; .EnTete "Le-Lisp (c) version 15.2" " " "Gestion du terminal virtuel" ; .EnPied " " "%" " " ; .Chapitre 8 "Gestion du Terminal" ; ; .Centre "*****************************************************************" ; .Centre " Ce fichier est en lecture seule hors du projet ALE de l'INRIA. " ; .Centre " Il est maintenu par ILOG SA, 2 Avenue Gallie'ni, 94250 Gentilly " ; .Centre " (c) Le-Lisp est une marque de'pose'e de l'INRIA " ; .Centre "*****************************************************************" ; .Centre "$Header: virtty.ll,v 4.4 89/01/04 16:42:38 neidl Exp $" (unless (>= (version) 15.2) (error 'load 'erricf 'virtty)) (add-feature 'virtty) ; La variable globale #:sys-package:tty contient le nom du ; package a` partir ; duquel seront recherche'es les fonctions du terminal. ; Par de'faut cette variable contient TTY. ; Le chargement d'un nouveau type de terminal doit : ; - charger cette variable avec un nom de type #:TTY:nom ; - de'finir les fonctions qui changent, ces fonctions e'tant ; dans le package #:TTY:nom (defvar #:sys-package:tty 'tty) ; La fonction INITTY, appele'e au de'but du chargement ; de toute image-me'moire, doit de'finir cette variable. ; Fonctions du terminal virtuel : ; ; Standard : ; (tyi) lit un caracte`re sur le terminal ; (tys) indique si un caracte`re est disponible au terminal et le lit ; (tyinstring strg) ligne un ligne en aveugle et la met dans la ; chaine. Retourne le nombre de caracteres lus. ; (tyo o1 o2 ... on) imprime les objets (cn, pname, string) dans le ; tampon du terminal. ; (tyflush) vide le tampon du terminal ; (tyod n nc) valeur nume'rique de n sur nc caracte`res ; (redisplayscreen ...) voir doc Chapitre 7. ; ; Obligatoires : ; (tycursor x y) positionne le curseur en "x" (col.) et "y" (ligne) ; (tycls) efface tout l'e'cran ; ; Facultatifs : ; les fonctions suivantes peuvent ne rien signifier ; pour un certain type de terminal, mais doivent e^tre ; toujours de'finies. Elles retournent () lorsqu'elles ; sont sans signification, une valeur non () sinon. ; ; (typrologue) qui initialise le terminal en mode vide'o ; (tyepilogue) qui termine le mode vide'o du terminal ; (tycleol) efface du caracte`re courant a` la fin de la ligne ; (tycleos) efface du caracte`re courant a` la fin de l'e'cran ; (tybeep) de'clenche la sonnette ; (tyinsch cn) inse`re le caracte`re cn a` la position du curseur ; (tyinscn cn) inse`re le caracte`re cn a` la position du curseur ; (tydelch) enle`ve le caracte`re a` la position du curseur ; (tydelcn cn) enle`ve le caracte`re cn a` la position du curseur ; (tyinsln) inse`re une nouvelle ligne a` la position courante ; (tydelln) enle`ve la ligne courante ; (tyattrib [i]) change/lit le mode de l'attribut ; (tybs cn) recule sans effacer sur le caractere cn ; (tycr) retourne en colonne 0 ; (tyshowcursor [i]) cache ou montre le curseur ; ; Fonctions compose'es : ; (tyco x y c1 c2 ... cn) positionne le curseur et affiche les car. ; (tycot x y c1 c2 ... cn) idem, mais avec l'attribut positionne' ; .Section "La 5e`me fonction standard sur terminal" (de tyod (x n) (to-tty 'tyod x n)) (de #:tty:tyod (x n) ; Affiche l'entier sur au moins caracte`res (when (or (gt n 1) (gt x 9)) (#:tty:tyod (div x 10) (sub1 n))) (tyo (add #/0 (rem x 10)))) ; .Section "Fonctions et Variables du terminal virtuel" (dmd to-tty (cmd . larg) `(funcall (getfn #:sys-package:tty ,cmd ()) ,@larg)) (dmd get-tty (var) `(symeval (getsymb #:sys-package:tty ,var ()))) (de tyerror (appel) (to-tty 'tyerror appel)) (de typrologue () (to-tty 'typrologue)) (de tyepilogue () (to-tty 'tyepilogue)) (de tycleol () (to-tty 'tycleol)) (de tycleos () (to-tty 'tycleos)) (de tybeep () (to-tty 'tybeep)) (de tyinsch (cn) (to-tty 'tyinsch cn)) (de tydelch () (to-tty 'tydelch)) (de tyinscn (cn) (to-tty 'tyinscn cn)) (de tydelcn (cn) (to-tty 'tydelcn cn)) (de tyinsln () (to-tty 'tyinsln)) (de tydelln () (to-tty 'tydelln)) (de tyattrib x (ifn x (get-tty 'tyattrib) (to-tty 'tyattrib (car x)) (set (getsymb #:sys-package:tty 'tyattrib ()) (car x)))) (de tybs (cn) (to-tty 'tybs cn)) (de tycr () (to-tty 'tycr)) (de tyshowcursor x (ifn x (get-tty 'tyshowcursor) (to-tty 'tyshowcursor (car x)) (set (getsymb #:sys-package:tty 'tyshowcursor ()) (car x)))) (de tyname () (get-tty 'name)) (de tyxmax () (get-tty 'xmax)) (de tyymax () (get-tty 'ymax)) (de tyupkey () (get-tty 'up)) (de tydownkey () (get-tty 'down)) (de tyleftkey () (get-tty 'left)) (de tyrightkey () (get-tty 'right)) ; .Section "Fonctions et Variables par de'faut" (de #:tty:tyerror (appel) ()) (de #:tty:typrologue ()) (de #:tty:tyepilogue ()) (de #:tty:tycleol () (tyerror '(tycleol))) (de #:tty:tycleos () (tyerror '(tycleos))) (de #:tty:tybeep () (tyo #^G)) (de #:tty:tyinsch (cn) (tyerror (list 'tyinsch cn))) (de #:tty:tyinscn (cn) (tyerror (list 'tyinscn cn))) (de #:tty:tydelch () (tyerror '(tydelch))) (de #:tty:tydelcn (cn) (tydelch)) (de #:tty:tyinsln () (tyerror '(tyinsln))) (de #:tty:tydelln () (tyerror '(tydelln))) (de #:tty:tyattrib (i) (tyerror (list 'tyattrib i))) (de #:tty:tybs (cn) (tyo #\bs)) (de #:tty:tycr () (tyo #\cr)) (de #:tty:tyshowcursor (i) (tyerror (list 'tyshowcursor i))) (defvar #:tty:tyattrib ()) (defvar #:tty:tyshowcursor ()) (defvar #:tty:name 'dumb) (defvar #:tty:xmax 79) (defvar #:tty:ymax 23) (defvar #:tty:up #^P) (defvar #:tty:down #^N) (defvar #:tty:left #^B) (defvar #:tty:right #^F) ; .SSection "Les fonctions compose'es" (de tyco (x y cn . l) (tycursor x y) (tyo cn) (while l (tyo (nextl l)))) (de tycot (x y cn . l) (tycursor x y) (tyattrib t) (tyo cn) (while l (tyo (nextl l))) (tyattrib ())) ; .Section "La fonction initty" (de initty term ; on cherche et on charge le vrai nom de terminal (setq #:tty:name (symbol () (cond ((consp term) ; l'argument fourni (car term)) ((getenv "TERM")) ((system))))) ; on regarde si l'on n'aurait pas de'ja` fait initty ; sur le me^me terminal physique. (unless (and #:sys-package:tty (equal (string #:tty:name) (string #:sys-package:tty))) (let ((file (catenate #:system:virtty-directory #:tty:name #:system:lelisp-extension))) ; on essaye de charger le fichier relatif au terminal (if (probefile file) (loadfile file t) (or (consp (catcherror t ; on charge le traducteur termcap -> virtty (libload termcap) ; on effectue la traduction ; ne pas foutre en l'air le FUNCALL (funcall '#:termcap:compile #:tty:name file) ; on decharge le traducteur (mapc 'remob (oblist 'termcap)) ; on charge le fichier traduit (loadfile file t))) (consp (catcherror t ; on charge le traducteur terminfo -> virtty (libload terminfo) ; on effectue la traduction ; ne pas foutre en l'air le FUNCALL (funcall '#:terminfo:compile #:tty:name file) ; on decharge le traducteur (mapc 'remob (oblist 'terminfo)) ; on charge le fichier traduit (loadfile file t))))) #:tty:name)))