Change news-group-truncate-subject variable to allow truncation

proportional to the width of the buffer.  Define new procedures
BUFFER-X-SIZE and MARK-X-SIZE.

diff --git a/v7/src/edwin/buffer.scm b/v7/src/edwin/buffer.scm
index 3581f61619d2ec6b7aad7c8f65e1075a99475c52..4c7dc15762cc8039806bf441a93db20acef9a2b8 100644 (file)
--- a/v7/src/edwin/buffer.scm
+++ b/v7/src/edwin/buffer.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: buffer.scm,v 1.169 1996/05/05 18:58:41 cph Exp $
+;;;    $Id: buffer.scm,v 1.170 1998/12/25 05:49:36 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989-96 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-98 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -243,6 +243,18 @@ The buffer is guaranteed to be deselected at that time."
 (define (buffer-visible? buffer)
   (there-exists? (buffer-windows buffer) window-visible?))
 
+(define (buffer-x-size buffer)
+  (let ((windows (buffer-windows buffer)))
+    (if (null? windows)
+       (screen-x-size (selected-screen))
+       (apply min (map window-x-size windows)))))
+
+(define (mark-x-size mark)
+  (let ((buffer (mark-buffer mark)))
+    (if buffer
+       (buffer-x-size buffer)
+       (screen-x-size (selected-screen)))))
+
 (define (buffer-get buffer key #!optional default)
   (let ((entry (assq key (buffer-alist buffer))))
     (if entry

diff --git a/v7/src/edwin/bufout.scm b/v7/src/edwin/bufout.scm
index 60e08eac64b3e90489db55b5fb63c2ef18d43785..26ba05c6ec8ff6527f3b6c04ef9902a7ec78e5a7 100644 (file)
--- a/v7/src/edwin/bufout.scm
+++ b/v7/src/edwin/bufout.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: bufout.scm,v 1.9 1993/08/12 06:03:21 cph Exp $
+;;;    $Id: bufout.scm,v 1.10 1998/12/25 05:49:52 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-98 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -103,11 +103,7 @@
   (mark-temporary! (port/mark port)))
 
 (define (operation/x-size port)
-  (let ((buffer (mark-buffer (port/mark port))))
-    (and buffer
-        (let ((windows (buffer-windows buffer)))
-          (and (not (null? windows))
-               (apply min (map window-x-size windows)))))))
+  (mark-x-size (port/mark port)))
 
 (define mark-output-port-template
   (make-output-port `((CLOSE ,operation/close)

diff --git a/v7/src/edwin/snr.scm b/v7/src/edwin/snr.scm
index 8a240eb701f94e250b477aa6e26637d02f423623..584a7fb99e06f7287a0528cd2476fe61c5779d62 100644 (file)
--- a/v7/src/edwin/snr.scm
+++ b/v7/src/edwin/snr.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: snr.scm,v 1.44 1998/11/18 03:18:00 cph Exp $
+;;;    $Id: snr.scm,v 1.45 1998/12/25 05:50:00 cph Exp $
 ;;;
 ;;;    Copyright (c) 1995-98 Massachusetts Institute of Technology
 ;;;
@@ -185,9 +185,13 @@ This is primarily used to enhance the context window."
 (define-variable news-group-truncate-subject
   "Maximum number of columns for the subject in a News-article header line.
 If zero, no truncation is performed.
+May also be a real number between 0 and 1 exclusive, in which case it
+ specifies the number of columns as a fraction of the buffer width.
 See also news-group-author-column."
-  50
-  exact-nonnegative-integer?)
+  0.7
+  (lambda (object)
+    (or (exact-nonnegative-integer? object)
+       (and (real? object) (< 0 object 1)))))
 
 (define-variable news-group-minimum-truncated-subject
   "Minimum number of columns that a subject can be truncated to.
@@ -1335,7 +1339,13 @@ This shows News groups that have been created since the last time that
     (insert-char #\space mark)
     (insert-chars #\space indentation mark)
     (if subject
-       (let ((ngts (ref-variable news-group-truncate-subject mark)))
+       (let ((ngts
+              (let ((ngts (ref-variable news-group-truncate-subject mark)))
+                (if (exact-nonnegative-integer? ngts)
+                    ngts
+                    (let ((x-size (mark-x-size mark)))
+                      (min x-size
+                           (round->exact (* ngts x-size))))))))
          (let ((subject-length
                 (max (ref-variable news-group-minimum-truncated-subject mark)
                      (- ngts indentation)))