LISTING FOR >special_ldd>install>MR12.0-1136>video_system.ctl COMPILED BY Multics LISP Compiler, Version 2.13c, July 11, 1983 ON 08/20/86 2256.4 mst Wed IN BEHALF OF Martinson.SysMaint.a ;;; *********************************************************** ;;; * * ;;; * Copyright, (C) Honeywell Information Systems Inc., 1982 * ;;; * * ;;; * Copyright (c) 1981 by Massachusetts Institute of * ;;; * Technology and Honeywell Information Systems, Inc. * ;;; * * ;;; *********************************************************** ;;; ;;; Video System CTL uses Multics Video System ;;; HISTORY COMMENTS: ;;; 1) change(83-12-03,Margolin), approve(), audit(), ;;; install(86-08-20,MR12.0-1136): ;;; pre-hcom history: ;;; Ripped off from VIP7200ctl BSG 6/6/78 (!) ;;; Suzanne Krupp 12/30/80 ;;; Standardized to not force vs on, 22 June 1981 RMSoley ;;; Protcol for window status BIM July 1981 ;;; Modified to check actual terminal capabilities before setting ;;; the flags by WMY, 11 August 1981 ;;; Add DCTL-prologue, which recomputes the window/terminal ;;; info. Barmar, 3 December 1983 ;;; 2) change(85-01-25,Margolin), approve(86-02-24,MCR7186), ;;; audit(86-08-12,Harvey), install(86-08-20,MR12.0-1136): ;;; Fix code declaration in video_system_ctl_util_$get_terminal_capabilities ;;; to have decimal point. ;;; END HISTORY COMMENTS (declare (special X Y tty-type rdis-whitespace-optimize idel-lines-availablep idel-chars-availablep DCTL-prologue-availablep DCTL-epilogue-availablep iocb_ptr code columns rows lines_per_scroll y_origin x_origin screenlinelen screenheight region-scroll-availablep overstrike-availablep ospeed) (*expr convert_status_code_ e_lap_$rtrim error_table_ Rprinc e_pl1_$get_iocb) (defpl1 window_$position_cursor "" (ptr) (fixed bin) (fixed bin) (return (setq code) fixed bin(35.))) (defpl1 window_$clear_to_end_of_window "" (ptr) (return (setq code) fixed bin(35.))) (defpl1 window_$clear_to_end_of_line "" (ptr) (return (setq code) fixed bin(35.))) (defpl1 window_$scroll_region "" (ptr) (fixed bin) (fixed bin) (fixed bin) (return (setq code) fixed bin(35.))) (defpl1 window_$insert_text "" (ptr) (char(*)) (return (setq code) fixed bin(35.))) (defpl1 window_$overwrite_text "" (ptr) (char(*)) (return (setq code) fixed bin(35.))) (defpl1 window_$delete_chars "" (ptr) (fixed bin) (return (setq code) fixed bin(35.))) (defpl1 window_$clear_window "" (ptr) (return (setq code) fixed bin(35.))) (defpl1 window_$bell "" (ptr) (return (setq code) fixed bin (35.))) ;;; Perform primitive window status check. to be haired up later. (defpl1 e_pl1_$check_for_window_status "" (fixed bin (35.))) ;;; This pl1 subroutine returns information about available terminal features. (defpl1 video_system_ctl_util_$get_terminal_capabilities "" (ptr) ; iocb pointer (lisp) ; the constant "t" (lisp) ; the constant "nil" (return (setq region-scroll-availablep) lisp) (return (setq idel-chars-availablep) lisp) (return (setq overstrike-availablep) lisp) (return (setq ospeed) fixed bin) (return (setq code) fixed bin(35.))) ;;; This pl1 routine returns infomation about the position and size of the ;;; window whose iocb pointer is iocb_ptr. (defpl1 video_system_ctl_util_$get_window_info "" (ptr) ; iocb_ptr (return (setq y_origin) fixed bin) ; Y_origin - line (return (setq x_origin) fixed bin) ; X_origin - col (return (setq screenlinelen) fixed bin) ; width (return (setq screenheight) fixed bin) ; height (return (setq code) fixed bin(35.))) ) ;;; Initialize terminal and terminal control package. (defun DCTL-init () (setq iocb_ptr (e_pl1_$get_iocb)) (putprop 'video_system t 'tintinnabulum-ipsum-meum-sono) (setq tty-type 'video_system DCTL-prologue-availablep t DCTL-epilogue-availablep t) (DCTL-prologue) ;initialize window/terminal info (window_$clear_window iocb_ptr) (e_pl1_$check_for_window_status code) (setq X 0 Y 0 ;; rdis-whitespace-optimize nil ;; removed 12/3/83 )) ;;; Prologue code (defun DCTL-prologue () (video_system_ctl_util_$get_window_info iocb_ptr) (cond ((zerop code)) ((= code (error_table_ 'undefined_order_request)) ;not in video (Rprinc "emacs: Video system CTL invoked with no video system.")) (t (Rprinc (catenate "emacs: " (e_lap_$rtrim (cadr (convert_status_code_ code))) " Can't get window info.")))) (video_system_ctl_util_$get_terminal_capabilities iocb_ptr t nil) (cond ((not (zerop code)) (Rprinc (catenate "emacs: " (e_lap_$rtrim (cadr (convert_status_code_ code))) " Can't get terminal capabilities."))))) ;;; Epilogue code (defun DCTL-epilogue () (window_$clear_window iocb_ptr) (e_pl1_$check_for_window_status code)) ;;; Move terminal's cursor to desired position. (defun DCTL-position-cursor (x y) (window_$position_cursor iocb_ptr (1+ y) (1+ x)) (e_pl1_$check_for_window_status code) (setq X x Y y)) ;;; Output string. (defun DCTL-display-char-string (string) (window_$overwrite_text iocb_ptr string) (e_pl1_$check_for_window_status code) (setq X (+ X (stringlength string)))) ;;; Clear entire screen (defun DCTL-clear-screen () (window_$clear_window iocb_ptr) (e_pl1_$check_for_window_status code)) ;;; Clear to end of screen. (defun DCTL-clear-rest-of-screen () (window_$clear_to_end_of_window iocb_ptr) (e_pl1_$check_for_window_status code)) ;;; Clear to end of line. (defun DCTL-kill-line () (window_$clear_to_end_of_line iocb_ptr) (e_pl1_$check_for_window_status code)) ;;; Scroll down. (defun DCTL-scroll-down-region (nlines bottom) (window_$scroll_region iocb_ptr (1+ Y) (1+ (- bottom Y)) nlines) (e_pl1_$check_for_window_status code)) ;;; Scroll up. (defun DCTL-scroll-up-region (nlines bottom) (window_$scroll_region iocb_ptr (1+ Y) (1+ (- bottom Y)) (- nlines)) (e_pl1_$check_for_window_status code)) ;;; Insert a string of characters on the screen. (defun DCTL-insert-char-string (str) (window_$insert_text iocb_ptr str) (e_pl1_$check_for_window_status code) (setq X (+ X (stringlength str)))) ;;; Delete a string of characters from the screen. (defun DCTL-delete-chars (n) (window_$delete_chars iocb_ptr n) (e_pl1_$check_for_window_status code)) ;;; Ring the terminal's bell. (defun DCTL-ring-tty-bell () (window_$bell iocb_ptr) (e_pl1_$check_for_window_status code)) Functions Defined Name Offset Offset Name DCTL-clear-rest-of-screen 1173 0 window_$position_cursor DCTL-clear-screen 1162 50 window_$clear_to_end_of_window DCTL-delete-chars 1313 106 window_$clear_to_end_of_line DCTL-display-char-string 1137 144 window_$scroll_region DCTL-epilogue 1100 220 window_$insert_text DCTL-init 720 264 window_$overwrite_text DCTL-insert-char-string 1270 330 window_$delete_chars DCTL-kill-line 1204 374 window_$clear_window DCTL-position-cursor 1111 432 window_$bell DCTL-prologue 760 470 e_pl1_$check_for_window_status DCTL-ring-tty-bell 1327 510 video_system_ctl_util_$get_terminal_capabilities DCTL-scroll-down-region 1215 620 video_system_ctl_util_$get_window_info DCTL-scroll-up-region 1242 720 DCTL-init e_pl1_$check_for_window_status 470 760 DCTL-prologue video_system_ctl_util_$get_terminal_capabilities 510 1100 DCTL-epilogue video_system_ctl_util_$get_window_info 620 1111 DCTL-position-cursor window_$bell 432 1137 DCTL-display-char-string window_$clear_to_end_of_line 106 1162 DCTL-clear-screen window_$clear_to_end_of_window 50 1173 DCTL-clear-rest-of-screen window_$clear_window 374 1204 DCTL-kill-line window_$delete_chars 330 1215 DCTL-scroll-down-region window_$insert_text 220 1242 DCTL-scroll-up-region window_$overwrite_text 264 1270 DCTL-insert-char-string window_$position_cursor 0 1313 DCTL-delete-chars window_$scroll_region 144 1327 DCTL-ring-tty-bell Functions Referenced DCTL-prologue error_table_ window_$clear_to_end_of_window Rprinc putprop window_$clear_window catenate stringlength window_$delete_chars convert_status_code_ video_system_ctl_util_$get_terminal_capabilities window_$insert_text e_lap_$rtrim video_system_ctl_util_$get_window_info window_$overwrite_text e_pl1_$check_for_window_status window_$bell window_$position_cursor e_pl1_$get_iocb window_$clear_to_end_of_line window_$scroll_region ----------------------------------------------------------- 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