; .EnTete "Le-Lisp (c) version 15.2" " " "Me'me'"
; .EnPied "meme.ll" "%" " "
; .SuperTitre "L'e'diteur me'me'"
;
; .Auteur "Bernard Serpette"
;
; .Centre "*****************************************************************"
; .Centre " (c) Le-Lisp est une marque de'pose'e de l'INRIA "
; .Centre "*****************************************************************"
;
; .Centre "$Header: meme.ll,v 4.1 88/01/13 12:35:37 kuczynsk Rel $"
(unless (>= (version) 15.2)
(error 'load 'erricf 'meme))
; .Section "L'e'diteur Me'me'"
; .SSection "Contenu."
; On de'finit ici un petit e'diteur a` la Emacs. Il est multi-e'cran,
; chaque e'cran posse`de sa ligne propre ligne d'information (wholine),
; tous les e'crans partagent la me↑me ligne de dialogue (qui est lui me↑me
; un e'diteur) et il est possible d'e'valuer une expression dans un e'cran.
; .SSection "De'clarations"
(defvar #:sys-package:colon '#:edit:editor:meme)
(add-feature 'meme)
(defstruct #.#:sys-package:colon
(wholine)
(wholinemap)
(locx 0)
(locy 0) )
; .SSection "Les variables globales"
; La liste des e'crans.
(defvar :list-editor ())
; .SSection "Fonction de lancement"
(defun meme f
(let ( (e ()) )
(if (and (null f) :list-editor)
(setq e (car :list-editor))
(setq :list-editor
(ncons (setq e (:make-meme-editor 0 0 (tyxmax) (tyymax)))) )
(when (setq f (car f))
(let ( (rf (probepathf f)) )
(ifn rf
(:file e f)
(FILE-READ e rf)
(:file e rf) ))))
(:rdpscreen e)
(edit-command-redisplay e ())
(untilexit meme
(tag no-redisplay (edit-command-redisplay e (tyi)))
(setq e (car :list-editor)) )
(tycursor 0 (tyymax))
'meme ))
(dmc ↑E ()
(if (eq (peekcn) 13)
'(meme)
`(meme ',(concat (readstring))) ))
; .SSection "Interface avec le re'affichage"
(defun :edit-drawcursor (e x y f)
(when f
(let ( (who (:wholine e)) (whomap (:wholinemap e)) )
(fillstring who 7 #\SP)
(when (ge (#:buffer:modif (:pbuffer e)) 4) (sset who 8 #/*))
(if (le (#:buffer:modif (:pbuffer e)) 1)
(bltstring who 10 "(RO)" 0)
(bltstring who 10 "(RW)" 0) )
(bltstring who 15 (:file e) 0)
(unless (eqstring who whomap)
(bltstring whomap 0 who 0)
(tycursor (:locx e) (add (:locy e) (:h e)))
(with ((tyattrib t)) (tyo whomap)) )
(tycursor (add x (:locx e)) (add y (:locy e))) )))
(defun :edit-redisplaystring (e x y s pos n)
(tycursor (add x (:locx e)) (add y (:locy e)))
(repeat n
(tyo (sref s pos))
(setq pos (add1 pos)) ))
(defun :edit-redisplaycleol (e x y n)
(tycursor (add x (:locx e)) (add y (:locy e)))
(tycleol) )
(defun :rdpscreen (ne)
(tycls)
(mapc
(lambda (e)
(WIN-CLEAR e)
(fillstring (:wholinemap e) 0 #\SP)
(unless (eq e ne)
(edit-command-redisplay e ()) ))
:list-editor ))
(defun :tycls (e)
(let ( (y (:locy e)) (x (:locx e)) )
(repeat (:h e)
(tycursor x y)
(tycleol)
(setq y (add1 y)) )))
; .SSection "Fonction de cre'ation et nouvelles cle's"
(defun :make-meme-editor (x y w h)
(let ( (e (:make)) (who (makestring w #\SP)) )
(init-editor e e w (sub1 h))
(:drawcursor e ':edit-drawcursor)
(:redisplaystring e ':edit-redisplaystring)
(:redisplaycleol e ':edit-redisplaycleol)
(:query e ':edit-query)
(:locx e x)
(:locy e y)
(bltstring who 0 "Editor:" 0)
(:wholine e who)
(:wholinemap e (makestring w #\SP))
(local-bind-to-ekey e #/c '(trap-meme . 0))
(local-bind-to-key e #↑L '(trap-meme . 1))
(local-bind-to-xkey e #/1 '(trap-meme . 2))
(local-bind-to-xkey e #/2 '(trap-meme . 3))
(local-bind-to-xkey e #/n '(trap-meme . 4))
(local-bind-to-xkey e #/p '(trap-meme . 5))
(local-bind-to-xkey e #↑V '(trap-meme . 6))
e ))
(defun trap-meme (e n)
(selectq n
(0 (:state e 0) (exit meme))
(1 (:rdpscreen e))
(2 (:unsplit-editor e))
(3 (:split-editor e))
(4 (:next-editor e))
(5 (:previous-editor e))
(6 (:visit-file e (:edit-query e "Visit File: " t))) ))
(defun :visit-file (e f)
(when f
(:split-editor e)
(BUF-UNLINK e)
(:file e (or (probepathf f) f))
(FILE-READ e (probepathf f))
(:tycls e) ))
(defun :previous-editor (e)
(let ( (l (nreverse :list-editor)) )
(setq :list-editor (cons (setq e (car l)) (nreverse (cdr l))))
(edit-command-redisplay e ())
(exit no-redisplay) ))
(defun :next-editor (e)
(setq :list-editor
(nreverse (cons (car :list-editor) (nreverse (cdr :list-editor)))) )
(setq e (car :list-editor))
(edit-command-redisplay e ())
(exit no-redisplay) )
(defun :unsplit-editor (e)
(init-editor e e (tyxmax) (sub1 (tyymax)))
(:locx e 0)
(:locy e 0)
(setq :list-editor (ncons e))
(:rdpscreen e)
(exit no-redisplay (edit-command-redisplay e ())) )
(defun :split-editor (e)
(if (le (:h e) 2)
(exit eoc "Your window is too small")
(let ( ne (h (:h e)) (w (:w e)) nh )
(setq nh (div (add1 h) 2) h (sub h nh))
(init-editor e e w h)
(setq ne
(:make-meme-editor (:locx e) (add1 (add h (:locy e))) w nh) )
(BUF-LINK ne e)
(:file ne (:file e))
(rplacd :list-editor (cons ne (cdr :list-editor)))
(fillstring (:wholinemap e) 0 #\SP)
(:tycls ne)
(edit-command-redisplay ne ()) )))
; .SSection "Interface avec un simple editeur de ligne."
; Sachant qu'a` chaque commande on demande d'effacer l'e'diteur de ligne
; on optimise en gardant l'e'tat courant de l'e'diteur de ligne (i.e.
; contient un message ou pas)
(defvar :clean-query? t)
(defun :edit-query (e msg fg)
(if fg
(let ( (ne (:make)) (n (slen msg)) )
(init-editor ne ne (tyxmax) 1)
(:drawcursor ne ':query-drawcursor)
(:redisplaystring ne ':edit-redisplaystring)
(:redisplaycleol ne ':edit-redisplaycleol)
(:locx ne n)
(:locy ne (tyymax))
(local-bind-to-key ne #↑G '(:trap-query . 0))
(local-bind-to-key ne #↑M '(:trap-query . 1))
(tycursor 0 (tyymax))
(tyo msg)
(tycleol)
(setq :clean-query? ())
(prog1
(untilexit query (edit-command-redisplay ne (tyi)))
(:xcursor e -1) ))
(unless (and (null msg) :clean-query?)
(tycursor 0 (tyymax))
(tycleol)
(ifn msg
(setq :clean-query? t)
(tyo msg)
(setq :clean-query? ()) )
(:xcursor e -1) )))
(defun :query-drawcursor (e x y f)
(when f (tycursor (add x (:locx e)) (add y (:locy e)))) )
(defun :trap-query (e n)
(selectq n
(0 (exit query ()))
(1 (exit query (LINE-GET e))) ))