;; -*- 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 ] ") (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)))