; .EnTete "Le-Lisp (c) version 15.2" "" "Le contro↑leur d'impression minimum"
; .EnPied "minimore.ll" "N-%" " "
; .Annexe N "Le contro↑leur d'impression minimum"
; .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: minimore.ll,v 4.1 88/01/13 12:22:40 kuczynsk Rel $"

(unless (>= (version) 15.2)
        (error 'load 'erricf 'minimore))

; Le mini contro↑leur d'impression : MINIMORE mais il fait le MAXIMORE!

(defvar #:sys-package:colon 'minimore)

(defvar :count (tyymax))
(defvar :string "--More--")

(de  more ()
     ; rentre dans MORE
     (unless (memq 'minimore #:sys-package:itsoft)
             (setq #:sys-package:itsoft
                   (cons  'minimore #:sys-package:itsoft))))

(de  morend ()
     ; sort de MORE
     (setq #:sys-package:itsoft
           (delq 'minimore #:sys-package:itsoft)))

(de  :bol ()
     ; a` chaque lecture d'une nouvelle ligne sur le terminal
     ; je repositionne le compteur.
     (when (null (inchan)) 
           (setq :count (tyymax)))
     (super-itsoft '#.#:sys-package:colon 'bol ()))

(de  :eol ()
     ; a` chaque impression d'une nouvelle ligne sur le terminal
     ; je compte et j'interpre`te.
     (when (null (outchan))
           (when (eq :count 0)
                 (tystring :string (slen :string))
                 (selectq (tyi)
                     ((#↑M #↑J)
                          ; affiche une seule ligne
                          (setq :count 1))
                     (#↑D ; affiche un demi e'cran
                          (setq :count (div (tyymax) 2)))
                     (#/  ; affiche un e'cran entier
                          (setq :count (tyymax)))
                     (#/q ; sort de MORE
                          (setq :count (tyymax))
                          (for (i (sub1 (slength :string)) -1 0)
                               (tyback (chrnth i :string)))
                          (fillstring (outbuf) 0 #\sp (outpos))
                          (outpos 0)
                          (exit #:system:toplevel-tag))
                     (t (setq :count 1)))
                 ; efface la chai↑ne "encore"
                 (for (i (sub1 (slength :string)) -1 0)
                      (tyback (chrnth i :string))))
            (setq :count (sub1 :count)))
     ; repasse au papa ...
     (super-itsoft '#.#:sys-package:colon 'eol ()))