anchor.diff:  		  2500000 3000000 3500000 4000000)
   		(logxor baud unix::tty-cbaudex)))))))
   
  -(defun tputs (string &rest args)
  +(defun terminal-size (&optional (stream *terminal-io*))
  +  (declare (type stream stream))
  +  #+CMU
  +  (alien:with-alien ((winsz (alien:struct unix:winsize)))
  +    (declare (optimize (ext:inhibit-warnings 3)))
  +    (if (unix:unix-ioctl (stream-fileno stream) unix:TIOCGWINSZ winsz)
  +	(values (alien:slot winsz 'unix:ws-row)
  +		(alien:slot winsz 'unix:ws-col))
  +	(values nil nil))))
  +
  +(defstruct padding time force line-multiplier)
  +
  +(defun decode-padding (string &optional (junk-allowed nil))
  +  "Decode padding from string.
  +
  +Return the values of
  +- padding time in milliseconds (could have a tenth)
  +- whether or not to force the padding
  +- whether or not to multiply by the lines affected
  +- end of padding #\> index into string
  +e.g. \"<10.5*/>\"   =>   (values (make-padding 10.5 T T) 7)
  +
  +Setting junk-allowed to t will decode a padding string
  +that does not start with #\<.
  +e.g. \"<10.5/>\"   => (values (make-padding 10.5 T NIL) 7)"
  +  (declare (type string string))
  +  (unless (find #\> string)
  +    (error "Invalid padding specification"))
  +  (do ((start (if junk-allowed
  +                  (1+ (position #\< string))
  +                  1))
  +       (time 0)
  +       (pad-end)
  +       (force)
  +       (line-multiplier))
  +      (pad-end
  +       (values (make-padding :time time :force force :line-multiplier line-multiplier) pad-end))
  +    (let ((c (elt string start)))
  +      (cond
  +        ((and (char= c #\*)
  +              (not line-multiplier))
  +         (setf line-multiplier t
  +               start (1+ start)))
  +        ((and (char= c #\/)
  +              (not force))
  +         (setf force t
  +               start (1+ start)))
  +        ((char= c #\>)
  +         (setf pad-end (1+ start)))
  +        ((and (digit-char-p (elt string start))
  +              (zerop time))
  +         (let* ((end (position-if-not #'digit-char-p string :start start))
  +                (ms (parse-integer string :start start :end end)))
  +           (if (char= (elt string end) #\.)
  +               (setf time (+ ms (* 0.1 (digit-char-p
  +                                        (elt string (1+ end)))))
  +                     start (+ end 2))
  +               (setf time ms
  +                     start end))))
  +        (t (error "Invalid padding specification"))))))
  +
  +(defun strings-and-delays (string)
  +  "Decompose the command string and delays into a list of
  +strings and delay time padding structs.
  +
  +The delay time entries are lists of the delay in milliseconds,
  +t or nil for / which indicates a delay time that needs to be forced,
  +and t or nil for * which indicates a multiplier for lines affected."
  +  (declare (type string string))
  +  (do ((strings-and-delays ())
  +       (start 0)
  +       (length (length string)))
  +      ((>= start length) (nreverse strings-and-delays))
  +    (let ((found (search "$<" string :start2 start)))
  +      (if found
  +          (progn
  +            (when (/= found start)
  +              (push (subseq string start found)
  +                    strings-and-delays)
  +              (setf start found))
  +            (multiple-value-bind
  +                  (padding end)
  +                (decode-padding (subseq string (1+ found)))
  +              (push padding strings-and-delays)
  +              (incf start (1+ end))))
  +          (return (append (nreverse strings-and-delays)
  +                          (list (subseq string start))))))))
  +;; TI> (ti::strings-and-delays "A{3}$<10.5*>B{2}")
  +;; ("A{3}" #S(PADDING :TIME 10.5 :FORCE NIL :LINE-MULTIPLIER T) "B{2}")
  +;; TI> (ti::strings-and-delays "A{3}$<10.5*>B{2}$<5>c")
  +;; ("A{3}" #S(PADDING :TIME 10.5 :FORCE NIL :LINE-MULTIPLIER T) "B{2}"
  +;;  #S(PADDING :TIME 5 :FORCE NIL :LINE-MULTIPLIER NIL) "c")
  +;; TI> (ti::strings-and-delays "A{3}$<10.5*>B{2}$<5/>c")
  +;; ("A{3}" #S(PADDING :TIME 10.5 :FORCE NIL :LINE-MULTIPLIER T) "B{2}"
  +;;  #S(PADDING :TIME 5 :FORCE T :LINE-MULTIPLIER NIL) "c")
  +;; TI> (ti::strings-and-delays "A{3}")
  +;; ("A{3}")
  +
  +(defun print-padding (padding &key
  +                                stream
  +                                baud-rate (affected-lines 1)
  +                                (terminfo *terminfo*))
  +  "Print a padding definition to the stream depending
  +on the capability of the terminfo data. 
  +
  +If stream is nil, the padding characters or delay time
  +in ms will be returned.  If a stream is provided, the
  +padding characters will be written, or the function will
  +sleep for the specified time."
  +  (declare (type padding padding))
  +  ;; Decide whether to apply padding:
  +  (when (or (padding-force padding)
  +            ;; TODO: capability doesn't indicate activation...
  +            (not (capability :xon-xoff terminfo)))
  +    (when (let ((pb (capability :padding-baud-rate terminfo)))
  +            (and baud-rate (or (null pb) (> baud-rate pb))))
  +      (cond ((capability :no-pad-char terminfo)
  +             (if stream
  +                 (progn (finish-output stream)
  +                        (sleep (* (padding-time padding) 0.001 affected-lines)))
  +                 (* (padding-time padding) affected-lines)))
  +            (t
  +             (let ((tmp (capability :pad-char terminfo))
  +                   (null-count (ceiling (* baud-rate (padding-time padding) 1000 affected-lines) 100000)))
  +               (let ((pad (or (and tmp (schar tmp 0))
  +                              #\Null)))
  +                 (if stream
  +                     (dotimes (i null-count)
  +                       (princ pad stream))
  +                     (make-string null-count :initial-element pad)))))))))
  +
  +(defmacro tputs (string &rest args)
  +  "Given a string and its arguments, compose the appropriate command 
  +for the terminfo terminal and put it into the stream, or return
  +a list of strings and delay times when stream is nil.
  +Keyword arguments are passed on to the executing function, and include:
  + (terminfo *terminfo*)
  + (stream *terminal-io*)
  + baud-rate
  + (affected-lines 1))
  +"
  +    ;; There's got to be a better way...
  +  (let ((args (subseq args 0 (position-if #'keywordp args)))
  +        (keywords (member-if #'keywordp args)))
  +    `(%tputs ,(if args `(tparm ,string ,@args)
  +                  string)
  +             ,@keywords)))
  +
  +(defun %tputs (string &key
  +                        (terminfo *terminfo*)
  +                        (stream *terminal-io*)
  +                        baud-rate
  +                        (affected-lines 1))
  +  "Print the control string to an output stream.  If stream is nil,
  +a list of strings and delay times is returned.
  +String must already have been operated upon by tparm if necessary."
  +  (declare (type fixnum affected-lines))
     (when string
  -    (let* ((stream (if (streamp (first args)) (pop args) *terminal-io*))
  -	   (terminfo (if (terminfo-p (first args)) (pop args) *terminfo*)))
  -      (with-input-from-string (string (apply #'tparm string args))
  -	(do ((c (read-char string nil) (read-char string nil)))
  -	    ((null c))
  -	  (cond ((and (char= c #\$)
  -		      (eql (peek-char nil string nil) #\<))
  -		 (let ((time 0) (force nil) (rate nil) (pad #\Null))
  -
  -		   ;; Find out how long to pad for:
  -		   (read-char string) ; eat the #\<
  -		   (loop
  -		     (setq c (read-char string))
  -		     (let ((n (digit-char-p c)))
  -		       (if n
  -			   (setq time (+ (* time 10) n))
  -			   (return))))
  -		   (if (char= c #\.)
  -		       (setq time (+ (* time 10)
  -				     (digit-char-p (read-char string)))
  -			     c (read-char string))
  -		       (setq time (* time 10)))
  -		   (when (char= c #\*)
  -		     ;; multiply time by "number of lines affected"
  -		     ;; but how do I know that??
  -		     (setq c (read-char string)))
  -		   (when (char= c #\/)
  -		     (setq force t c (read-char string)))
  -		   (unless (char= c #\>)
  -		     (error "Invalid padding specification."))
  -
  -		   ;; Decide whether to apply padding:
  -		   (when (or force (not (capability :xon-xoff terminfo)))
  -		     (setq rate (stream-baud-rate stream))
  -		     (when (let ((pb (capability :padding-baud-rate terminfo)))
  -			     (and rate (or (null pb) (> rate pb))))
  -		       (cond ((capability :no-pad-char terminfo)
  -			      (finish-output stream)
  -			      (sleep (/ time 10000.0)))
  -			     (t
  -			      (let ((tmp (capability :pad-char terminfo)))
  -				(when tmp (setf pad (schar tmp 0))))
  -			      (dotimes (i (ceiling (* rate time) 100000))
  -				(princ pad stream))))))))
  -
  -		(t
  -		 (princ c stream))))))
  -    t))
  +    (let ((strings-and-delays (strings-and-delays string))
  +          (result ()))
  +      (dolist (item strings-and-delays (and (not stream) (nreverse result)))
  +        (let ((printed
  +               (typecase item
  +                 (padding (print-padding item :baud-rate baud-rate :stream stream :terminfo terminfo :affected-lines affected-lines))
  +                 (string (if stream (princ item stream) item)))))
  +          (unless stream
  +            (push printed result)))))))
   
   (defun set-terminal (&optional name)
  +  "Load the terminfo database specified, or defined per 
  +the TERM environment variable."
     (setf *terminfo* (load-terminfo (or name
   				      #+ccl
   				      (ccl:getenv "TERM")
  
positive.code:   (defcap box-chars-1 string 413))
  
  (defun load-terminfo (name)
    (flet ((stringify-first-char (name)
  	   #+darwin (format nil "~X" (char-code (char name 0)))
  	   #-darwin (string (char name 0))))
      (let ((name (concatenate 'string (stringify-first-char name) "/" name)))
        (dolist (path (list* #+CMU "home:.terminfo/"
  			   #+Allegro "~/.terminfo/"
  			   #-(or CMU Allegro) 
  			   (merge-pathnames ".terminfo/" (user-homedir-pathname))
  			   *terminfo-directories*))
  	(with-open-file (stream (merge-pathnames name path)
  				:direction :input
  				:element-type '(unsigned-byte 8)
  				:if-does-not-exist nil)
  	  (when stream
  	    (flet ((read-short (stream)
  		     (let ((n (+ (read-byte stream) (* 256 (read-byte stream)))))
  		       (if (> n 32767)
  			   (- n 65536)
  			   n)))
  		   (read-string (stream)
  		     (do ((c (read-byte stream) (read-byte stream))
  			  (s '()))
  			 ((zerop c) (coerce (nreverse s) 'string))
  		       (push (code-char c) s))))
  	      (let* ((magic (read-short stream))
  		     (sznames (read-short stream))
  		     (szbooleans (read-short stream))
  		     (sznumbers (read-short stream))
  		     (szstrings (read-short stream))
  		     (szstringtable (read-short stream))
  		     (names (let ((string (read-string stream)))
  			      (loop for i = 0 then (1+ j)
  				    as j = (position #\| string :start i)
  				    collect (subseq string i j) while j)))
  		     (booleans (make-array szbooleans
  					   :element-type '(or t nil)
  					   :initial-element nil))
  		     (numbers (make-array sznumbers
  					  :element-type '(signed-byte 16)
  					  :initial-element -1))
  		     (strings (make-array szstrings
  					  :element-type '(signed-byte 16)
  					  :initial-element -1))
  		     (stringtable (make-string szstringtable))
  		     (count 0))
  		(unless (= magic #o432)
  		  (error "Invalid file format"))
  		(dotimes (i szbooleans)
  		  (setf (aref booleans i) (not (zerop (read-byte stream)))))
  		(when (oddp (+ sznames szbooleans))
  		  (read-byte stream))
  		(dotimes (i sznumbers)
  		  (setf (aref numbers i) (read-short stream)))
  		(dotimes (i szstrings)
  		  (unless (minusp (setf (aref strings i) (read-short stream)))
  		    (incf count)))
  		(dotimes (i szstringtable)
  		  (setf (char stringtable i) (code-char (read-byte stream))))
  		(let ((xtrings (make-array szstrings :initial-element nil)))
  		  (dotimes (i szstrings)
  		    (unless (minusp (aref strings i))
  		      (setf (aref xtrings i)
  			    (subseq stringtable (aref strings i)
  				    (position #\Null stringtable
  					      :start (aref strings i))))))
  		  (setq strings xtrings))
  		(return (make-terminfo :names names :booleans booleans
  				       :numbers numbers :strings strings))))))))))
  
  (defun tparm (string &rest args)
    (when (null string) (return-from tparm ""))
    (with-output-to-string (out)
      (with-input-from-string (in string)
  
negative.code: 			     (incf (second args))))
  			 (go terminal))
  		    (#\? (go state14))
  		    (#\t (go state15))
  		    (#\e (go state16))
  		    (#\; (go state17))
  		    (otherwise (error "Unknown %-control character: ~C" c)))
  		state1
  		  (let ((next (peek-char nil in nil)))
  