mirror of
https://github.com/PDP-10/its.git
synced 2026-02-12 11:07:03 +00:00
85994ed770
Resolves #284. Commented out uses of time-origin in maxtul; mcldmp (init) until we can figure out why it gives arithmetic overflows under the emulators. Updated the expect script statements in build_macsyma_portion to not attempt to match expected strings, but simply sleep for some time since in some cases the matching appears not to work.
252 lines
8.9 KiB
Plaintext
252 lines
8.9 KiB
Plaintext
;; -*- Mode: Lisp; Package: Macsyma; Ibase: 8 -*-
|
||
|
||
(macsyma-module edits)
|
||
|
||
;; Macsyma display-oriented expression editor
|
||
;; MacLisp I/O and screen management
|
||
;; 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
|
||
|
||
;; Global variables and structure definitions.
|
||
|
||
(load-macsyma-macros edmac)
|
||
|
||
;; To be added:
|
||
;; Expression file I/O
|
||
;; Use ITS split-screen stuff
|
||
|
||
(eval-when (compile)
|
||
(cond ((not (status feature its))
|
||
(error "Compile on ITS only"))))
|
||
|
||
; Possible values for the TCTYP word returned by CNSGET.
|
||
; %TNSFW -- 7. Software -- CRTSTY or SUPDUP
|
||
; %TNESC -- 9. VT52 type terminal
|
||
; %TNRAY -- 11. Teleray 1061
|
||
|
||
; Bit mask for the TTYSTS word returned by TTYGET
|
||
; %TSSAI -- 4000_18. Use Sail character set for output
|
||
|
||
; Bit masks for the TTYOPT word returned by CNSGET.
|
||
; %TOCID -- 1_18. Can do character insertion and deletion
|
||
; %TOLID -- 2_18. Can do line insertion and deletion
|
||
; %TOFCI -- 10_18. Can generate full 12-bit character set
|
||
; %TOOVR -- 1000_18. Can overstrike (raster scan graphic)
|
||
|
||
(defvar TTYGET (syscall 5 'ttyget tyo))
|
||
(defvar CNSGET (syscall 6 'cnsget tyo))
|
||
|
||
(let ((TTYOPT (fifth CNSGET)))
|
||
(setq idel-chars-available? (not (= 0 (logand TTYOPT #o 1_18.))))
|
||
(setq idel-lines-available? (not (= 0 (logand TTYOPT #o 2_18.))))
|
||
(setq 12-bit-kbd-available? (not (= 0 (logand TTYOPT #o 10_18.))))
|
||
(setq overstrike-available? (not (= 0 (logand TTYOPT #o 1000_18.)))))
|
||
|
||
;; On supdup from AI, draw with a solid box. On supdup from Plasma or Lisp
|
||
;; Machines, use line graphics. The TTY variable is the same as the TCTYP word
|
||
;; returned by CNSGET.
|
||
|
||
(if (and (= tty 7)
|
||
12-bit-kbd-available?
|
||
idel-lines-available?)
|
||
(setq $boxchar '|& |))
|
||
|
||
(if 12-bit-kbd-available?
|
||
(setq 12-bit-input (open 'tty: '(tty in fixnum single))))
|
||
|
||
;; Make every character an activation character and don't echo when typed.
|
||
;; Later make this whole thing be interrupt driven. Or check at redisplay if
|
||
;; more chars available. Turn off all interrupt characters except ^G ^S group.
|
||
|
||
(defun disable-echoing ()
|
||
(sstatus tty #o 020202020202 #o 030202020202 (logior (caddr TTYGET) #o 4000_18.)))
|
||
|
||
(defun enable-echoing ()
|
||
(sstatus tty (car TTYGET) (cadr TTYGET) (caddr TTYGET)))
|
||
|
||
;; So that control-g will not break to macsyma when typing input.
|
||
|
||
(defun ed-prologue ()
|
||
(sstatus ttyint #/ '(lambda (not used)
|
||
(tyi) ;Gobble control-g
|
||
(minibuffer-clear)
|
||
(*throw 'command-loop nil)))
|
||
(sstatus ttyint #/ nil)
|
||
(disable-echoing))
|
||
|
||
; Check for user-set interrupt characters.
|
||
(defun ed-epilogue ()
|
||
; (sstatus ttyint 1 '(lambda (?x ?y) (merrbreak nil)))
|
||
; (sstatus ttyint 2 '(lambda (?x ?y) (mpause nil)))
|
||
; (sstatus ttyint 3 '(lambda (?x ?y) (princ ^cmsg) (setq ^d nil)))
|
||
; (sstatus ttyint 4 '(lambda (?x ?y) (princ ^dmsg) (setq ^d t)))
|
||
(sstatus ttyint #/ '(lambda (not used) (mquit nil)))
|
||
; (sstatus ttyint 8 nil) ; this line is unnecessary.
|
||
; (sstatus ttyint 18. nil)
|
||
(sstatus ttyint #/ 'mquiet)
|
||
; (sstatus ttyint 24. 'xquit)
|
||
; (sstatus ttyint 29. '(lambda (?x ?y) (timesofar nil)))
|
||
; (sstatus ttyint 30. 7) ; ^^ quits into lisp.
|
||
(enable-echoing))
|
||
|
||
(setq minibuffer-height 3)
|
||
(setq minibuffer-vpos (- ttyheight minibuffer-height 1))
|
||
(setq expr-area-height (- ttyheight minibuffer-height 1))
|
||
(setq mode-line-vpos (1- minibuffer-vpos))
|
||
|
||
; Display control
|
||
(defun tv-beep () (tyo 7))
|
||
|
||
(defun dctl-insert-lines (n-lines)
|
||
(dotimes (i n-lines) (cursorpos '[)))
|
||
|
||
(defun dctl-delete-lines (n-lines)
|
||
(dotimes (i n-lines) (cursorpos '\)))
|
||
|
||
(defun dctl-insert-chars (n-chars)
|
||
(dotimes (i n-chars) (cursorpos '^)))
|
||
|
||
(defun dctl-delete-chars (n-chars)
|
||
(dotimes (i n-chars) (cursorpos '-)))
|
||
|
||
; If it seems worth it, treat the VT100 as a special case later.
|
||
(defun dctl-scroll-region-up (top-line region-height n-lines)
|
||
(check-arg n-lines (> n-lines 0) "a non-negative integer")
|
||
(cond ((not (= 0 n-lines))
|
||
(cursorpos top-line 0)
|
||
(dctl-delete-lines n-lines)
|
||
(cursorpos (+ top-line region-height (- n-lines)) 0)
|
||
(dctl-insert-lines n-lines)))))
|
||
|
||
(defun dctl-scroll-region-down (top-line region-height n-lines)
|
||
(check-arg n-lines (> n-lines 0) "a non-negative integer")
|
||
(cond ((not (= 0 n-lines))
|
||
(cursorpos (+ top-line region-height) 0)
|
||
(dctl-delete-lines n-lines)
|
||
(cursorpos top-line 0)
|
||
(dctl-insert-lines n-lines))))
|
||
|
||
; Clear n lines on the screen
|
||
(defun dctl-clear-lines (top-line no-of-lines)
|
||
(if (< no-of-lines 0)
|
||
(break |Negative second arg to dctl-clear-lines|))
|
||
(do i 0 (1+ i) (= i no-of-lines)
|
||
(declare (fixnum i))
|
||
(cursorpos (+ top-line i) 0)
|
||
(cursorpos 'L))) ;Clear EOL
|
||
|
||
; Output functions. Clear and display on various portions of the screen.
|
||
; Leaves the cursor at the right place for typing into the minibuffer.
|
||
(defun minibuffer-clear ()
|
||
(cursorpos minibuffer-vpos 0)
|
||
(cursorpos 'E)) ;Clear to EOP
|
||
|
||
(defun expr-area-clear ()
|
||
(dctl-clear-lines 0 (1- mode-line-vpos)))
|
||
|
||
; This isn't right since we don't know where the cursor is. Make streams
|
||
; for minibuffer and expr-area display.
|
||
(defun minibuffer-print args (apply 'format (cons t (listify args))))
|
||
|
||
; This has to be made much hairer to know about which expressions to display
|
||
; and how deep to reveal.
|
||
; Displays the expressions in the current buffer.
|
||
(defun display-expressions (exp-list)
|
||
(cursorpos 'T)
|
||
(mapc '(lambda (exp)
|
||
(display-expression exp (car (cursorpos)))
|
||
(cursorpos 'D)) ;Down one line
|
||
exp-list))
|
||
|
||
; Hack reveal depth in here soon.
|
||
(defun display-expression (exp vpos)
|
||
(cursorpos vpos 0)
|
||
(cursorpos 'L)
|
||
(if (region-boxed? exp) (box-region exp))
|
||
(displa `((mlable) ,(expression-label exp) ,(cadr (displayed exp))))
|
||
(if (region-boxed? exp) (unbox-region exp)))
|
||
|
||
(defun display-mode-line ()
|
||
(cursorpos mode-line-vpos 0)
|
||
(if overstrike-available? (cursorpos 'L)) ;Clear EOL
|
||
(format t "Macsyma Display Editor [~A mode] ~A:"
|
||
(buffer-mode current-buffer)
|
||
(buffer-name current-buffer))
|
||
(if (and (expression-list current-buffer)
|
||
(cdr (expression-list current-buffer)))
|
||
(format t " (~D expressions)"
|
||
(length (expression-list current-buffer)))))
|
||
|
||
; Input functions. Read a character, a line, and a macsyma expression,
|
||
; respectively.
|
||
|
||
(defun read-char ()
|
||
(if 12-bit-kbd-available?
|
||
|
||
;ITS represents BS as 10 and Lambda as 4010. So check for BS, TAB,
|
||
;LINE, etc. as special cases. In all other cases, just mask the 4000
|
||
;bit and map the character directly to the Lisp Machine equivalent.
|
||
;See page 153 of the Preliminary Lisp Machine manual to understand
|
||
;this function.
|
||
;Hack ESC,BREAK,CLEAR,... ITS sends BREAK as TOP-B.
|
||
|
||
(let* ((char (tyi 12-bit-input))
|
||
(control? (not (= 0 (logand char #o 200))))
|
||
(meta? (not (= 0 (logand char #o 400))))
|
||
(top? (not (= 0 (logand char #o 4000)))))
|
||
(setq char (logand char #o 177)) ;Mask shift keys
|
||
(if (and (not top?) (> char 7) (< char #o 16))
|
||
(setq char (+ char #o 200))) ;BS, TAB, LINE, VT, FORM, RETURN
|
||
(if (and (not top?) (= char #o 177))
|
||
(setq char #o 207)) ;RUBOUT
|
||
(if (and top? (= char #/H))
|
||
(setq char #o 206)) ;HELP
|
||
(if control? (setq char (+ char #o 400)))
|
||
(if meta? (setq char (+ char #o 1000)))
|
||
char)
|
||
|
||
;When coming from an ascii keyboard, convert C-M to RETURN, since the
|
||
;user most likely typed RETURN on his keyboard. Don't convert C-K to
|
||
;to VT since it is unlikely that he has a VT key on his keyboard.
|
||
|
||
(let ((char (tyi)))
|
||
(cond ((= char #\ALT) #o 33)
|
||
((= char #\RUBOUT) #o 207)
|
||
((= char #\BS) #o 210)
|
||
((= char #\TAB) #o 211)
|
||
((= char #\LF) #o 212)
|
||
((= char #\CR) #o 215)
|
||
((= char #\HELP) #o 206)
|
||
((= char #/ ) #o 100)
|
||
((and (= char #/) ;Fix ^S ^Q lossage
|
||
(= tty #o 11) ;possibly a VT52
|
||
(> (listen tyi) 0)
|
||
(= (tyipeek nil tyi) #/))
|
||
(tyi tyi)
|
||
(read-char))
|
||
((< char #\ALT) (+ #o 540 char)) ;^A through ^Z
|
||
((< char #\SPACE) (+ #o 500 char)) ;^\, ^], ^^, ^_
|
||
(t char)))))
|
||
|
||
; Have a bug here: Find some way to correctly echo characters typed before
|
||
; echoing was turned back on.
|
||
|
||
(defun read-line args
|
||
(minibuffer-clear)
|
||
(minibuffer-print "[Terminate with <CR>] ")
|
||
(if (> args 0) (apply 'minibuffer-print (listify args)))
|
||
(enable-echoing)
|
||
(unwind-protect (readline) (disable-echoing)))
|
||
|
||
; Read an expression from the minibuffer. Expression is in internal macsyma
|
||
; format.
|
||
|
||
(defun read-expression args
|
||
(minibuffer-clear)
|
||
(minibuffer-print "[Terminate with ;] ")
|
||
(if (> args 0) (apply 'minibuffer-print (listify args)))
|
||
(enable-echoing)
|
||
(unwind-protect (retrieve "" nil)
|
||
(disable-echoing)))
|