;;;; -*- mode:lisp; coding:utf-8 -*-
;;;;****************************************************************************
;;;;FILE:               site.lisp
;;;;LANGUAGE:           Common-Lisp
;;;;SYSTEM:             Common-Lisp
;;;;USER-INTERFACE:     NONE
;;;;DESCRIPTION
;;;;
;;;;    Generate the www.ogamita.com site static pages.
;;;;
;;;;AUTHORS
;;;;    <PJB> Pascal Bourguignon <pjb@informatimago.com>
;;;;MODIFICATIONS
;;;;    2007-05-28 <PJB> Updated for ogamita.
;;;;    2004-03-14 <PJB> Created.
;;;;BUGS
;;;;LEGAL
;;;;    GPL
;;;;
;;;;    Copyright Pascal Bourguignon 2001 - 2007
;;;;
;;;;    This program is free software; you can redistribute it and/or
;;;;    modify it under the terms of the GNU General Public License
;;;;    as published by the Free Software Foundation; either version
;;;;    2 of the License, or (at your option) any later version.
;;;;
;;;;    This program is distributed in the hope that it will be
;;;;    useful, but WITHOUT ANY WARRANTY; without even the implied
;;;;    warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;;;    PURPOSE.  See the GNU General Public License for more details.
;;;;
;;;;    You should have received a copy of the GNU General Public
;;;;    License along with this program; if not, write to the Free
;;;;    Software Foundation, Inc., 59 Temple Place, Suite 330,
;;;;    Boston, MA 02111-1307 USA
;;;;****************************************************************************

(defpackage "COM.OGAMITA.SITE"
  (:use "CL")
  (:export "GENERATE-SITE"))
(in-package "COM.OGAMITA.SITE")
(setf CUSTOM:*LOAD-LOGICAL-PATHNAME-TRANSLATIONS-DATABASE*
      (list (make-pathname
             :name "LOGHOSTS" :type "TRA" :version nil
             :case :common :defaults (user-homedir-pathname))))
(load-logical-pathname-translations "PACKAGES")

;; For Example, my current ~/loghosts.tra on thalassa:
;;
;; ;;;; -*- mode:lisp; coding:utf-8; -*-
;;
;; "PACKAGES"   (list
;;               (list "PACKAGES:COM;INFORMATIMAGO;**;*.*"
;;                     (merge-pathnames "./src/public/lisp/**/*.*"
;;                                      (user-homedir-pathname) nil))
;;               (list "PACKAGES:COM;INFORMATIMAGO;**;*"
;;                     (merge-pathnames "./src/public/lisp/**/*"
;;                                      (user-homedir-pathname) nil))
;;               (list "PACKAGES:**;*.*"
;;                     "/data/lisp/packages/**/*.*")
;;               (list "PACKAGES:**;*"
;;                     "/data/lisp/packages/**/*"))


(HANDLER-CASE (LOAD "PACKAGES:COM;INFORMATIMAGO;COMMON-LISP;PACKAGE")
  (T ()       (LOAD "PACKAGES:COM;INFORMATIMAGO;COMMON-LISP;PACKAGE.LISP")))
(IMPORT 'PACKAGE:DEFINE-PACKAGE)
(PACKAGE:LOAD-PACKAGE "COM.INFORMATIMAGO.COMMON-LISP.SOURCE-FORM")
(PACKAGE:LOAD-PACKAGE "COM.INFORMATIMAGO.COMMON-LISP.UTILITY")
(PACKAGE:LOAD-PACKAGE "COM.INFORMATIMAGO.COMMON-LISP.LIST")
(PACKAGE:LOAD-PACKAGE "COM.INFORMATIMAGO.COMMON-LISP.ECMA048")
(PACKAGE:LOAD-PACKAGE "COM.INFORMATIMAGO.COMMON-LISP.STRING")
(PACKAGE:LOAD-PACKAGE "COM.INFORMATIMAGO.COMMON-LISP.CHARACTER-SETS")
(PACKAGE:LOAD-PACKAGE "COM.INFORMATIMAGO.COMMON-LISP.HTML")
(PACKAGE:ADD-NICKNAME "COM.INFORMATIMAGO.COMMON-LISP.HTML" "<")
(PACKAGE:LOAD-PACKAGE "COM.INFORMATIMAGO.COMMON-LISP.ISO639A")



(defvar *corp-name* "Ogamita")


(defparameter *all-languages*
  (mapcar (lambda (item) (intern (string (second item)) "KEYWORD"))
          COM.INFORMATIMAGO.COMMON-LISP.ISO639A::+LANGUAGES+))

(defvar *languages* '(:en)
  "Gives the list of languages to generate.")

(defmacro define-languages (&rest languages)
  `(setf *languages* (list ,@languages)))

(defvar *language* :en)



(defun localize (plist)
  (if (and (listp plist)
           (loop
              :for (k v) :on plist :by (function cddr)
              :always (member k *all-languages*)))
      (or (getf plist *language*)
          (error "Missing translation to ~A in ~S"
                 *language* plist))
      plist))


(defun localize-format (stream plist &rest args)
  (apply (function format) stream
         (mapcar (function localize) (cons plist args))))




(defparameter *pages* '())

(defstruct page
  url short-title title keywords author body)

(defmacro define-page (url-base (&key short-title title keywords author)
                       &body body)
  `(progn (push (make-page :url ,url-base
                           :short-title ,(or short-title title)
                           :title ,(or title short-title)
                           :keywords ,keywords
                           :author ,author
                           :body (lambda () ,@body)) *pages*)
          ',url-base))




(defvar *menus* '()
  "Gives the urls of the page to put in the menu in order.")

(defstruct menu url page title)

(defmacro define-menu (&rest urls)
  `(setf *menus*  (list ,@urls)))


(defun menu (menu &optional selected-item)
  (<:table ()
           (dolist (item menu)
             (<:tr ()
                   (<:td ()
                         (<:div (:class (if (equal item selected-item)
                                            "menu-selected"
                                            "menu"))
                             (<:a (:href (menu-url item))
                                  (<:pcdata (localize (menu-title item))))))))))




(defmacro define-localized-tag (name tag)
  `(defun ,name (&rest arguments)
     (if (or (keywordp (first arguments))
             (rest arguments))
         (,tag () (<:pcdata (localize arguments)))
         (,tag () (<:pcdata "~A" (first arguments))))))


(define-localized-tag p  <:p)
(define-localized-tag b  <:b)
(define-localized-tag h2 <:h2)
(define-localized-tag li <:li)


(defun email (email &optional title)
  (<:a (:href (format nil "mailto:~A" email))
       (if title
           (<:pcdata (localize title))
           (<:pcdata email))))

(defun phone (phone &optional title)
  (<:a (:href (format nil "phoneto:~A" phone))
       (if title
           (<:pcdata (localize title))
           (<:pcdata phone))))


(defun address (&rest lines)
  (when lines
    (<:address ()
               (<:pcdata (localize (first lines)))
               (dolist (line (rest lines))
                 (<:br)
                 (<:pcdata (localize line))))))


(defun page* (stream page &key (menu '()))
  (<:with-html-output (stream)
    (<:DOCTYPE
      :LOOSE
      (<:HTML
        ()
        (<:comment "PLEASE DO NOT EDIT THIS FILE!")
        (<:comment "The source of this file is site.lisp")
        (<:HEAD
          ()

          ;; <link rel="shortcut icon"                        href="http://www.ogamita.com/favicon.ico" />
          ;; <link rel="icon" type="image/vnd.microsoft.icon" href="http://www.ogamita.com/favicon.ico" />
          ;; <link rel="icon" type="image/png"                href="http://www.ogamita.com/favicon.png" />

          (<:link (:rel "shortcut icon" :HREF "favicon.ico" :type "image/x-icon"))
          (<:link (:rel "icon"          :HREF "favicon.ico" :type "image/x-icon"))
          (<:link (:rel "stylesheet"    :HREF "default.css" :type "text/css"))
          (when (page-title page)
            (<:TITLE () (<:pcdata (localize (page-title page))))
            (<:META (list :HTTP-EQUIV "Description "
                          :CONTENT (localize (page-title page))
                          :NAME "description")))
          (when (page-author page)
            (<:META (list :NAME "author"
                          :CONTENT (localize (page-author page)))))
          (when (page-keywords page)
            (<:META (list :NAME "keywords"
                          :CONTENT (localize (page-keywords page)))))
          (<:META (:HTTP-EQUIV "Content-Type" :CONTENT "text/html;charset=utf-8")))
        (<:BODY
          ()
          (<:table
            (:class "frame")
            (<:tr ()
                  (<:td (:class "menu"))
                  (<:td ( )
                        (<:img (:src "images/ogamita.png" :alt *corp-name*))
                        (<:br)
                        (<:pcdata *corp-name*)))
            (<:tr (:valign "top")
                  (<:td (:class "menu")
                        (menu menu (find page menu :key (function menu-page))))
                  (<:td (:class "body")
                        (<:div (:class "body") (funcall (page-body page)))))
            (<:tr
              (:valign "top")
              (<:td ()
                    (<:pcdata (localize '(:en "Languages: "
                                          :fr "Langues : "
                                          :es "Idiomas : ")))
                    (dolist (lang *languages*)
                      (<:a (:href (format nil "~A-~(~A~)" (page-url page) lang)
                                  :class "language")
                           (<:pcdata (format nil "~(~A~)" lang)))
                      (<:html-string "&nbsp;")))
              (<:td
                (:height "5%")
                (<:div (:class "copyright")
                    (<:pcdata (format nil "Copyright 2001 - ~D ~A ; "
                                      (nth-value 5 (decode-universal-time
                                                    (get-universal-time)))
                                      *corp-name*))
                  (email "info@ogamita.com"))))))))))




(defun generate-site ()
  (dolist (*language* *languages*)
    (dolist (page *pages*)
      (with-open-file (stream
                       (format nil "~A.html.~(~A~)" (page-url page) *language*)
                       :direction :output
                       :if-does-not-exist :create
                       :if-exists :supersede)
        (format *trace-output* "Generating ~A~%" (pathname stream))
        (finish-output *trace-output*)
        (page* stream page
               :menu (mapcar
                      (lambda (menu)
                        (let ((target-page (find menu *pages*
                                                 :test (function string=)
                                                 :key (function page-url))))
                          (make-menu
                           :url menu
                           :page target-page
                           :title (page-short-title target-page))))
                      *menus*)))
      (with-open-file (stream
                       (format nil "~A-~(~A~).html" (page-url page) *language*)
                       :direction :output
                       :if-does-not-exist :create
                       :if-exists :supersede)
        (format *trace-output* "Generating ~A~%" (pathname stream))
        (finish-output *trace-output*)
        (page* stream page
               :menu (mapcar
                      (lambda (menu)
                        (let ((target-page (find menu *pages*
                                                 :test (function string=)
                                                 :key (function page-url))))
                          (make-menu
                           :url (format nil "~A-~(~A~)" menu *language*)
                           :page target-page
                           :title (page-short-title target-page))))
                      *menus*))))))





(define-languages :en :fr :es)
(define-menu "about" "services" "clients" "products" "contact" "quote")


(define-page "about" (:short-title '(:en "About"
                                     :fr "À propos"
                                     :es "A cerca de")
                      :title (mapcar (lambda (x)
                                       (if (stringp x)
                                           (format nil x *corp-name*)
                                           x))
                                     '(:en "About ~A"
                                       :fr "À propos de ~A"
                                       :es "A cerca de ~A")))
  (p (localize-format nil
                      '(:en "~A is a dynamic corporation composed by
a team of experimented international software developers,
dedicated to fulfill the software needs of our customers."
                        :fr "~A est une société dynamique composée par une
équipe internationnale de développeurs de logiciel expérimentés, qui
se compromettent à satisfaire les besoins de nos clients. "
                        :es "~A es una empresa dinamica compuesto por un equipo
internacional de desarrolladores experimentados,
dedicados a satisfacer nuestros clientes.")
                      *corp-name*))
  (p :en "We specialize in custom software development on
unix (linux, MacOSX), and in dynamic web site development."
     :fr "Nous sommes specialisé en développement de logiciel
personnalisé, sur unix (linux, MacOSX), et de sites web dynamiques."
     :es "Somos especializados en el desarrollo de aplicaciones
personalizadas, sobre unix (linux, MacOSX), y en sitios web dinamicos."))



(define-page "services" (:title '(:en "Services"
                                  :fr "Services"
                                  :es "Servicios"))
  (h2 :en "Software Development"
      :fr "Développement de logiciel"
      :es "Desarrollo de programas")
  (p :en "We provide our customers the following services:"
     :fr "Nous fournissons les services suivants :"
     :es "")
  (<:ul ()
        (li :en "UNIX system & application development."
            :fr "Développement UNIX (système et applications)."
            :es "Desarrollo UNIX (sistema y aplicaciones).")
        (li :en "Object-oriented application development
                 (OpenStep: MacOSX or GNUstep/Linux)."
            :fr "Développement d'applications orienté-objet
                 (OpenStep: MacOSX ou GNUstep/Linux)."
            :es "Desarrollo d'aplicaciones orientado-objecto
                 (OpenStep: MacOSX o GNUstep/Linux).")
        (li :en "Web-based application development."
            :fr "Développement d'applications web dynamique."
            :es "Desarrollo d'aplicaciones web dinamico.")
        (li :en "Internet and intranet design."
            :fr "Conception de serveurs Internet et Intranet."
            :es "Concepción de servidores Internet y Intranet.")
        (li :en "Free software customization."
            :fr "Personalisation de logiciel libre."
            :es "Personalización de programas libre.")))



(define-page "clients" (:title '(:en "Clients"
                                 :fr "Clients"
                                 :es "Clientes"))
  (<:ul ()
        (li :en "For Mappy.com we developped MapTree, a fast geographical
indexing module, for an interactive map application."
            :fr "Nous avons développé pour Mappy.com un module d'indexation
géographique pour une application de cartographie interactive."
            :es "Hemos desarrollado para Mappy.com un modulo de indexación
geográfica rapida, por una aplicación de mapas interactivas.")

        (li :en "For Intergruas.com we developped a web agent collecting
yellow-page addresses."
            :fr "Pour Intergruas.com, nous avons développé un agent web
collectant des adresses postales de répertoires téléphoniques sur le web."
            :es "Para Intergruas.com hemos desarrollado un agente web para
recoger dirrecciones de sitios web de paginas amarillas.")))



(define-page "products" (:title '(:en "Products"
                                  :fr "Produits"
                                  :es "Productos"))
  (p :en "Soon, some nice software will be available here."
     :fr "Prochainement, des jolis programmes seront disponible ici."
     :es "A continuación, programas guapos estaran disponible aquí."))


(define-page "contact" (:title '(:en "Contact Info"
                                 :fr "Contactez nous"
                                 :es "Contactar con nosotros"))
  (p (localize-format
      nil '(:en "We at ~A welcome your inquiries.
Please contact us by any of the following means:"
            :fr "Vous pouvez nous faire part de vos besoins
en nous contactant par :"
            :es "Contacta con nosotros por :")
      *corp-name*))
  (<:p ()
       (b :en "Email"
          :fr "Courriel"
          :es "Correo electrónico")
       (<:br) (email "info@ogamita.com")
       (<:br) (email "sales@ogamita.com"))
  (<:p ()
       (b :en "Phone"
          :fr "Téléphone"
          :es "Teléfono")
       (<:br) (phone "+34636653318" "+34 636 653 318 (Pascal Bourguignon)"))
    (<:p ()
       (b :en "Address"
          :fr "Adresse"
          :es "Dirrección")
       (<:br) (address "C/ José María Bergamin, 7; 2º4"
                       "29660 Marbella Nueva Andalucia"
                       '(:en "Spain"
                         :fr "Espagne"
                         :es "España"))))




(defun form* (method action title &rest items)
  (<:form* (list :method method :action action)
           (cons (<:b* '() (list (<:pcdata* (localize title))))
                 (loop
                    :for item :in items
                    :nconc (if (listp item)
                               item
                               (list item))))))


(defun text-field* (id title &key (size 40))
  (setf title (localize title))
  (list (<:br*) (<:br*) (<:pcdata* title)
        (<:br*) (<:input* (list :type "text"
                                :name id
                                :class "inputbox"
                                :size size))))


(defun text-area* (id title &key (cols 40) (rows 4))
  (setf title (localize title))
  (list (<:br*) (<:br*) (<:pcdata* title)
        (<:br*) (<:textarea* (list :name id
                                   :class "inputbox"
                                   :rows rows :cols cols))))


(defun radio-buttons* (id title &rest choices-plist)
  (setf title (localize title))
  (list* (<:br*) (<:br*) (<:pcdata* title)
         (loop
            :for first = t :then nil
            :for (value label) :on choices-plist :by (function cddr)
            :nconc (list (<:br*)
                         (<:input* (list* :type "radio"
                                          :name id
                                          :value (string value)
                                          (when first
                                            (list :checked "checked"))))
                         (<:pcdata* (localize label))))))


(defun submit* (value) (<:input* (list :type "submit" :value (localize value))))
(defun reset*  (value) (<:input* (list :type "reset"  :value (localize value))))



(define-page "quote-ack" (:title '(:en "Quote Request Acknowledge"
                                   :fr "Demande de devis envoyée"
                                   :es "Demanda enviada"))
  (<:p ()
       (<:pcdata
        (localize '(:en "Thank you " :fr "Merci " :es "Gracias ")))
       (<:comment "CONTACT-PERSON")
       (<:pcdata (localize
                  '(:en " for taking the time to submit your quote request.
We will contact you soon."
                    :fr " pour cette demande de devis.  Nous allons prendre
contact avec vous bientôt."
                    :es " por mandar nos esta pregunta.
Vamos a contactarle pronto. ")))))


(define-page "quote-nak" (:title '(:en "Quote Request - No Acknowledge"
                                   :fr "Demande de devis - Pas envoyée"
                                   :es "Error de transmission"))
  (<:p ()
       (<:pcdata
        (localize '(:en "Sorry " :fr "Désolé " :es "Lo siento ")))
       (<:comment "CONTACT-PERSON")
       (<:pcdata (localize
                  '(:en ", your quote request can't be forwarded.
Please, send your request by email to: "
                    :fr ", je n'ai pas pu envoyer votre demande de
devis.  Veuillez l'envoyer par courriel à : "
                    :es ", no he podido enviar su demanda.
Por favor, envienla por correo electrónico a : ")))
       (email "info@ogamita.com")))





(define-page "quote" (:title '(:en "Request a Quote"
                               :fr "Demandez un devis"
                               :es "Preguntar un precio"))

  (<:p ()
       (<:pcdata
        (localize
         '(:en "You may get a quote  either sending your detailed request
description to:"
           :fr "Vous pouvez demander un devis soit en envoyant un message à :"
           :es "Pueden preguntar por un presupuesto bien por correo
electrónico a :")))
       (email "sales@ogamita.com")
       (<:pcdata
        (localize
         '(:en " or fill out this form:"
           :fr " ou en remplissant ce formulaire :"
           :es " o rellenando este formulario :"))))
  (<:hr)
  (<:collect-element
   (form* "POST" "quote.cgi"
          '(:en "Quote Request Form"
            :fr "Formulaire de demande de devis"
            :es "Fomulario")
          (text-field* :company-name '(:en "Company Name:"
                                       :fr "Nom de votre société :"
                                       :es "Nombre de su empresa :")
                       :size 60)
          (text-field* :contact-person '(:en "Contact Name:"
                                         :fr "Votre nom :"
                                         :es "Su nombre :")
                       :size 60)
          (text-field* :email '(:en "Email:"
                                :fr "Courriel :"
                                :es "Correo electrónico :")
                       :size 60)
          (text-field* :fax '(:en "Fax Number:"
                              :fr "Numéro télcopie :"
                              :es "Número de telecopia :")
                       :size 60)
          (text-field* :phone '(:en "Phone Number:"
                                :fr "Numéro de téléphone :"
                                :es "Número de teléfono :")
                       :size 60)
          (radio-buttons*
           :contact-me '(:en "I prefer to be contacted by:"
                         :fr "Je préfère être contacté par :"
                         :es "Prefiero que me contacten por :")
           :email '(:en "Email"
                    :fr "Courriel"
                    :es "Correo electrónico")
           :fax   '(:en "Fax"
                    :fr "Télécopie"
                    :es "Telecopia")
           :phone '(:en "Phone"
                    :fr "Téléphone"
                    :es "Teléfono"))
          (radio-buttons*
           :request-type '(:en "Type of request:"
                           :fr "Type de requête :"
                           :es "Tipo de pregunta :")
           :unix-sys-dev '(:en "Unix System Development/Maintenance"
                           :fr "Dévelopement système unix/maintenance"
                           :es "Desarrolo sistema unix/mantenimiento")
           :soft-dev '(:en "Application Software Development/Maintenance"
                       :fr "Développment ou maintenance d'applications"
                       :es "Desarrollo o mantenimiento d'aplicaciones")
           :web-dev '(:en "Web Application Development"
                      :fr "Développment d'applications web dynamique"
                      :es "Desarrollo d'aplicaciones web dinamico")
           :unix-admin '(:en "Internet/Intranet Design"
                         :fr "Conception Internet / Intranet"
                         :es "Concepción Internet / Intranet")
           :other '(:en "Other" :fr "Autre" :es "Otro"))

          (text-area* :message
                      '(:en "Description of your request:"
                        :fr "Description de votre demande :"
                        :es "Describe su demanda :")
                      :cols 60 :rows 12)
          (<:br*)(<:br*)
          (submit* '(:en "Submit" :fr "Envoyer"       :es "Enviar"))
          (reset*  '(:en "Reset"  :fr "Réinitialiser" :es "Reiniciar")))))



;;;; THE END ;;;;
ViewGit