Allow service numbers in news server proxy entries.

diff --git a/v7/src/edwin/nntp.scm b/v7/src/edwin/nntp.scm
index 69dfe910588c85cfb16bb21f1491c867e879fa36..e33c06e5a321e1cb110b6363c572105f77e5a2de 100644 (file)
--- a/v7/src/edwin/nntp.scm
+++ b/v7/src/edwin/nntp.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: nntp.scm,v 1.37 2008/01/30 20:02:04 cph Exp $
+$Id: nntp.scm,v 1.38 2008/05/17 02:18:27 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -46,9 +46,10 @@ USA.
 (define-structure (nntp-connection
                   (conc-name nntp-connection:)
                   (constructor make-nntp-connection
-                               (server proxy change-hook)))
+                               (server proxy change-hook #!optional service)))
   (server #f read-only #t)
   (proxy #f read-only #t)
+  (service "nntp" read-only #t)
   (change-hook #f read-only #t)
   (port #f)
   (banner #f)
@@ -65,7 +66,7 @@ USA.
     (let ((port
           (open-tcp-stream-socket (or (nntp-connection:proxy connection)
                                       (nntp-connection:server connection))
-                                  "nntp")))
+                                  (nntp-connection:service connection))))
       (set-nntp-connection:port! connection port)
       (set-nntp-connection:banner! connection (input-port/read-line port)))
     (set-nntp-connection:current-group! connection #f)

diff --git a/v7/src/edwin/snr.scm b/v7/src/edwin/snr.scm
index 61e9c179bd66dc72cb20036d2258af6c7da01896..6f7334b0b0361a82374708d95a006caa0a322f0d 100644 (file)
--- a/v7/src/edwin/snr.scm
+++ b/v7/src/edwin/snr.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: snr.scm,v 1.70 2008/01/30 20:02:05 cph Exp $
+$Id: snr.scm,v 1.71 2008/05/17 02:18:26 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -54,7 +54,8 @@ This has three possible values:
   "Alist mapping news servers to associated proxies.
 Each entry in the list is a pair of strings:
  the car of the entry is the FQDN of a news server;
- the cdr of the entry is the FQDN of a proxy for that server."
+ the cdr of the entry is the FQDN of a proxy for that server,
+ optionally followed by a colon and a service number."
   '()
   (lambda (object)
     (list-of-type? object
@@ -473,12 +474,25 @@ Only one News reader may be open per server; if a previous News reader
   (nntp-connection:close (news-server-buffer:connection buffer)))
 \f
 (define (make-nntp-connection-1 server buffer)
-  (make-nntp-connection
-   server
-   (let ((entry (assoc server (ref-variable news-server-proxy-alist buffer))))
-     (and entry
-         (cdr entry)))
-   update-nntp-connection-modeline!))
+  (let ((entry (assoc server (ref-variable news-server-proxy-alist buffer))))
+    (if entry
+       (receive (proxy service) (parse-proxy-name (cdr entry))
+         (make-nntp-connection server
+                               proxy
+                               update-nntp-connection-modeline!
+                               service))
+       (make-nntp-connection server #f update-nntp-connection-modeline!))))
+
+(define (parse-proxy-name string)
+  (let ((parts (burst-string string (char-set #\:) #f)))
+    (cond ((and (pair? parts) (null? (cdr parts)))
+          (values (car parts) #!default))
+         ((and (pair? parts) (pair? (cdr parts)) (null? (cddr parts)))
+          (values (car parts)
+                   (or (string->number (cadr parts) #d10)
+                       (cadr parts))))
+         (else
+          (error "Malformed NNTP proxy name:" string)))))
 
 (define (news-server-buffer:save-groups buffer)
   (write-groups-init-file buffer)
@@ -501,7 +515,7 @@ Only one News reader may be open per server; if a previous News reader
            (insert-news-group-line group mark)
            (set-news-group:index! group #f))))
     (mark-temporary! mark)))
-
+\f
 (define (news-server-buffer:show-group? buffer group)
   (and (or (ref-variable news-show-unsubscribed-groups buffer)
           (news-group:subscribed? group))