Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv24325

Modified Files: los0.lisp Log Message: Tweaked the implementation of :more.

Date: Mon Jul 12 01:41:23 2004 Author: ffjeld

Index: movitz/losp/los0.lisp diff -u movitz/losp/los0.lisp:1.17 movitz/losp/los0.lisp:1.18 --- movitz/losp/los0.lisp:1.17 Mon Jul 12 01:00:06 2004 +++ movitz/losp/los0.lisp Mon Jul 12 01:41:23 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 1 18:08:32 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: los0.lisp,v 1.17 2004/07/12 08:00:06 ffjeld Exp $ +;;;; $Id: los0.lisp,v 1.18 2004/07/12 08:41:23 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -808,20 +808,32 @@ (defmacro with-paging (options &body body) (declare (ignore options)) `(block paging - (let ((*paging-offset* 2)) + (let ((paging-offset 2)) (handler-bind ((newline (lambda (condition) (declare (ignore condition)) - (when (>= (incf *paging-offset*) - muerte.x86-pc::*screen-height*) - (format t "~&more? ") - (loop + (when (and paging-offset + (>= (incf paging-offset) + muerte.x86-pc::*screen-height*)) + (format t "~&more? (y/n/a) ") + (prog () + loop (case (muerte.x86-pc.keyboard:poll-char) - ((#\esc #\n #\N) + ((#\esc) + (break "Console pager")) + ((#\n #\N) ; No more (return-from paging (values))) - ((#\y #\Y #\space #\newline) - (setf *paging-offset* 1) - (return)))))))) + ((#\a #\A) ; Quit paging + (setf paging-offset nil)) + ((#\newline #\x) + (setf paging-offset + (1- muerte.x86-pc::*screen-height*))) + ((#\y #\Y #\space) ; One more page + (setf paging-offset 1)) + (t (go loop)))) + (write-char #\return) + (clear-line *standard-output* 0 (cursor-y *standard-output*)) + )))) ,@body))))

(defun tp (x) (dotimes (i x) (print i)))