From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 25 Dec 1998 05:50:00 +0000 (+0000)
Subject: Change news-group-truncate-subject variable to allow truncation
X-Git-Tag: 20090517-FFI~4708
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ffb34bacd8cd575a293d37cd38c715fb5ccae7af;p=mit-scheme.git

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 3581f6161..4c7dc1576 100644
--- 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 60e08eac6..26ba05c6e 100644
--- 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 8a240eb70..584a7fb99 100644
--- 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)))