launch-browser.scm
(module launch-browser mzscheme
        (require (lib "process.ss"))
        (require (planet "spod.scm" ("oesterholt" "roos.plt" 1 0)))
        (provide launch-browser
                 launch-browser-documentation)
        
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;;; WIN32 stuff
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        
        (define (win32?)
          (eq? (system-type 'os) 'windows))

        (define (win32-launch url)
          (eq? (shell-execute #f url "" (current-directory) 'sw_shownormal) #f))
        
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;;; UNIX stuff
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        
        (define BROWSERS '("konqueror" "firefox" "epiphany" "mozilla" "opera" "netscape"))
        
        (define (unix-launch url)
          (letrec ((f (lambda (L)
                        (if (null? L)
                            #f
                            (let ((browser (car L)))
                              (apply (lambda (in out pid err-in control)
                                       (let ((result (control 'status)))
                                         (close-input-port in)
                                         (close-input-port err-in)
                                         (close-output-port out)
                                         (if (eq? result 'running)
                                             (begin
                                               (sleep 1)
                                               (set! result (control 'status))
                                               (if (eq? result 'running)
                                                   (begin
                                                     (sleep 2)
                                                     (set! result (control 'status))))))
                                         (if (eq? result 'done-error)
                                             (f (cdr L))
                                             #t)))
                                     (process (format "~a ~a" browser url))))))))
            (let ((DEFAULT-BROWSER (getenv "DEFAULT_BROWSER")))
              (if (eq? DEFAULT-BROWSER #f)
                  (f BROWSERS)
                  (f (cons DEFAULT-BROWSER BROWSERS))))))
        
        (define (unix?)
          (or (eq? (system-type 'os) 'unix) (eq? (system-type 'os) 'macosx)))
        
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;;; code
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        
        (spod-module-def)
        (spod-module-add (s= "launch-browser - starting the default browser with a given url"))
        
        (spod-module-add 
         (sp "This module provides an interface to start a default browser for a given url."))
        
        (spod-module-add
         (s== "Provided functions")
         
         (s=== (s% "(launch-browser url:string?) --> boolean"))
         (sp "Starts a browser (or opens a new tab in a browser) using url. On Windows, it will be "
             "the default browser (using the windows shell). On Unix like systems, the environment "
             "variable 'DEFAULT_BROWSER' will be tried, before walking through a list of browsers: "
             (s% "'konqueror, firefox, epiphany, mozilla, opera, netscape'"))
         (sp "Returns #t on success, #f otherwise."))
        (define (launch-browser url . status)
          (cond ((win32?) (win32-launch url))
                ((unix?)  (unix-launch url))
                (else (error "launch-browser: I don't know how to start a browser on this platform."))))
              
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;; Module documentation
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        
        (define %module-doc (spod-module-doc))
        (define (launch-browser-documentation)
          %module-doc)
        
        )