; .EnTete "Le-Lisp (c) version 15.2" " " "L'e'diteur vide'o minimum PEPE"
; .EnPied "pepe.ll" "M-%" " "
; .Annexe M "L'e'diteur vide'o minimum PEPE"
; .nr % 1
;
; .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: pepe.ll,v 4.2 88/11/23 10:44:11 gallou Exp $"
(unless (>= (version) 15.21)
(error 'load 'erricf 'pepe))
; Tous les symboles pre'ce'de's de : seront cre'e's dans le package PEPE.
(defvar #:sys-package:colon 'pepe)
(add-feature 'pepe)
; PEPE est l'e'diteur minimum de Le←Lisp version 15.2.
; Il permet d'e'diter des fichiers ou n'importe quelle
; expression Lisp. Il fonctionne sur tout terminal vide'o
; qui doit au moins permettre l'effacement de tout
; l'e'cran et le positionnement absolu du curseur.
; Le tampon de PEPE est une liste de chai↑nes de caracte`res,
; chacunes d'elles repre'sentant une ligne.
; Cette repre'sentation qui a le me'rite de la simplicite'
; entrainera la fabrication d'une nouvelle chai↑ne pour chaque
; caracte`re tape'.
; PEPE, tout comme EMACS, garde les proprie'te's suivantes\ :
; - e'crit entie`rement en Lisp
; - extensible tre`s facilement
; - inde'pendant vis-a`-vis du mate'riel
; - reaffichage asynchrone.
; Le terminal virtuel doit e↑tre charge' et initialise'
; avant de lire ce fichier par exemple au moyen de :
; (initty)
; .Section "Les Variables Globales"
; La pre'sence de ces variables globales, empe↑che PEPE
; d'e↑tre reentrant.
(defvar :buffer ()) ; le tampon des lignes
(defvar :xcursor 0) ; X courant
(defvar :ycursor 0) ; Y courant
(defvar :column 0) ; colonne courante
(defvar :ydisplay 0) ; nume'ro de la 1e`re ligne visible
(defvar :file "tmp") ; nom du fichier courant
(defvar :commands ()) ; liste des commandes
(defvar :escommands ()) ; liste des ESC-commandes
(defvar :modbuf ()) ; indicateur de tampon modifie'
(defvar :kill ()) ; la chai↑ne du dernier kill
(defvar :searchstrg "") ; la chai↑ne de la dernie`re recherche
; Quelques DEFVAR supple'mentaires, pour s'accorder au nouveau comportement du
; compilateur : les utilisations de variables dynamiques doivent e↑tre voulues.
; ces 6 variables sont utilisees par :matchparent, :curlexnext, :curchar
(defvar :x) ; copie locale de Xcursor
(defvar :y) ; copie locale de Ycursor
(defvar :l) ; pointeur courant dans la ligne
(defvar :s) ; longueur actuelle de la ligne pointe'e par :l
(defvar :fm) ; la ligne courante
(defvar :char) ; le caracte`re courant dans la ligne
; ces 2 variables sont utilisees par pepefile, :[true]redisplay, :clrscreen,
; :fillminibuf[nb], :help et evalbuffer:eol
(defvar :oscreen) ; copie en memoire de l'e'cran
(defvar :nscreen) ;
; cette variable est utilise'e dans :evalbuffer et :evalbuffer:eol
(defvar :xy) ; sauvegarde de :-xmax-1 le temps d'e'valuer
; cette variable est utilise'e dans :redisplay et :fillminibufnb
(defvar :pos) ; position a` partir de laquelle on e'crira
; variables de'finies dans pepefile, figeant l'espace de la fene↑tre PEPE
(defvar :xmax)
(defvar :xmax+1)
(defvar :xmax/2+2)
(defvar :xmax/2-2)
(defvar :xmax+1*ymax)
(defvar :-xmax+1)
(defvar :ymax)
(defvar :ymax+1)
(defvar :ymax-1)
(defvar :ymax/2)
(defvar :ymax/4)
; .Section "La Boucle Principale"
(df pepe (:f)
; la forme FSUBRe'e de la fonction suivante
(pepefile :f))
(de pepefile (:f)
; la fonction qui e'value son nom de fichier
(let ((:xmax (tyxmax))
(:ymax (tyymax))
(:xmax+1 (add1 (tyxmax)))
(:-xmax+1 (sub 0 (add1 (tyxmax))))
(:xmax-1 (sub1 (tyxmax)))
(:xmax/2+2 (add (div (tyxmax) 2) 2))
(:xmax/2-2 (sub (div (tyxmax) 2) 2))
(:ymax+1 (add1 (tyymax)))
(:ymax-1 (sub1 (tyymax)))
(:ymax/2 (div (tyymax) 2))
(:ymax/4 (div (tyymax) 4))
(:xmax+1*ymax (mul (add1 (tyxmax)) (tyymax))))
(let ((:oscreen (makestring (mul :xmax+1 :ymax+1) #\SP))
(:nscreen (makestring (mul :xmax+1 :ymax+1) #\SP)))
(:clrscreen)
(ifn :f
(unless :buffer (setq :buffer (list "")))
(setq :file "tmp" :xcursor 0 :ycursor 0 :column 0 :ydisplay 0
:modbuf ())
(cond
((equal :f t) ; je veux un fichier scratch
(setq :buffer (list "")))
((atom :f) ; ce doit e↑tre un fichier qui existe
(tag eoc (setq :buffer (:readfile :f)))
(setq :file (string :f)))
(t ; c'est donc un PROGN a` e'valuer
(setq :buffer (list ""))
(let ((#:sys-package:itsoft ':eval))
(eval :f))
(setq :buffer (nreverse :buffer)))))
(typrologue)
;
; le top-level proprement dit de PEPE
;
(untilexit pepe
(tag eoc
(:redisplay)
(tycursor :xcursor :ycursor)
(:pepecmd (tyi))))
; je sors de PEPE : qu'Il soit avec vous!
(tycursor 0 :ymax)
(tycleol)
(tycursor 0 :ymax-1)
(tycleol)
(tyepilogue)
(tyflush)
'pepe))))))
(de :eval:eol ()
; re'cupe'ration de la ligne imprime'e
; s'il faut e'diter le re'sulat d'une e'valuation
(newl :buffer (substring (outbuf) 0 (outpos)))
(fillstring (outbuf) 0 #\SP (outpos))
(outpos (lmargin)))
; .Section "Les interpre`tes des commandes"
(de :pepecmd (c)
; interpre`te la commande <c>
; la A-liste des commandes se trouve dans :commands
(let ((l (cassq c :commands)))
(if l (eprogn l)
; ce n'est pas une commande
(if (lt c 32)
(:deadend)
(:insertchar c))))
(when (setq c (tys))
(:pepecmd c)))
(de :escommand ()
; L'interpre`te des commandes <esc> X
; la A-Liste des commandes se trouve dans :escommands
(let ((c (tyi)))
; passage en majuscule
(when (and (ge c #/a) (le c #/z))
(setq c (sub c 32)))
(let ((l (cassq c :escommands)))
(if l (eprogn l) (:deadend)))))
; .Section "Les fonctions d'affichage"
; A de rares exceptions, ces fonctions n'utilisent pas
; les fonctions du terminal virtuel mais la fonction de
; reaffichage asynchrone REDISPLAYSCREEN.
(de :redisplay ()
; reaffiche toute la fene↑tre visible
(fillstring :nscreen 0 #\SP)
(let ((y :-xmax+1)
(:pos (add :xmax+1*ymax :xmax/2-2))
(s (length :buffer))
(lib1 "Pepe: ")
(l (nthcdr :ydisplay :buffer)))
; affiche le texte
(repeat :ymax
(bltstring :nscreen (setq y (add y :xmax+1))
(car l) 0 :xmax+1)
(when (and (car l) (gt (slen (nextl l)) :xmax+1))
(sset :nscreen (add y :xmax) #/\)))
; affiche la "who-line"
(fillstring :nscreen :xmax+1*ymax #\SP :xmax)
(:fillminibuf 0 lib1)
(:fillminibuf (slen lib1) :file)
(:fillminibufnb s)
(sset :nscreen (setq :pos (sub1 :pos)) #//)
(:fillminibufnb (add1 (add :ydisplay :ycursor)))
; (setq :pos (sub1 :pos))
; (:fillminibufnb (slen (:currentline)))
; (sset :nscreen (setq :pos (sub1 :pos)) #//)
; (:fillminibufnb (add1 :xcursor))
(:fillminibuf :xmax/2-2 (if :modbuf " <M> " " "))
(:trueredisplay)))
(dmd :trueredisplay ()
`(redisplayscreen :nscreen :oscreen :xmax+1 :ymax+1))
(dmd :fillminibuf (x strg)
; e'crit dans la dernie`re ligne a` partir de <x> la chai↑ne <strg>
`(bltstring :nscreen (add :xmax+1*ymax ,x) ,strg 0))
(de :fillminibufnb (nb)
; e'crit dans :nscreen a` partir de <:pos> la valeur nume'rique <nb>
(sset :nscreen (setq :pos (sub1 :pos)) (add #/0 (rem nb 10)))
(when (ge nb 10)
(:fillminibufnb (div nb 10))))
(de :clrscreen ()
; efface tout l'e'cran
(tycursor 0 0)
(tycls)
(fillstring :oscreen 0 #\SP))
; .Section "Les fonctions de dialogue"
(de :more ()
; demande s'il faut continuer les impressions.
(slet ((prmpt " Encore? ")
(lenpr (slen prmpt)))
(:fillminibuf :xmax/2+2 prmpt)
(:trueredisplay)
(tycursor (add :xmax/2+2 lenpr) :ymax)
(unless (chrpos (tyi) " YyOoTt") (exit eoc))
(:fillminibuf :xmax/2+2 (makestring lenpr #\SP))))
(de :readname (strg)
; Lecture d'une chai↑ne sur le terminal
; <strg> est la chai↑ne d'invite
(:fillminibuf :xmax/2+2 strg)
(let ((l) (c) (p (add :xmax/2+2 (slen strg))))
(:trueredisplay)
(tycursor p :ymax)
(while (neq (setq c (tyi)) #↑M)
(cond ((eq c #↑G) (exit eoc ()))
((eq c #\BS)
(:fillminibuf (setq p (sub1 p)) " ")
(setq p (sub1 p))
(nextl l))
(t (:fillminibuf p (list c)) (newl l c)))
(:trueredisplay)
(tycursor (setq p (add1 p)) :ymax))
(if l (string (nreverse l)) (exit eoc "")))))
; .Section "Les Fonctions Auxiliaires"
(dmd :deadend ()
; fin de la route : on ne plus plus bouger!
`(progn (tybeep) (exit eoc)))
(dmd :currentline ()
; retourne la ligne courante
`(nth (add :ydisplay :ycursor) :buffer))
(dmd :currentlines ()
; retourne la liste commencant par la ligne courante
`(nthcdr (add :ydisplay :ycursor) :buffer))
(dmd :cursor (x y)
; change la position du curseur de PEPE
`(setq :xcursor ,x :ycursor ,y))
; .Section "Une Brouette de Pre'dicats Utiles"
(dmd :bolp ()
; teste si on se trouve en de'but de ligne
`(eqn :xcursor 0)))
(dmd :eolp ()
; teste si on se trouve en fin de ligne
`(ge :xcursor (slen (:currentline))))
(dmd :bobp ()
; teste si on se trouve en de'but de buffer
`(and (eqn :ydisplay 0) (eqn :ycursor 0)))
(dmd :eobp ()
; teste si on se trouve en fin de buffer
`(ge (add1 (add :ydisplay :ycursor)) (length :buffer)))
(dmd :bosp ()
; teste si on se trouve au de'but de l'e'cran
`(eqn :ycursor 0))
(dmd :eosp ()
; teste si on se trouve a` la fin de l'e'cran
`(ge :ycursor :ymax-1))
; .Section "Les Commandes de Base de PEPE"
(de :left ()
; un coup a` gauche
(ifn (:bolp)
(setq :column (setq :xcursor (sub1 :xcursor)))
(:up) (:endline)))
(de :right ()
; un coup a` droite
(ifn (:eolp)
(if (ge :xcursor :xmax)
(:deadend)
(setq :column (setq :xcursor (add1 :xcursor))))
(:begline)
(:down)))
(de :endline ()
; va a` la fin de la ligne
(setq :xcursor (imin (slen (:currentline)) :xmax)
:column :xcursor))
(de :begline ()
; va au de'but de la ligne
(setq :xcursor 0 :column 0)))
(de :up ()
; va a` la ligne pre'ce'dente
(if (:bobp)
(:deadend)
(ifn (:bosp)
(setq :ycursor (sub1 :ycursor)
:xcursor (imin :column
(slen (:currentline))))
(setq :ydisplay (sub :ydisplay (add1 :ymax/4))
:ycursor (add :ycursor :ymax/4))
(when (lt :ydisplay 0)
(setq :ydisplay 0 :ycursor 0)))
(setq :xcursor (imin :column (slen (:currentline))))))
(de :down ()
; va a` la ligne suivante
(if (:eobp)
(:deadend)
(if (:eosp)
(setq :ydisplay (add :ydisplay (add1 :ymax/4))
:ycursor (sub :ycursor :ymax/4))
(setq :ycursor (add1 :ycursor)))
(setq :xcursor (imin :column (slen (:currentline))))))
(de :nextscreen ()
; passe a` l'e'cran suivant
(when (gt (add :ydisplay :ymax-1) (length :buffer))
(:deadend))
(setq :ydisplay (add :ydisplay :ymax-1))
(:begline))
(de :prevscreen ()
; passe a` l'e'cran pre'ce'dent
(when (lt (setq :ydisplay (sub :ydisplay :ymax-1)) 0)
(setq :ydisplay 0))
(:begline))
(de :insertchar (c)
; rajoute le caracte`re <c> a` la position courante
; re`gle le pb du bltstring a` droite sur la me↑me chai↑ne.
(let* ((l (:currentlines))
(s (catenate " " (car l))))
(if (ge :xcursor :xmax)
(:deadend)
(bltstring s 0 s 1 :xcursor)
(sset s :xcursor c)
(rplaca l s))
(setq :column (setq :xcursor (add1 :xcursor)))
(setq :modbuf t)))
(de :deletechar ()
; enle`ve le caracte`re a` la position du curseur
(let ((l (:currentlines))
(s))
(if (:eolp)
(rplac l (catenate (car l) (cadr l)) (cddr l))
(setq s (makestring (sub1 (slen (car l))) #\SP))
(bltstring s 0 (car l) 0 :xcursor)
(bltstring s :xcursor (car l) (add1 :xcursor))
(rplaca l s)))
(setq :modbuf t))
(de :breakline ()
; casse la ligne a` la position du curseur
(let ((l (:currentlines)))
(ifn (:eolp)
(rplac l (substring (car l) 0 :xcursor)
(cons (substring (car l) :xcursor) (cdr l)))
(rplacd l (cons "" (cdr l))))
(setq :modbuf t)))
(de :killine ()
; de'truit la ligne courante
(setq :modbuf t)
(cond ((:bobp)
(setq :kill (nextl :buffer))
(when (null :buffer)
(setq :buffer (list ""))))
((:eobp)
(let ((l (nthcdr (sub1 (add :ydisplay :ycursor)) :buffer)))
(setq :kill (cadr l))
(rplacd l (cddr l))
(:up)))
(t (let ((l (:currentlines)))
(setq :kill (car l))
(rplac l (cadr l) (cddr l)))))
(when (lt (slen (:currentline)) :xcursor)
(:endline))))
; .Section "Les Fonctions de Recherche"
(de :search ()
; cherche une chai↑ne de caracte`res
(let ((s (tag eoc (:readname " Chaine? ")))
(f (:currentlines))
(y 0)
(r))
(cond ((null s) (exit eoc))
((eqstring s "") (setq s :searchstrg))
(t (setq :searchstrg s)))
(setq r (index s (nextl f) :xcursor))
(untilexit search
(cond
(r (:gotoabs (add r (slen s)) y)
(exit search))
((null f) (:deadend))
(t (setq r (index s (nextl f) 0)
y (add1 y)))))))
(de :gotoabs (x y)
; se positionne en <x> et <y> du tampon
; <y> est en relatif par rapport a` :ycursor
; Si ce n'est pas sur l'e'cran se positionne au
; milieu de la fene↑tre visible.
(setq :xcursor x :column x)
(let ((y (add :ycursor y)))
(if (gt y :ymax-1)
(setq :ydisplay (sub (add :ydisplay y) :ymax/2)
:ycursor :ymax/2)
(setq :ycursor y))))
(de :matchparent (c)
; Ve'rificateur de parenthe`ses a` la Lisp
; <c> peut e↑tre une parenthe`se ou un crochet.
(slet ((:fm (:currentlines))
(:x :xcursor)
(:y 0)
(:l (nextl :fm))
(:s (slen :l))
(:char))
(until (eqn (:curlexnext) c))
(:gotoabs :x :y)))
(de :curlexnext ()
(selectq (:curchar)
(#/( (until (eqn (:curlexnext) #/))) #/()
(#/[ (until (eqn (:curlexnext) #/])) #/[)
(#/| (until (eqn (:curchar) #/|)) #/|)
(#/" (until (eqn (:curchar) #/")) #/")
(#/# (selectq (:curchar)
((#/( #/[ #/") (:curlexnext))
(#// (:curchar) #//)
(t :char)))
(#/; (setq :x :s) (:curlexnext))
(t :char)))
(de :curchar ()
(while (ge :x :s)
(if (null :fm)
(:deadend)
(setq :x 0
:y (add1 :y)
:l (nextl :fm)
:s (slen :l))))
(setq :char (sref :l :x)
:x (add1 :x))
:char)
; .Section "Les Fonctions sur les Fichiers"
(de :readfile (f)
; Lecture d'un fichier : retourne une liste (non vide)
; de lignes d'au plus :xmax caracte`res.
(let ((ll)
(in (probefile f)))
(if in
; c'est un fichier connu
(with ((inchan (openi f)))
(inmax 0)
(untilexit eof (newl ll (readstring)))
(if (consp ll) (nreverse ll) (list "")))
; c'est un nouveau fichier
(tybeep) ; pour indiquer une cre'ation!
(list ""))))
(de :writefile (f)
; Ecriture d'un fichier
(let ((out (catcherror () (openo f))))
(unless (consp out) (:deadend))
(with ((outchan (car out))
(lmargin 0)
(rmargin (sub1 (slen (outbuf)))))
(let ((:xcursor :xcursor)
(:ycursor :ycursor)
(#:system:print-for-read ()))
(:cursor 0 :ymax)
(mapc 'print :buffer))
(close (outchan))) ; Redde Caesari quae sunt Caesaris !
(setq :modbuf ())))
(de :insertfile ()
; Insert un fichier a` la position du curseur.
(let ((l (:currentlines)))
(rplacd l (nconc (:readfile (:readname " Fichier? "))
(cdr l)))
(setq :modbuf t)))
(de :backup ()
; change le nom de :file en :file.BAK
; a` utiliser avant un :write
(when (probefile :file)
(let ((i (index "." :file)) (:backup))
(setq :backup
(catenate (if i (substring :file 0 i) :file) ".BAK"))
(renamefile :file :backup))))
(de :help ()
; affiche un aide me'moire des commandes.
(let ((:ycursor :ycursor)
(y :-xmax+1)
(in))
(unless (catcherror ()
(setq in (openi (catenate #:system:llib-directory
'pepehelp
#:system:lelisp-extension))))
(:deadend))
(:clrscreen)
(with ((inchan in))
(fillstring :nscreen 0 #\SP)
(untilexit eof
(bltstring :nscreen (setq y (add y :xmax+1))
(readstring) 0 :xmax+1)))
(:fillminibuf 0 "Aide memoire de PEPE"))
; attend la frappe d'un caracte`re pour continuer
(tag eoc (:more))
(:clrscreen))
; .Section "Les Autres Fonctions"
(de :evalbuffer ()
; Evaluation de tout le tampon sans sortir de PEPE
; inde'pendant du format des lignes.
; Toutes les impressions vont sur le terminal tre`s proprement
(let ((#:sys-package:itsoft ':evalbuffer)
(:buffer :buffer) ; sauvetage du tampon
(:xy :-xmax+1))
(with ((lmargin 0)
(rmargin :xmax-1))
(tycursor 0 0)
(tyflush)
(catcherror (untilexit eoc (print "=> " (eval (read)))))
(teread)
(:more))))
(de :evalbuffer:bol ()
; nouvelle ligne en entre'e sous EVALBUFFER
(ifn :buffer
(exit eoc)
(let* ((l (nextl :buffer))
(n (slen l)))
(bltstring (inbuf) 0 l)
(sset (inbuf) n #\CR)
(sset (inbuf) (setq n (add1 n)) #\LF)
(inmax (setq n (add1 n))))))
(de :evalbuffer:syserror (f m b)
(printerror f m b)
(exit eoc))
(de :evalbuffer:eol ()
; ITSOFT fin de ligne sous EVALBUFFER
(fillstring :nscreen (setq :xy (add :xy :xmax+1)) #\SP :xmax+1)
(bltstring :nscreen :xy (outbuf) 0 (outpos))
(fillstring (outbuf) 0 #\SP (outpos))
(outpos (lmargin))
(when (ge :xy (mul :xmax+1 :ymax-1))
(:more)
(setq :xy :-xmax+1)))
; .Section "Initialisation des Clefs"
(dmd defkey (k . f) `(newl :commands (cons ,k ',f)))
(progn
(defkey #↑A (:begline))
(defkey #:tty:left (:left))
(defkey #↑C (exit pepe))
(defkey #↑D (:deletechar))
(defkey #↑E (:endline))
(defkey #:tty:right (:right))
(defkey #↑G (:deadend))
(defkey #↑H (:left)
(:cursor :xcursor :ycursor)
(:deletechar))
(defkey #↑K (:killine))
(defkey #↑L (:clrscreen))
(defkey #↑M (:breakline) (:right))
(defkey #:tty:down (:down))
(defkey #↑O (:breakline))
(defkey #:tty:up (:up))
(defkey #↑S (:search))
(defkey #↑V (:clrscreen) (:nextscreen))
(defkey #↑Y (:breakline)
(:cursor :xcursor :ycursor)
(mapc ':insertchar
(pname :kill)))
(defkey #$7F (:left)
(:cursor :xcursor :ycursor)
(:deletechar))
(defkey 27 (:escommand))
)
(df defesckey (k . f) (newl :escommands (cons k f)))
(progn
(defesckey #/E (:evalbuffer))
(defesckey #/F (setq :file
(:readname " Nom du fichier? ")))
(defesckey #/I (:insertfile))
(defesckey #/R (setq :file (:readname " Fichier? ")
:buffer (:readfile :file)
:xcursor 0 :ycursor 0
:column 0 :ydisplay 0
:modbuf ()))
(defesckey #/S (:backup) (:writefile :file))
(defesckey #/V (:clrscreen) (:prevscreen))
(defesckey #/W (:writefile (:readname " Fichier? ")))
(defesckey #/X (apply (or (getfn '#.#:sys-package:colon
(concat (:readname
" Fonction? ")))
':deadend)
()))
(defesckey #/Z (:writefile :file)
(tycursor 0 :ymax)
(loadfile :file t)
(exit pepe))
(defesckey #/) (:matchparent #/())
(defesckey #/] (:matchparent #/[))
(defesckey #/< (:clrscreen)
(setq :ydisplay 0 :xcursor 0 :ycursor 0 :column 0))
(defesckey #/> (:clrscreen)
(setq :ycursor (length :buffer)
:ydisplay (imax 0 (sub :ycursor :ymax/2))
:ycursor (sub1 (sub :ycursor :ydisplay)))
(:endline))
(defesckey #/? (:help))
))
; .Section "Pour Re'cupe'rer la Place de PEPE"
(de pepend ()
; de'truit tous les symboles de :...
(mapc 'remob (oblist '#.#:sys-package:colon))
; enle`ve le trait PEPE
(rem-feature 'pepe)
; rede'finit les fonctions autoload
(libautoload pepe pepe pepefile))