Removing obsolete commandline utility

svn: r6472

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"))

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

collects/web-server/private/setup-launch.ss

@@ -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"))))
-   '()))

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))))
+        [(path? base) base]))))