LISTING FOR  >special_ldd>install>MR12.2-1071>ambassador.ctl
COMPILED BY Multics LISP Compiler, Version 2.13c, July 11, 1983
ON 08/01/88  0957.7 mst Mon
IN BEHALF OF GJohnson.SysMaint.a



;;; ***********************************************************
;;; *                                                         *
;;; * Copyright, (C) Honeywell Bull Inc., 1988                *
;;; *                                                         *
;;; * Copyright, (C) Honeywell Information Systems Inc., 1982 *
;;; *                                                         *
;;; * Copyright (c) 1978 by Massachusetts Institute of        *
;;; * Technology and Honeywell Information Systems, Inc.      *
;;; *                                                         *
;;; ***********************************************************

;;;               AnnArbor Ambassador Controller


;;; HISTORY COMMENTS:
;;;  1) change(88-02-02,Schroth), approve(), audit(), install():
;;;     Pre-hcom journal.
;;;               AnnArbor Ambassador pkg --- BSG 1/26/81
;;;               Tavares' Redisplay hacking features of 1/6/81 added, too.
;;;  2) change(88-02-02,Schroth), approve(88-02-29,MCR7852),
;;;     audit(88-06-08,RBarstad), install(88-08-01,MR12.2-1071):
;;;     Updated to make set-screen-size compatible with split screen.
;;;                                                      END HISTORY COMMENTS


(%include emacs-rdis-dcls)

(declare (special X Y screenheight screenlinelen ospeed DCTL-csistring))
(declare (special idel-lines-availablep idel-chars-availablep tty-type))
(declare (special DCTL-prologue-availablep DCTL-epilogue-availablep))
(declare (special given-tty-type DCTL-dcl-screen-height))
(declare (special modelwindow))
(declare (*expr DCTL-standard-set-screen-size Rprinc Rtyo
	      reset-minibuffer-size wman-init))

;;; Initialize terminal and terminal control package.
(defun DCTL-init ()
       (setq idel-lines-availablep t idel-chars-availablep t
             screenlinelen 79. tty-type 'ambassador
	   DCTL-prologue-availablep t DCTL-epilogue-availablep t
             X -777 Y -777)
       (setq DCTL-dcl-screen-height
	   (or (cdr (assq given-tty-type
		        '((ambassador . 30.) (ambassador_24l . 24.)
		          (ambassador_30l . 30.) (ambassador_48l . 48.)
			(ambassador_60l . 60.))))
	       30.))
       (setq screenheight DCTL-dcl-screen-height)
       (setq DCTL-csistring (catenate (ascii 33) "["))
       (DCTL-prologue)
       (DCTL-position-cursor 0 0)
       (DCTL-clear-rest-of-screen))



(defun DCTL-prologue ()
       (DCTL-csi1 49. "Q")			;Make ICH/DCH win
       (DCTL-csiprinc ">30l")			;RM ZDBM, make ^H win
       (DCTL-set-hw-screen-size screenheight))

(defun DCTL-epilogue ()
       (DCTL-set-hw-screen-size DCTL-dcl-screen-height))

;;; Move terminal's cursor to desired position.
(defun DCTL-position-cursor (x y)
       (cond ((and (= x X) (= y Y)) nil)	;gudenov
	   ((and (= x 0) (= y 0))
	    (DCTL-csiprinc "H")
	    (setq X 0 Y 0))
	   ((or (< X 0)(< Y 0))
	    (DCTL-position-cursor 0 0)
	    (DCTL-position-cursor x y))
	   ((= y Y)			;get away with "HPA"!
	    (let ((d (- x X)))
	         (cond ((= x 0)(Rtyo 15))		;CR
		     ((and (> d 0)(< d 10.))	;HPR will do
		      (DCTL-csi1 d "a"))	;HPR
		     ((and (< d 0)(< (- d) 10.))
		      (setq d (- d))
		      (cond ((< d 5)
			   (do i X (1- i)(= i x)(Rtyo 10)))	;^H
			  (t (DCTL-csi1 d "D"))))
		     (t (DCTL-csi1 (1+ x) "`"))))	;HPA
	    (setq X x))
	   ((= x X)			;get away with "VPA"!
	    (let ((d (- y Y)))
	         (cond ((and (> d 0)(< d 10.))	;VPR will do
		      (cond ((< d 5)
			   (do i Y (1+ i)(= i y)(Rtyo 12)))     ;LF
			  (t (DCTL-csi1 d "e"))))	;VPR
		     ((and (< d 0)(< (- d) 10.))   ;CUU
		      (setq d (- d))
		      (cond ((= d 1)(Rtyo 33)(Rprinc "M"))
			  (t (DCTL-csi1 d "A"))))
		     (t (DCTL-csi1 (1+ y) "d"))))	;VPA
	    (setq Y y))
	   ((= x 0)			;CNL/CPL
	    (DCTL-csi1 (abs (- y Y))
		     (cond ((> y Y) "E")	;CNL
			 (t "F")))	;CPL
	    (setq Y y X 0))
	   ((and (< (+ (abs (- X x)) (abs (- Y y))) 3))
	    (DCTL-position-cursor x Y)
	    (DCTL-position-cursor x y))
	   ;; Direct Cursor Addressing is best.
	   (t (setq X x Y y)
	      (DCTL-csi1 (1+ y) ";")
	      (DCTL-outANSIdec (1+ x))
	      (Rprinc "H"))))

;;; Output string.
(defun DCTL-display-char-string (string)
       (setq X (+ X (stringlength string)))
       (Rprinc string))


;;; Clear to end of screen.
(defun DCTL-clear-rest-of-screen ()
       (DCTL-csi1 0 "J"))

;;; Clear to end of line.
(defun DCTL-kill-line ()
       (DCTL-csi1 0 "K"))


;;; Insert character string in line at current position.
(defun DCTL-insert-char-string (str)
       (DCTL-csi1 (stringlength str) "@")
       (Rprinc str)
       (setq X (+ X (stringlength str))))


;;; Delete characters from current position in line.
(defun DCTL-delete-chars (n)
       (DCTL-csi1 n "P"))


;;; Insert n blank lines at current position.
(defun DCTL-insert-lines (n)
       (DCTL-csi1 n "L")
       (setq X 0))


;;; Delete n lines at current position.
(defun DCTL-delete-lines (n)
       (DCTL-csi1 n "M")
       (setq X 0))


;;; Encoding cruft 1/26/81

(defun DCTL-csi1 (n stuff)
       (Rprinc DCTL-csistring)
       (DCTL-outANSIdec n)
       (Rprinc stuff))

(defun DCTL-outANSIdec (n)
       (cond ((or (= n 0)(= n 1)))
	   (t (DCTL-outANSIdec-recurse n))))

(defun DCTL-outANSIdec-recurse (n)
       (cond ((> n 9)(DCTL-outANSIdec-recurse (// n 10.))))
       (Rtyo (+ (CtoI "0") (\ n 10.))))

(defun DCTL-csiprinc (stuff)
       (Rprinc DCTL-csistring)
       (Rprinc stuff))



;;; Send pad characters to wait specified number of milliseconds
(defun DCTL-pad (n)
       (do i (1+ (// (* n ospeed) 1000.)) (1- i) (= i 0)
           (Rtyo 0)))

;;;; Tavares' hack


;;; the following hack enables the terminal to change its ACTUAL hardware
;;; screen size in response to the set-screen-size command.
;;; (Should work in supdup or emacs, nobody will call set-screen-size,
;;; fixed not to use decimal-rep -BSG 1/26/81)
;;; first, copy the REAL set-screen-size somewhere safe.

(putprop 'DCTL-standard-set-screen-size (get 'set-screen-size 'subr) 'subr)

(defun set-screen-size (screen-size)

;;; find the proper hardware screen size

       (setq screenheight
	   (cond ((> screen-size 48.) 60.)
	         ((> screen-size 40.) 48.)
	         ((> screen-size 36.) 40.)
	         ((> screen-size 30.) 36.)
	         ((> screen-size 28.) 30.)
	         ((> screen-size 26.) 28.)
	         ((> screen-size 24.) 26.)
 	         ((> screen-size 20.) 24.)
	         ((> screen-size 18.) 20.)
	         (t 18.)))

        (DCTL-set-hw-screen-size screenheight)

;;; wipe out the dregs of the obsolete mode line and minibuffer, etc.

        (DCTL-position-cursor 0 (startline modelwindow))
        (DCTL-clear-rest-of-screen)

;;; if the new screenheight is higher than ever, grow emacs' arrays.

        (cond ((> screenheight (cadr (arraydims screen)))
	     ;; The following 'strange' *rearray is used as we must keep both
	     ;; an array pointer and a named array reference up-to-date.
	     (setq screen      (*rearray 'screen t screenheight))
	     (setq eline-conts (*rearray 'eline-conts t screenheight))
	     (setq newscreen   (*rearray 'newscreen t screenheight))))

;;; perform the standard emacs action on set-screen-size

        (DCTL-standard-set-screen-size screen-size)

;;; make emacs recompute where to put the mode line, etc.

        (wman-init)
        (reset-minibuffer-size)

;;; force terminal to return screen to top of page

        (setq X -777 Y -777)			;randomize, force output
        (DCTL-position-cursor 0 0)))



(defun DCTL-set-hw-screen-size (size)
       (DCTL-csiprinc "60;;;")
       (DCTL-outANSIdec size)
       (Rprinc "p")
       (setq X 0 Y 0))			; hw also homes cursor

INCLUDE FILE >special_ldd>install>MR12.2-1071>emacs-rdis-dcls.incl.lisp

;;; BEGIN INCLUDE FILE emacs-rdis-dcls.incl.lisp


;;; HISTORY COMMENTS:
;;;  1) change(87-12-23,Schroth), approve(), audit(), install():
;;;     Original Written: Way back when by BSGreenberg
;;;  2) change(87-12-23,Schroth), approve(88-02-29,MCR7852),
;;;     audit(88-06-08,RBarstad), install(88-08-01,MR12.2-1071):
;;;     Updated for split-screen changes: defined displayline and split
;;;     structures, changed named arrays to array pointers.  Used
;;;     defmacro and defstruct changes from Barry Margolin.
;;;                                                      END HISTORY COMMENTS



;;; Include file for Emacs redisplay modules

(%include defmacro)
(declare (macros nil))			;drop these macros at load
(%include defstruct)
(%include backquote)
(%include setf)

;;; Macro to make an array pointer look like a named array
;;; This creates a special variable and an access macro with the name given
;;; as the first argument.  The remaining variable number of arguments define
;;; the number of arguments the access macro needs and correspond to array
;;; dimensions.  Note that the array is NOT allocated by this macro.  The
;;; programmer must do so manually.
;;; Note that since the access macro generates an 'arraycall', it may be
;;; used with setf.  This is not the case with named arrays.

(defmacro defarray (array-name &rest indices)
	`(progn 'compile
	        (declare (special ,array-name))
	        (defmacro ,array-name (,@indices)
		        (list 'arraycall t ',array-name ,@indices))))

(defarray screen line-index)			;Screen rdis-lines
(defarray newscreen line-index)		;New windows being built
(defarray eline-conts line-index)		;Old linecontents

(defarray windows window-num)			;Window structures
(defarray uwindows uwindow-index)		;User-indices into windows.

;;;
;;; Screen Hardware Window Data Structures
;;;
;;; Hardware windows are called "splits" to avoid confusion with the EMACS
;;; concept of a window.
;;;

(defarray splits split-index) 		;one entry / hardware window

;;; The above array has one entry per hardware window the terminal can display.
;;; When not in split mode, only one is active and it is not really used.
;;; In split mode, this array stores the entire redisplay state for that
;;; split (hardware window) as if it were the entire screen.
;;; Moving to a new window causes a context switch using this array.
;;; See the (defstruct (split ...)) definition below.


(defarray usplits usplit-number)		;one entry per user split
					; these index into the
					; splits array

(defmacro aos (x) `(incf ,x))
(defmacro sos (x) `(decf ,x))
(defmacro rbarf (message &optional object)
	`(error ,message ,object 'fail-act))

;;;
;;;  Screen/editorline structures
;;;
(defstruct (window
	   (:eval-when (eval compile))
	   (:type list))
	 (startline 0)
	 (numlines 0)
	 (bufmark nil)
	 (bufsym nil)
	 (window-split nil))		;split the  window is in

(defmacro rplac-startline (window new-startline)
	`(setf (startline ,window) ,new-startline))
(defmacro rplac-numlines (window new-numlines)
	`(setf (numlines ,window) ,new-numlines))
(defmacro rplac-bufmark (window new-bufmark)
	`(setf (bufmark ,window) ,new-bufmark))
(defmacro rplac-bufsym (window new-bufsym)
	`(setf (bufsym ,window) ,new-bufsym))
(defmacro rplac-split (window split)
	`(setf (window-split ,window) ,split))

(defstruct (uwindow				;user window array element
	   (:eval-when (eval compile))
	   (:type list)
	   (:conc-name))
	 (windowx 0)			;index into windows array
	 (split nil))			;split owning the uwindow

(defmacro uwind (window-number)
	`(windows (uwindow-windowx (uwindows ,window-number))))
(defmacro uwind-split (window-number)		;returns split given uwindows index
	`(uwindow-split (uwindows ,window-number)))

;;;
;;; Display-line structure.
;;; (This commentary lifted from e_redisplay)
;;;
;;;	Screen is maintained as the array "screen", containing knowledge
;;;	and images of screen. Each element of "screen" is called a "displayline",
;;;	and looks like this:
;;;
;;;	(editorline "printablerepresentationwithnonewline" . printinglength)
;;;
;;;	The array "newscreen" is used during redisplay computation only.
;;;
;;;	The array "eline-conts" parallels the window array of redisplay lines
;;;	maintaining what e_ calls "line-contents" so that an "eq" check can
;;;	be made (see redisplay-window) to avoid detabbification and resultant
;;;	consing, for eq lines with eq contents cannot detabbify differently.

(defstruct (displayline
	   (:eval-when (eval compile))
	   (:type list*))			;save a cons cell
	 (eline nil)			;the editorline
	 (linedata nil)			;the directly displayable image w/o NL
	 (lineln 0))			;interesting length of image
;;;
;;; Display-line special macros. These operate on the screen array elements.
;;;
(defmacro rplac-eline (displayline new-eline)
	`(setf (eline ,displayline) ,new-eline))
(defmacro rplac-linedata (displayline new-linedata)
	`(setf (linedata ,displayline) ,new-linedata))
(defmacro rplac-lineln (displayline new-lineln)
	`(setf (lineln ,displayline) ,new-lineln))

;;;
;;; The screen split data structure
;;;
;;; This structure is used to contain the data relevant to a screen split (hardware window)
;;; which is viewed as a seperate virtual screen.  As such, all display screen
;;; data is stored in a split structure when that split is not active. When a split is
;;; active, its data is copied into the globalredisplay and window manager data
;;; (after the prior data.)
;;;

(defstruct (split
	   (:eval-when (eval compile))
	   (:type array)			;use arrays to speed access to elements
	   (:conc-name))
	 (line-length 0)			;usable split width (consider cursor wrap, scrolling etc.)
	 (width 0)			;real width on screen (used only be creation stuff)
	 (height 0)			;split depth = main-window-size
	 (id 0)				;used to talk to CTL
	 (home-X 0)			;home location on ABS screen
	 (home-Y 0)
	 (damaged t)			;needs to be redisplayed
	 (screen nil)			;array of display-lines
	 (eline-conts nil)			;array of corr. elines
	 (windows nil)			;the windows in this split
	 (nwindows 0))


;;; END   INCLUDE FILE emacs-rdis-dcls.incl.lisp

INCLUDE FILE >ldd>include>defmacro.incl.lisp

;; -*- Mode: Lisp; Lowercase: True -*-

;; defmacro.incl.lisp - Loads lisp_backquote_, lisp_destructuring_let_,
;; and lisp_defmacro_ into either the compiler or interpreter environment.
;; Written:  October 1982 by Carl Hoffman

;; Defmacro needs destructuring_let to run.
;; It can run without backquote, but would be useless.

(eval-when (eval compile)
  (or (status feature backquote)
      (load (catenate (car (namelist (truename infile))) ">lisp_backquote_")))
  (or (status feature destructuring_let)
      (load (catenate (car (namelist (truename infile))) ">lisp_destructuring_let_")))
  (or (status feature defmacro)
      (load (catenate (car (namelist (truename infile))) ">lisp_defmacro_"))))

;; This is necessary for (defprop a b macro) forms and defuns produced
;; by defmacro to appear in the object segment.  Let the default be
;; the right thing for naive users.
(declare (macros t))

INCLUDE FILE >ldd>include>defstruct.incl.lisp

;; -*- Mode: Lisp; Lowercase: True -*-

;; defstruct.incl.lisp - Loads lisp_defstruct_ and lisp_setf_ into either the
;; compiler or interpreter environment.
;; Written:	October 1982 by Alan Bawden, Carl Hoffman, and Rich Lamson

(eval-when (eval compile)
  (or (status feature setf)
      (load (catenate (car (namelist (truename infile))) ">lisp_setf_")))
  (or (status feature defstruct)
      (load (catenate (car (namelist (truename infile))) ">lisp_defstruct_"))))

INCLUDE FILE >ldd>include>backquote.incl.lisp

;;;
;;; backquote.incl.lisp - BSG 10/9/79
;;; Loads lisp_backquote_ into either the compiler or interpreter
;;; environment.
;;;
;;; Modified 10/30/82 by Richard Lamson to use eval-when and
;;;				   (status feature backquote)
;;;
(eval-when (eval compile)
  (or (status feature backquote)
      (load (catenate (car (namelist (truename infile))) ">lisp_backquote_"))))

INCLUDE FILE >ldd>include>setf.incl.lisp

;; -*- Mode: Lisp; Lowercase: True -*-

;; setf.incl.lisp - Loads lisp_setf_ into either the compiler or
;; interpreter environment.
;; Written:  October 1982 by Carl Hoffman

(eval-when (eval compile)
  (or (status feature setf)
      (load (catenate (car (namelist (truename infile))) ">lisp_setf_"))))

			Functions Defined

Name			Offset		Offset		Name


DCTL-clear-rest-of-screen        546		   0		DCTL-init
DCTL-csi1                        660		   62		DCTL-prologue
DCTL-csiprinc                    742		   104		DCTL-epilogue
DCTL-delete-chars                617		   111		DCTL-position-cursor
DCTL-delete-lines                644		   532		DCTL-display-char-string
DCTL-display-char-string         532		   546		DCTL-clear-rest-of-screen
DCTL-epilogue                    104		   560		DCTL-kill-line
DCTL-init                        0		   572		DCTL-insert-char-string
DCTL-insert-char-string          572		   617		DCTL-delete-chars
DCTL-insert-lines                627		   627		DCTL-insert-lines
DCTL-kill-line                   560		   644		DCTL-delete-lines
DCTL-outANSIdec                  676		   660		DCTL-csi1
DCTL-outANSIdec-recurse          720		   676		DCTL-outANSIdec
DCTL-pad                         754		   720		DCTL-outANSIdec-recurse
DCTL-position-cursor             111		   742		DCTL-csiprinc
DCTL-prologue                    62		   754		DCTL-pad
DCTL-set-hw-screen-size          1206		   1002		set-screen-size
set-screen-size                  1002		   1206		DCTL-set-hw-screen-size





			Functions Referenced

*rearray                                DCTL-position-cursor                    arraydims
DCTL-clear-rest-of-screen               DCTL-prologue                           assq
DCTL-csi1                               DCTL-set-hw-screen-size                 reset-minibuffer-size
DCTL-csiprinc                           DCTL-standard-set-screen-size           stringlength
DCTL-outANSIdec                         Rprinc                                  wman-init
DCTL-outANSIdec-recurse                 Rtyo                                    


                                          -----------------------------------------------------------


Historical Background

This edition of the Multics software materials and documentation is provided and donated
to Massachusetts Institute of Technology by Group BULL including BULL HN Information Systems Inc. 
as a contribution to computer science knowledge.  
This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology,
Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell BULL Inc., Groupe BULL
and BULL HN Information Systems Inc. to the development of this operating system. 
Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970),
renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership
of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture 
for managing computer hardware properly and for executing programs. Many subsequent operating systems 
incorporated Multics principles.
Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., 
as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. .

                                          -----------------------------------------------------------

Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without
fee is hereby granted,provided that the below copyright notice and historical background appear in all copies
and that both the copyright notice and historical background and this permission notice appear in supporting
documentation, and that the names of MIT, HIS, BULL or BULL HN not be used in advertising or publicity pertaining
to distribution of the programs without specific prior written permission.
    Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc.
    Copyright 2006 by BULL HN Information Systems Inc.
    Copyright 2006 by Bull SAS
    All Rights Reserved