From d1b0957a1137d834fc7a5e32d33fb936f7ae75ac Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Mon, 4 Jun 2007 20:32:49 +0000
Subject: [PATCH] Removing obsolete commandline utility

svn: r6472
---
 collects/web-server/info.ss                 |  4 +--
 collects/web-server/private/launch.ss       |  8 +++++
 collects/web-server/private/setup-launch.ss | 38 ---------------------
 collects/web-server/private/util.ss         | 12 +------
 4 files changed, 11 insertions(+), 51 deletions(-)
 delete mode 100644 collects/web-server/private/setup-launch.ss

diff --git a/collects/web-server/info.ss b/collects/web-server/info.ss
index b4b59fac2d..c1fe7f9d6e 100644
--- a/collects/web-server/info.ss
+++ b/collects/web-server/info.ss
@@ -3,9 +3,9 @@
   (define post-install-collection "docs/doc-installer.ss")
   
   (define mzscheme-launcher-libraries
-    (list "private/launch-text.ss" "private/setup-launch.ss" ))
+    (list "private/launch-text.ss"))
   (define mzscheme-launcher-names
-    (list "PLT Web Server Text" "PLT Web Server Setup")) 
+    (list "PLT Web Server Text")) 
 
   (define mred-launcher-libraries
     (list "private/launch-gui.ss"))
diff --git a/collects/web-server/private/launch.ss b/collects/web-server/private/launch.ss
index 63159afb7e..5aa5dbe9b0 100644
--- a/collects/web-server/private/launch.ss
+++ b/collects/web-server/private/launch.ss
@@ -8,6 +8,14 @@
            "../web-config-sig.ss"
            "../web-server-unit.ss"
            "../web-server-sig.ss")
+      
+  ; this is used by launchers
+  ; extract-flag : sym (listof (cons sym alpha)) alpha -> alpha
+  (define (extract-flag name flags default)
+    (let ([x (assq name flags)])
+      (if x
+          (cdr x)
+          default)))
   
   (define configuration@
     (parse-command-line
diff --git a/collects/web-server/private/setup-launch.ss b/collects/web-server/private/setup-launch.ss
deleted file mode 100644
index 770c1374e1..0000000000
--- a/collects/web-server/private/setup-launch.ss
+++ /dev/null
@@ -1,38 +0,0 @@
-(module setup-launch mzscheme
-  (require (lib "cmdline.ss")
-           (lib "file.ss")
-           (lib "struct.ss"))
-  (require "../web-config-unit.ss"
-           "../configuration/configuration-table-structs.ss"
-           "../configuration/configuration-table.ss"
-           "util.ss")
-  
-  (parse-command-line
-   "web-server-setup"
-   (current-command-line-arguments)
-   `((once-each
-      [("-p" "--port")
-       ,(lambda (flag port)
-          (cons 'port (string->number port)))
-       ("Use an alternate network port." "port")]
-      [("-d" "--destination")
-       ,(lambda (flag destination)
-          (let ([p (normalize-path (string->path destination))])
-            (cons 'destination p)))
-       ("Use an destination directory other than the current directory" "directory")]))
-   (lambda (flags)
-     (let ([port (extract-flag 'port flags 8080)]
-           [dest (extract-flag 'destination flags (current-directory))])
-       ;; Create dest
-       (make-directory* dest)
-       ;; Copy default-web-root into dest/default-web-root
-       (copy-directory/files (build-path (collection-path "web-server") "default-web-root")
-                             (build-path dest "default-web-root"))
-       ;; Read default configuration-table, changing the port
-       ;; Write configuration-table into dest/configuration-table
-       (write-configuration-table
-        (copy-struct configuration-table 
-                     (read-configuration-table default-configuration-table-path)
-                     [configuration-table-port port])
-        (build-path dest "configuration-table"))))
-   '()))
\ No newline at end of file
diff --git a/collects/web-server/private/util.ss b/collects/web-server/private/util.ss
index f47a2ae8f7..3970937a3f 100644
--- a/collects/web-server/private/util.ss
+++ b/collects/web-server/private/util.ss
@@ -13,7 +13,6 @@
    [list-prefix (list? list? . -> . (or/c list? false/c))]
    [strip-prefix-ups (list? . -> . list?)] ; XXX need path-element?
    [url-path->string ((listof (or/c string? path/param?)) . -> . string?)]
-   [extract-flag (symbol? (listof (cons/c symbol? any/c)) any/c . -> . any/c)]
    [network-error ((symbol? string?) (listof any/c) . ->* . (void))]
    [directory-part (path? . -> . path?)]
    [lowercase-symbol! ((or/c string? bytes?) . -> . symbol?)]
@@ -143,13 +142,4 @@
       (cond
         [(eq? 'relative base) (current-directory)]
         [(not base) (error 'directory-part "~a is a top-level directory" path)]
-        [(path? base) base])))
-    
-  ; this is used by launchers
-  ; extract-flag : sym (listof (cons sym alpha)) alpha -> alpha
-  ; XXX remove
-  (define (extract-flag name flags default)
-    (let ([x (assq name flags)])
-      (if x
-          (cdr x)
-          default))))
\ No newline at end of file
+        [(path? base) base]))))
\ No newline at end of file