Make Edwin buffer and window output ports correctly support the
authorArthur Gleckler <edu/mit/csail/zurich/arthur>
Tue, 18 Jun 1991 20:31:43 +0000 (20:31 +0000)
committerArthur Gleckler <edu/mit/csail/zurich/arthur>
Tue, 18 Jun 1991 20:31:43 +0000 (20:31 +0000)
operation X-SIZE.

X-SIZE on a buffer output port now returns the character width of the
most narrow window showing the port's buffer, or 79 if no window shows
the buffer.

X-SIZE on a window output port now returns the character width of the
window.

v7/src/edwin/bufout.scm
v7/src/edwin/winout.scm

index e6b6e9757a7aa3692a5d869122e44182bbc8d617..d7b2d2d1d7d25dd116f525ba93552ee1fe01068d 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufout.scm,v 1.4 1991/05/15 21:19:11 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufout.scm,v 1.5 1991/06/18 20:31:43 arthur Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
 (define (operation/close port)
   (mark-temporary! (output-port/mark port)))
 
+(define (operation/x-size port)
+  (let ((sizes
+        (map window-x-size
+             (buffer-windows
+              (mark-buffer (output-port/mark port))))))
+    (if (null? sizes)
+       79
+       (apply min sizes))))
+
 (define mark-output-port-template
   (make-output-port `((CLOSE ,operation/close)
                      (FLUSH-OUTPUT ,operation/flush-output)
                      (FRESH-LINES ,operation/fresh-lines)
                      (PRINT-SELF ,operation/print-self)
                      (WRITE-CHAR ,operation/write-char)
-                     (WRITE-STRING ,operation/write-string))
+                     (WRITE-STRING ,operation/write-string)
+                     (X-SIZE ,operation/x-size))
                    false))
\ No newline at end of file
index aa7061bd512507b70486673ab37f769d4781be04..3dea2cbd673fe79b3030a457366102d9f670b5a6 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/winout.scm,v 1.5 1991/03/11 01:14:58 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/winout.scm,v 1.6 1991/06/18 20:30:48 arthur Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
     (if (window-needs-redisplay? window)
        (window-direct-update! window false))))
 
+(define (operation/x-size port)
+  (window-x-size (output-port/state port)))
+
 (define (operation/print-self state port)
   (unparse-string state "to window ")
   (unparse-object state (output-port/state port)))
                      (FRESH-LINES ,operation/fresh-lines)
                      (PRINT-SELF ,operation/print-self)
                      (WRITE-CHAR ,operation/write-char)
-                     (WRITE-STRING ,operation/write-string))
+                     (WRITE-STRING ,operation/write-string)
+                     (X-SIZE ,operation/x-size))
                    false))
\ No newline at end of file