;;; File:
;;;   webutils.ss
;;; Version:
;;;   1.0 of September 2002
;;; Author:
;;;   Samuel A. Rebelsky
;;; Contents:
;;;   A simple collection of utilities for building Web pages.
;;; Organization:
;;;   Preparation
;;;   Sam's CGI Helpers - Procedures for getting CGI variables
;;;     (get-cgi-param param-name default)
;;;   Sam's HTML Helpers - Procedures for generating HTML
;;;     (body contents)
;;;     (field name)
;;;     (form cgi-script submit-text contents)
;;;     (head title)
;;;     (heading level)
;;;     (make-page head body)
;;;     (markup tag contents)
;;;     (paragraph contents)
;;; Warning:
;;;   While all of this procedures are intended for beginning Schemers
;;;   to use, some rely on techniques that those students may not yet
;;;   know.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Preparation

;;; Look!  We're going to use the CGI library.  What fun.
(require (lib "cgi.ss" "net"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Sam's CGI Helpers

;;; Procedure:
;;;   get-cgi-param
;;; Parameters:
;;;   param-name, a symbol that names a CGI parameter
;;;   default, a string
;;; Purpose:
;;;   Extracts the CGI parameter with the given name.  If no
;;;   such parameter exists, uses default.
;;; Produces:
;;;   param-value, a string
;;; Preconditions:
;;;   The cgi.ss and net librares must be loaded.
;;; Postconditions:
;;;   If this procedure was invoked from within a CGI environment
;;;     and the request included a specification for a value named
;;;     param-name,  param-value is that value.
;;;   Otherwise, param-value is default.
(define get-cgi-param
  (lambda (param-name default)
    (if (get-cgi-method) ; Returns false if invoked outside of CGI envt.
        (get-cgi-param-helper (extract-bindings param-name (get-bindings)) 
                              default)
        default)))

  (define get-cgi-param-helper
    (lambda (value-list default)
      (if (null? value-list) ; extract-bindings returns null for "no such param"
          default
          (car value-list))))
     
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Sam's HTML Helpers

;;; Procedure:
;;;   body
;;; Parameters:
;;;   contents, the intended contents of a page
;;; Purpose:
;;;   Generates some nice happy HTML that represents the body of
;;;   a page with a particular contents.
;;; Produces:
;;;   A string for HTML that represents the body.
;;; Preconditions:
;;;   contents is a string
;;;   contents represents valid, though partial, HTML
;;; Postconditions:
;;;   You get some nice HTML which you can join with a
;;;     head and some html tags to make a full page.
;;;   The result may contain carriage returns (newlines).
(define body
  (lambda (contents)
    (markup "body"
      (string-append 
        (string #\newline)
        contents 
        (string #\newline)))))

;;; Procedure:
;;;   field
;;; Parameters:
;;;   name, a string
;;; Purpose:
;;;   Builds HTML for a field with the given name.
;;; Produces:
;;;   form-code, a string
;;; Preconditions:
;;;   name consists of only letters and digits [Not Verified].
;;; Postconditions:
;;;   form-code is valid HTML.
;;;   form-code describes a text input field with the given name.
(define field
  (lambda (name)
    (string-append
      "<input type=\"text\" name=\"" name "\" value=\"\">")))

;;; Procedure:
;;;   form
;;; Parameters:
;;;   cgi-script, a string
;;;   submit-text, a string
;;;   contents, a string
;;; Purpose:
;;;   Builds HTML for a form that sends input to the named
;;;   cgi-script.
;;; Produces:
;;;   form-code, a string
;;; Preconditions:
;;;   cgi-script names a valid CGI script.
;;;   contents provides valid HTML for the contents of the form.
;;; Postconditions:
;;;   form-code is valid HTML.
;;;   form-code provides a form that will submit input to the cgi-script.
(define form
  (lambda (cgi-script submit contents)
    (string-append
      "<form method=\"get\" action=\"" cgi-script "\">"
      (string #\newline)
      contents
      (string #\newline)
      "<input type=\"submit\" value=\"" submit "\">"
      (string #\newline)
      "</form>")))

;;; Procedure:
;;;   head
;;; Parameters:
;;;   title, the title of the page
;;; Purpose:
;;;   Generates some nice happy HTML that represents the head of
;;;   a page with a particular title.
;;; Produces:
;;;   A string for HTML that represents the head.
;;; Preconditions:
;;;   The title is a string with no internal HTML.
;;; Postconditions:
;;;   You get some nice HTML which a normal browser displays
;;;   as the titlebar of a window.
(define head
  (lambda (title)
    (markup "head" 
      (string-append
        "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=ISO-8859-1\">"
        (string #\newline)
        (markup "title" title)))))

;;; Procedure:
;;;   heading
;;; Parameters:
;;;   level, a heading level (1-6)
;;;   text, some text to mark up
;;; Purpose:
;;;   Generates some nice happy HTML that represents the heading of
;;;   a section of text.
;;; Produces:
;;;   A string for HTML that represents the heading.
;;; Preconditions:
;;;   Level is an exact integer between 1 and 6, inclusive.
;;;   text is a string.
;;;   text is valid HTML.
;;; Postconditions:
;;;   You get some nice HTML which a normal browser displays
;;;   as a heading.
(define heading
  (lambda (level text)
    (markup (string-append "h" (number->string level)) text)))

;;; Procedure:
;;;   make-page
;;; Parameters:
;;;   head, the head of a page
;;;   body, the body of a page
;;; Purpose:
;;;   Shoves the head and the body together to make a page.
;;; Produces:
;;;   HTML for a full page.  Wow!
;;; Preconditions:
;;;   head was created by the head procedure
;;;   body was created by the body procedure
;;; Postconditions:
;;;   You get some nice HTML which a normal browser displays
;;;   appropriately.
(define make-page
  (lambda (head body)
    (string-append 
      "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">"
      (string #\newline)
      "<html lang=\"en\">"
      (string #\newline)
      head
      (string #\newline)
      body
      (string #\newline)
      "</html>"
      (string #\newline)
    )
  )
)

;;; Procedure:
;;;   markup
;;; Parameters:
;;;   tag, the role that the text plays
;;;   text, some text to mark up
;;; Purpose:
;;;   Generates some nice happy HTML for me.
;;; Produces:
;;;   A string for HTML that represents the marked text.
;;; Preconditions:
;;;   Both parameters are strings.
;;;   The text is valid HTML.
;;;   The tag contains only alphanumeric characters and 
;;;     corresponds to a valid HTML tag.
;;; Postconditions:
;;;   You get some nice HTML.
(define markup 
  (lambda (tag text)
    (string-append "<" tag ">" text "</" tag ">")))

;;; Procedure:
;;;   paragraph
;;; Parameters:
;;;   contents, the contents of the paragraph
;;; Purpose:
;;;   Generates some nice happy HTML that represents on paragraph.
;;;   Also to annoy the world with introductory comments that are
;;;     significantly longer than the procedure needs.
;;; Produces:
;;;   A string for HTML that represents the paragraph.
;;; Preconditions:
;;;   The contents is (are?) valid HTML with no block-level elements.
;;; Postconditions:
;;;   You get some nice HTML which a normal browser displays
;;;   appropriately.
(define paragraph
  (lambda (contents)
    (markup "p" contents)))