Commit 29d8b60b authored by Pascal J. Bourguignon's avatar Pascal J. Bourguignon

Updated copyright date. Some debugging. Added pagination. CFFI structures must...

Updated copyright date. Some debugging. Added pagination. CFFI structures must be referenced with :struct.  Generalized some terminal methods.
parent d123a4b1
-*- mode:rst; coding:utf-8 -*-
-*- mode:org; coding:utf-8 -*-
00001:
* TODO: 00003 FAIRE n POUR I_1 JUSQUA 100 doesn't work.
::
#+BEGIN_SRC(lse)
1 FAIRE 10 POUR I_1 JUSQUA 100
2 AFFICHER[C,20X,C,U]I
3 T_TEM()
4 SI T=TEM() ALORS ALLER EN 4
5 AFFICHER['.']
10* fin faire
20 TERMINER
#+END_SRC
#+BEGIN_SRC(lse)
EXECUTER A PARTIR DE 1
1 .
TERMINE EN LIGNE 020
#+END_SRC
* TODO: 00001 segfault
#+BEGIN_SRC(lse)
PRET
^Gau
AU REVOIR 02:52:54
......@@ -17,18 +34,15 @@
;;; #<PROCESS Initial(0) [Active] #x1805D45E> requires access to Shared Terminal Input
;;; Type (:y 0) to yield control to this thread.
;;;
#+END_SRC
00002:
We should add a timeout and disconnect if no input occurs after that delay.
* TODO: 00002 add a timeout and disconnect if no input occurs after that delay.
There seem to be scanners who connect to ports without sending
anything, and keeping the ports open indefinitely. For example:
::
#+BEGIN_SRC(lse)
11:21:15.325617 IP 193.49.123.6.51872 > voyager.informatimago.com.8115: Flags [S], seq 1980334663, win 65535, options [mss 1460,nop,wscale 4,nop,nop,TS val 1368891875 ecr 0,sackOK,eol], length 0
E..@
'@./.nN.1{.X.>E....v .G.......................
......@@ -104,3 +118,5 @@
tcp 0 0 88.198.62.69:8115 82.123.168.209:51062 ESTABLISHED 21410/lse
tcp 0 0 88.198.62.69:8115 109.190.38.230:49716 ESTABLISHED 12126/lse
tcp 0 0 88.198.62.69:8115 92.163.81.111:62166 ESTABLISHED 25565/lse
#END_SRC
......@@ -3,3 +3,4 @@
# sudo apt-get install libfixposix-dev
git clone https://github.com/marsijanin/iolib.termios.git
git clone https://github.com/sionescu/libfixposix.git
......@@ -16,7 +16,7 @@
#LEGAL
# AGPL3
#
# Copyright Pascal J. Bourguignon 2012 - 2012
# Copyright Pascal J. Bourguignon 2012 - 2014
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU Affero General Public License as published by
......@@ -63,7 +63,7 @@ LOAD = $(CCL_LOAD)
EVAL = $(CCL_EVAL)
HELPFORMAT="$(MAKE) %-20s \# %s\n"
HELPFORMAT="$$(basename $(MAKE)) %-20s \# %s\n"
help::
@printf $(HELPFORMAT) all 'builds all executables on all hosts.'
......@@ -77,7 +77,7 @@ all:ChangeLog
help::
@printf $(HELPFORMAT) ChangeLog 'Extracts the logs from git into the ChangeLog file.'
@printf $(HELPFORMAT) ChangeLog 'extracts the logs from git into the ChangeLog file.'
ChangeLog:.git
git log > ChangeLog
#ChangeLog:../_FOSSIL_
......@@ -92,7 +92,7 @@ cli:
$(SYMLINK_CLI)
help::
@printf $(HELPFORMAT) macosx 'builds the unix cli executable and the MacOSX application bundle.'
@printf $(HELPFORMAT) macosx 'builds the unix cli executable and the MacOSX application bundle.'
macosx:cli
$(MAKE) -C macosx
......
-0.06999577
\ No newline at end of file
-0.09899583
\ No newline at end of file
......@@ -16,7 +16,7 @@
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2012 - 2013
;;;; Copyright Pascal J. Bourguignon 2012 - 2014
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
......
......@@ -22,7 +22,7 @@
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2000 - 2013
;;;; Copyright Pascal J. Bourguignon 2000 - 2014
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
......
......@@ -16,7 +16,7 @@
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2012 - 2013
;;;; Copyright Pascal J. Bourguignon 2012 - 2014
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
......@@ -218,7 +218,7 @@ lse complétant: B O [XOFF] --> BONJOUR.
| || NASIUM L.S.E.
| || LANGAGE SYMBOLIQUE D'ENSEIGNEMENT
| || VERSION 1.0.0-0.272-CL-UNIX
| || COPYRIGHT 1984 - 2012 PASCAL BOURGUIGNON
| || COPYRIGHT 1984 - 2014 PASCAL BOURGUIGNON
| ||
| || DISTRIBUE SELON LES TERMES DE LA LICENCE AGPLv3.
| ||
......@@ -649,7 +649,7 @@ http://fr.wikipedia.org/wiki/LSE_(langage_de_programmation)
"
Système L.S.E
Copyright (C) 2013 Pascal Bourguignon
Copyright (C) 1984 - 2014 Pascal Bourguignon
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as
......@@ -1354,8 +1354,8 @@ nil représente le vide.
;;;
(defchapter "INSTRUCTIONS"
(write-documentation *task*
"Voici la liste des instructions disponibles.
(write-documentation *task*
"Voici la liste des instructions disponibles.
Taper DO)CUMENTATION <instruction> pour avoir la documentation de
chaque instruction:
......@@ -1373,8 +1373,8 @@ chaque instruction:
(defchapter "FONCTIONS"
(write-documentation *task*
"Voici la liste des fonctions disponibles.
(write-documentation *task*
"Voici la liste des fonctions disponibles.
Taper DO)CUMENTATION <fonction> pour avoir la documentation de
chaque fonction.
......@@ -1383,13 +1383,13 @@ chaque fonction.
(title-width (reduce (function max) chapters
:key (compose length chapter-title)
:initial-value 0)))
(dolist (chapter chapters)
(when (stringp (chapter-text chapter))
(let ((syntax (first-line (chapter-text chapter)))
(title (chapter-title chapter))
(oneliner (chapter-oneliner chapter)))
(io-format *task* "~VA ~A~@[, ~A~];~%"
title-width title syntax oneliner))))))
(dolist (chapter chapters)
(when (stringp (chapter-text chapter))
(let ((syntax (first-line (chapter-text chapter)))
(title (chapter-title chapter))
(oneliner (chapter-oneliner chapter)))
(io-format *task* "~VA ~A~@[, ~A~];~%"
title-width title syntax oneliner))))))
;;;; THE END ;;;;
......@@ -16,7 +16,7 @@
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2012 - 2013
;;;; Copyright Pascal J. Bourguignon 2012 - 2014
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
......@@ -42,17 +42,30 @@
(output-accented t)
(output-no-bell nil)
(modern-mode t)
(return-is-xoff nil))
(return-is-xoff nil)
(pager t))
(defun boolean-enval (var default)
(let ((val (getenv var)))
(if val
(not (not (find val '("T" "Y" "TRUE" "YES" "1") :test (function string-equal))))
(not (not (find val '("T" "Y" "TRUE" "YES" "O" "OUI" "1") :test (function string-equal))))
default)))
(defun boolean-or-integer-enval (var default)
(let ((val (getenv var)))
(if val
(cond
((find val '("T" "Y" "TRUE" "YES" "O" "OUI" "1") :test (function string-equal))
t)
((find val '("NIL" "N" "FALSE" "NO" "NON" "0") :test (function string-equal))
nil)
(t
(parse-integer val)))
default)))
(defun choice-enval (var default choices)
(let ((val (getenv var)))
(if val
......@@ -77,7 +90,8 @@ RETURN: A new OPTIONS structure instance.
:output-accented (boolean-enval "LSE_ACCENTED_OUTPUT" t)
:output-no-bell (boolean-enval "LSE_NO_BELL" nil)
:modern-mode (boolean-enval "LSE_MODERN_MODE" t)
:return-is-xoff (boolean-enval "LSE_RETURN_IS_XOFF" nil)))
:return-is-xoff (boolean-enval "LSE_RETURN_IS_XOFF" nil)
:pager (boolean-or-integer-enval "LSE_PAGER" t)))
(defvar *options* (make-default-options))
......@@ -198,6 +212,11 @@ Indique s'il faut utiliser le mode moderne de saisi, ou le mode ancien
LSE_RETURN_IS_XOFF (NIL ou T, défaut: NIL)
Indique comment traiter la touche [ENTRÉE] dans le mode ancien.
Correspond aux options --entree-comme-xoff --return-is-xoff.
LSE_PAGER (NIL, T, ou un nombre de lignes; défaut: T)
Indique s'il faut pager les sorties sur le terminal. NIL indique pas
de pagination; T active la pagination en fonction de la taille du
terminal; un nombre active la pagination sur ce nombre de ligne.
"
"lse"))
......@@ -569,7 +588,7 @@ We have utf-8 and nasium-lse.terminal setup.
"
Permet d'effectuer la saisie des options de ligne de commande de
manière interactive, en pré-supposant l'usage avec Terminal.app et la
configuration nasium-lse.temrinal.
configuration nasium-lse.terminal.
"
(setf *options* (configuration-interactive-macosx-terminal *options*)))
......
......@@ -16,7 +16,7 @@
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2012 - 2013
;;;; Copyright Pascal J. Bourguignon 2012 - 2014
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
......@@ -43,7 +43,8 @@
"COM.INFORMATIMAGO.COMMON-LISP.UNIX.OPTION"
"COM.INFORMATIMAGO.LSE.OS"
"COM.INFORMATIMAGO.LSE"
"COM.INFORMATIMAGO.LSE.UNIX-TERMINAL")
"COM.INFORMATIMAGO.LSE.UNIX-TERMINAL"
"COM.INFORMATIMAGO.SIGNAL")
(:export "MAIN")
(:documentation "
This package contains the Command Line Interface to the LSE system:
......
......@@ -16,7 +16,7 @@
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2012 - 2013
;;;; Copyright Pascal J. Bourguignon 2012 - 2014
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
......@@ -116,66 +116,74 @@ BONJOUR ~8A
(defun main (&optional args)
(push #P "/usr/local/lib/" cffi:*foreign-library-directories*)
(setf *program-name* (or (program-name) *default-program-name*))
(setf *options* (make-default-options))
(set-lse-root)
(let ((encoding (locale-terminal-encoding)))
(set-terminal-encoding encoding)
(let* ((terminal-class (progn
#+swank
(cond
((typep (stream-output-stream *terminal-io*)
'swank-backend::slime-output-stream)
'swank-terminal)
((member (getenv "TERM") '("emacs" "dumb")
:test (function string=))
'standard-terminal)
(t #+unix 'unix-terminal
#-unix 'standard-terminal))
#-swank
(cond
((member (getenv "TERM") '("emacs" "dumb")
:test (function string=))
'standard-terminal)
(t #+unix 'unix-terminal
#-unix 'standard-terminal))))
(terminal (make-instance terminal-class
:input-stream (stream-input-stream *terminal-io*)
:output-stream (stream-output-stream *terminal-io*)))
(task (make-instance 'task
:state :active
:case-insensitive t
:upcase-output nil
:unicode (eql encoding :utf-8)
:arrows (if (eql encoding :utf-8)
:unicode-halfwidth
:ascii)
:terminal terminal)))
(setf *task* task) ; to help debugging, we keep the task in the global binding.
(or (parse-options (or args (arguments)))
;; parse-option may call show-bindings which calls
;; apply-options, so we need *task*.
(progn
(apply-options *options* *task*)
(terminal-initialize terminal)
(unwind-protect
(let* ((old-debugger-hook *debugger-hook*)
(*debugger-hook*
(lambda (condition debugger-hook)
;; We shouldn't come here.
(when debugger-hook
(terminal-finalize terminal))
(opt-format *debug-io* "~%My advice: exit after debugging.~%")
(when old-debugger-hook
(funcall old-debugger-hook condition debugger-hook)))))
(io-format *task* "~A" *tape-banner*)
(io-format *task* "~?" *title-banner* (list (version) *copyright*))
(io-format *task* "~?" *cli-banner* (list (subseq (dat) 9)))
(command-repl *task*))
(task-close-all-files *task*)
(terminal-finalize terminal)))
ex-ok))))
(handler-case
(progn
(push #P "/usr/local/lib/" cffi:*foreign-library-directories*)
(setf *program-name* (or (program-name) *default-program-name*))
(setf *options* (make-default-options))
(set-lse-root)
(let ((encoding (locale-terminal-encoding)))
(set-terminal-encoding encoding)
(let* ((terminal-class (progn
#+swank
(cond
((typep (stream-output-stream *terminal-io*)
'swank-backend::slime-output-stream)
'swank-terminal)
((member (getenv "TERM") '("emacs" "dumb")
:test (function string=))
'standard-terminal)
(t #+unix 'unix-terminal
#-unix 'standard-terminal))
#-swank
(cond
((member (getenv "TERM") '("emacs" "dumb")
:test (function string=))
'standard-terminal)
(t #+unix 'unix-terminal
#-unix 'standard-terminal))))
(terminal (make-instance terminal-class
:input-stream (stream-input-stream *terminal-io*)
:output-stream (stream-output-stream *terminal-io*)))
(task (make-instance 'task
:state :active
:case-insensitive t
:upcase-output nil
:unicode (eql encoding :utf-8)
:arrows (if (eql encoding :utf-8)
:unicode-halfwidth
:ascii)
:terminal terminal))
(*trace-output* (make-broadcast-stream)))
(setf *task* task) ; to help debugging, we keep the task in the global binding.
(or (parse-options (or args (arguments)) nil nil nil)
;; parse-option may call show-bindings which calls
;; apply-options, so we need *task*.
(progn
(apply-options *options* *task*)
(terminal-initialize terminal)
(unwind-protect
(let* ((old-debugger-hook *debugger-hook*)
(*debugger-hook*
(lambda (condition debugger-hook)
;; We shouldn't come here.
(when debugger-hook
(terminal-finalize terminal))
(opt-format *debug-io* "~%My advice: exit after debugging.~%")
(when old-debugger-hook
(funcall old-debugger-hook condition debugger-hook)))))
(with-pager *task*
(io-format *task* "~A" *tape-banner*)
(io-format *task* "~?" *title-banner* (list (version) *copyright*))
(io-format *task* "~?" *cli-banner* (list (subseq (dat) 9))))
(command-repl *task*))
(task-close-all-files *task*)
(terminal-finalize terminal)))
ex-ok))))
(error (err)
(format t "~&~A~%" err)
(finish-output)
ex-software)))
......@@ -257,7 +265,7 @@ BONJOUR ~8A
:ascii)
:terminal terminal)))
(setf *task* task) ; to help debugging, we keep the task in the global binding.
(or (parse-options (or args (arguments)))
(or (parse-options (or args (arguments)) nil nil nil)
;; parse-option may call show-bindings which calls
;; apply-options, so we need *task*.
(progn
......
......@@ -16,7 +16,7 @@
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2012 - 2013
;;;; Copyright Pascal J. Bourguignon 2012 - 2014
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
......
......@@ -16,7 +16,7 @@
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2012 - 2013
;;;; Copyright Pascal J. Bourguignon 2012 - 2014
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
......
......@@ -16,7 +16,7 @@
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2012 - 2013
;;;; Copyright Pascal J. Bourguignon 2012 - 2014
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
......
......@@ -16,7 +16,7 @@
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2012 - 2013
;;;; Copyright Pascal J. Bourguignon 2012 - 2014
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
......
......@@ -16,7 +16,7 @@
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2012 - 2013
;;;; Copyright Pascal J. Bourguignon 2012 - 2014
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
......
......@@ -19,7 +19,7 @@
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2012 - 2013
;;;; Copyright Pascal J. Bourguignon 2012 - 2014
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
......@@ -476,13 +476,12 @@ Bound by COMMAND-EVAL-LINE.")
(defmethod command-call ((command command))
(let ((gn (command-grammar command)))
(if gn
(apply (command-function command)
(converting-parser-errors
(funcall (command-parser command)
(io-read-line *task* :beep t))))
(funcall (command-function command)))))
(let ((arguments (when (command-grammar command)
(converting-parser-errors
(funcall (command-parser command)
(io-read-line *task* :beep t))))))
(with-pager *task*
(apply (command-function command) arguments))))
(defmethod all-commands ((group command-group))
......@@ -1037,6 +1036,13 @@ Voir les commandes SELECTIONNER RUBAN, RUBAN, PERFORER A PARTIR DE, ARCHIVER RUB
"Selectionne un ruban de l'étagère et le place dans le lecteur de ruban."
"Selectionne un ruban de l'étagère et le place dans le lecteur de ruban.
Un fichier ruban doit commencer par un titre sur la première ligne,
suivi des données.
Le titre est lu et affiché par cette commande; le reste des données
est lu par les commandes et instructions données par l'utilisateur ou
le programme.
Voir les commandes ETAGERE DE RUBAN, RUBAN, PERFORER A PARTIR DE, ARCHIVER RUBAN."
(io-new-line *task*)
(let ((path (catalog-pathname ruban "R")))
......@@ -1044,7 +1050,7 @@ Voir les commandes ETAGERE DE RUBAN, RUBAN, PERFORER A PARTIR DE, ARCHIVER RUBAN
(close (task-tape-input *task*)))
(setf (task-tape-input *task*) (open path :if-does-not-exist :error))
(io-format *task* "~&LE RUBAN ~:@(~A~) (~A) EST MIS EN PLACE.~%"
ruban (read-line (task-tape-input *task*)))))
ruban (read-line (task-tape-input *task*)))))
(defcommand "RUBAN" awake nil ()
......@@ -1900,8 +1906,8 @@ Voir les commandes TABLE DES FICHIERS, SUPPRIMER."
(io-format task "~%PRET~%")
(io-finish-output task))
(user-interrupt (condition)
#+developing
(io-format task "~%Condition: ~A~%" condition)
;; #+developing (io-format task "~%-Condition: ~A~%" condition)
(io-format task " ")
(io-standard-redirection task)
(echo)
(io-format task "~%PRET~%")
......
......@@ -19,7 +19,7 @@
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal Bourguignon 2005 - 2013
;;;; Copyright Pascal Bourguignon 2005 - 2014
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
......
1* COMPTE DE 1 A 100
10 I_1
15 SI I=100 ALORS ALLER EN 45
20 AFFICHER[C,20X,C,U]I
25 T_TEM()
30 SI T=TEM() ALORS ALLER EN 30
35 AFFICHER['.']
40 I_I+1;ALLER EN 15
45 TERMINER
......@@ -16,7 +16,7 @@
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal Bourguignon 2005 - 2013
;;;; Copyright Pascal Bourguignon 2005 - 2014
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
......@@ -64,7 +64,7 @@
(defparameter *password* "MAYER")
(defparameter *header* "EMULSE : L.S.E. [ EMULATION MITRA-15 ]")
(defparameter *copyright* "COPYRIGHT 1984 - 2013 PASCAL BOURGUIGNON")
(defparameter *copyright* "COPYRIGHT 1984 - 2014 PASCAL BOURGUIGNON")
;; (map nil (function ensure-directories-exist)
......
......@@ -16,7 +16,7 @@
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2012 - 2013
;;;; Copyright Pascal J. Bourguignon 2012 - 2014
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
......
......@@ -16,7 +16,7 @@
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2012 - 2013
;;;; Copyright Pascal J. Bourguignon 2012 - 2014
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
......
......@@ -23,7 +23,7 @@
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2000 - 2013
;;;; Copyright Pascal J. Bourguignon 2000 - 2014
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
......
......@@ -26,7 +26,7 @@
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2012 - 2013
;;;; Copyright Pascal J. Bourguignon 2012 - 2014
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
......
......@@ -16,7 +16,7 @@
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal Bourguignon 2005 - 2013
;;;; Copyright Pascal Bourguignon 2005 - 2014
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
......@@ -541,15 +541,22 @@ Cette fonction évalue l'expression Common Lisp EXPR.
(*package* (find-package #-(and) "COMMON-LISP-USER"
"COM.INFORMATIMAGO.LSE")))
(handler-case
(let ((results (multiple-value-list (eval (read-from-string expr)))))
(let* ((results)
(output (with-output-to-string (out)
(let ((*standard-output* out)
(*error-output* out)
(*trace-output* out))
(setf results (multiple-value-list (eval (read-from-string expr))))))))
(io-format *task* "~&~A~&" output)
(when (plusp print)
(io-format *task* "~%--> ~{~S~^~% ~}~%" results))
(io-format *task* "~&--> ~{~S~^~% ~}~%" results))
(typecase (first results)
((or integer nombre chaine) (first results))
(t (prin1-to-string (first results)))))
(error (err)
(if (plusp noerr)
0.0
0.0 ; TODO: we should return '' when a string is expected.
(error err))))))
......
......@@ -16,7 +16,7 @@
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2012 - 2013
;;;; Copyright Pascal J. Bourguignon 2012 - 2014
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
......@@ -79,6 +79,7 @@
#-windows (asdf:run-shell-command "rm -rf ~S" (namestring dir)))
(ql:quickload :swank)
(ql:quickload *program-system*)
......
......@@ -16,7 +16,7 @@
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2012 - 2013
;;;; Copyright Pascal J. Bourguignon 2012 - 2014
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
......
......@@ -16,7 +16,7 @@
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2012 - 2013
;;;; Copyright Pascal J. Bourguignon 2012 - 2014
;;;;
;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
......
......@@ -16,7 +16,7 @@
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2012 - 2013
;;;; Copyright Pascal J. Bourguignon 2012 - 2014
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
......
......@@ -16,7 +16,7 @@
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2012 - 2013
;;;; Copyright Pascal J. Bourguignon 2012 - 2014
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
......
......@@ -22,7 +22,7 @@
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2000 - 2013
;;;; Copyright Pascal J. Bourguignon 2000 - 2014
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
......@@ -121,14 +121,53 @@
(terminal-carriage-return (task-terminal task))
(princ #\Return (task-output task))))
(defvar *page-height* nil "For the pager: number of lines in screen.")
(defvar *line-count* nil "For the pager: number of lines written so far.")
(defun call-with-pager (task thunk)
(let ((paging (task-paging task)))
(let ((*page-height* (case paging
((nil) nil)