This is the source file for this web pages. The Skribe Web page is implemented in Skribe (hence the name meta-circular Skribe homepage).

skb/index.skb
;*=====================================================================*/
;*    serrano/prgm/project/skribe/www/skb/index.skb                    */
;*    -------------------------------------------------------------    */
;*    Author      :  Manuel Serrano                                    */
;*    Creation    :  Mon Sep 15 15:06:04 2003                          */
;*    Last change :  Tue Oct 31 15:41:33 2006 (serrano)                */
;*    Copyright   :  2003-06 Manuel Serrano                            */
;*    -------------------------------------------------------------    */
;*    The meta-circular Skribe home page.                              */
;*=====================================================================*/

;*---------------------------------------------------------------------*/
;*    Styles                                                           */
;*---------------------------------------------------------------------*/
(skribe-load "js-tricks.skr")
(skribe-load "skribehp.skr")
(skribe-load "skribehp-html.skr")
(skribe-load "changelog.skr")
(skribe-load "funs.skr")
(skribe-load "html-navtabs.skr")
(skribe-load "skribehp-rmargin.skr")

;*---------------------------------------------------------------------*/
;*    URLs and Files                                                   */
;*---------------------------------------------------------------------*/
(define *gpl-url* 
   "ftp://ftp.gnu.ai.mit.edu/pub/gnu/COPYING")
(define *scheme-r5rs-url* 
   "http://www-sop.inria.fr/mimosa/fp/Bigloo/doc/r5rs.html")
(define *unice-url*
   "http://www.i3s.unice.fr")
(define *inria-url*
   "http://www.inria.fr")
(define *bigloo-url* 
   "http://www-sop.inria.fr/mimosa/fp/Bigloo")
(define *stklos-url* 
   "http://www.stklos.net")
(define *skribe-ftp* 
   "ftp://ftp-sop.inria.fr/mimosa/fp/Skribe")
(define *mirror-ftp*
   "ftp://kaolin.unice.fr/Skribe")

;*---------------------------------------------------------------------*/
;*    Colors                                                           */
;*---------------------------------------------------------------------*/
(define *stable-color* "#00c80c")
(define *unstable-color* "#ff161d")
(define *ftp-color* "#f1b40e")

(define *skribe-url* "http://www-sop.inria.fr/mimosa/fp/Skribe")
(define *scribe-url* "http://www-sop.inria.fr/mimosa/fp/Scribe")
(define *advi-url* "http://pauillac.inria.fr/activedvi") 

(define *skribe-changelog* "../etc/ChangeLog")

;*---------------------------------------------------------------------*/
;*    *gallesio*                                                       */
;*---------------------------------------------------------------------*/
(define *gallesio*
   (table :width 100.
      (tr (td :align 'left (ref :url "http://saxo.essi.fr/~gallesio"
                 :text (color :fg "blue" (bold "Erick Gallesio")))))
      (tr (td :align 'left (ref :url *unice-url*
                              :text (color :fg "blue"
                                       "Université de Nice - Sophia Antipolis"))))
      (tr (td :align 'left 
             (table 
                (tr (td :align 'left (it "930 route des Colles, BP 145")))
                (tr (td :align 'left (it "F-06903 Sophia Antipolis, Cedex")))
                (tr (td :align 'left (it "France"))))))))

;*---------------------------------------------------------------------*/
;*    *serrano*                                                        */
;*---------------------------------------------------------------------*/
(define *serrano*
   (table :width 100. 
      (tr (td  :align 'left (ref :url "http://www-sop.inria.fr/mimosa/Manuel.Serrano"
                 :text (color :fg "blue" (bold "Manuel Serrano")))))
      (tr (td :align 'left (ref :url *inria-url* 
                              :text (color :fg "blue" 
                                       "Inria Sophia-Antipolis"))))
      (tr (td :align 'left (table
                 (tr (td :align 'left (it "2004 route des Lucioles - BP 93")))
                 (tr (td :align 'left (it "F-06902 Sophia Antipolis, Cedex")))
                 (tr (td :align 'left (it "France"))))))))

;*---------------------------------------------------------------------*/
;*    releases ...                                                     */
;*---------------------------------------------------------------------*/
(define (releases n e)
   (menu e
         :title "Versions"
         (let ((stable (tr (td :align 'left [Stable:])
                           (td :align 'right [
,(color :fg *stable-color* 
    (ref :chapter "Download" :text (bold *skribe-stable-release*))),
,(it *skribe-stable-release-date*)])))
               (unstable (tr (td :align 'left [Unstable:])
                            (td :align 'right [
,(color :fg *unstable-color* 
    (ref :chapter "Download" :text (bold *skribe-unstable-release*))),
,(it *skribe-unstable-release-date*)]))))
            (if (not (string=? *skribe-unstable-release* ""))
                (table :width 100. :border 0 stable unstable)
                (table :width 100. :border 0 stable)))))

;*---------------------------------------------------------------------*/
;*    doc                                                              */
;*---------------------------------------------------------------------*/
(define (doc n e)
   (menu e
         :title "Documentations"
         (table :width 100. :border 0 
            (tr (td :align 'left 
                   (color :fg "blue"
                      (ref :url "doc/user.html" 
                         :text "User manual"))))
            (tr (td :align 'left 
                   (color :fg "blue"
                      (ref :url *scheme-r5rs-url* 
                         :text "Scheme programming language")))))))
 
;*---------------------------------------------------------------------*/
;*    authors ...                                                      */
;*---------------------------------------------------------------------*/
(define (authors n e)
   (menu e
         :title "Authors"
         (table :width 100. :border 0 
            (tr (td :align 'left *gallesio*))
            (tr (td :align 'left (linebreak)))
            (tr (td :align 'left *serrano*)))))

;*---------------------------------------------------------------------*/
;*    skribehp-left-margin ...                                         */
;*---------------------------------------------------------------------*/
(define (skribehp-left-margin n e)
   (list (releases n e)
         (linebreak 1)
         (doc n e)
         (linebreak 1)
         (authors n e)
         (linebreak 1)))

;*---------------------------------------------------------------------*/
;*    The document                                                     */
;*---------------------------------------------------------------------*/
(document :title (table :cellpadding 0 :cellspacing 0
                    (tr (th :align 'left 
                           (font :size +1. (bold "Skribe Home Page"))))
                    (tr (td :align 'left 
                           (it "The functional authoring language"))))
   :html-title "Skribe"
   :html-tabs-bar (linebreak)
  
   ;; New host
   (! "<div class='important'>")
   (p [Manuel Serrano can no longer maintain and develop Skribe. Skribe
is thus looking for a new maintainer. If you feel interested, please
contact Manuel Serrano that is willing to help anyone that will accept
this charge.])
   (! "</div>")

   ;; Presentation
   (p [,(sc "Skribe") is a text processor. Even if it is a general purpose 
tool, it best suits the writing of technical documents such as web pages or
technical reports, API documentations, etc.  At first glance, Skribe
looks like a mark-up language ,(emph "ŕ la") HTML. So, there is
,(bold "no need") to have developed computer programming skills to
use Skribe.])
   
   (p [A second look reveals that Skribe is actually a true programming
language, provided with high level features (such as objects,
higher order functions, regular and syntactic parsing, etc.). Skribe is based
on the ,(ref :url (make-file-name *bigloo-url* "doc/r5rs.html") :text "Scheme")
programming language.])
   
   (p [From Skribe source files it is possible to produce various targets:])
   (itemize 
      (item [HTML pages that can be used to implement a web site (such as 
the Skribe Home Page).])
      (item [XML files.])
      (item [LaTeX files that can be used to produce high quality
Postscript or PDF files.]))
   
   ;; license
   (p [Skribe is the successor of ,(ref :url *scribe-url* :text "Scribe")
(whose development has been abandoned in favor of Skribe). Skribe is 
distributed under the 
,(ref :url *gpl-url* :text "Gnu General Public License").])
   
;*---------------------------------------------------------------------*/
;*    Download                                                         */
;*---------------------------------------------------------------------*/
(include "download.skb")

;*---------------------------------------------------------------------*/
;*    Bigloo ChangeLog                                                 */
;;;*-------------------------------------------------------------------*/
(chapter :title "ChangeLog" :number #f :file #t
   :tabs-color "#674bda"
   :html-tabs-bar (linebreak)
   (prog :line #f (source :language changelog :file *skribe-changelog*)))
   
;*---------------------------------------------------------------------*/
;*    mailing list                                                     */
;*---------------------------------------------------------------------*/
(include "mailing.skb")
   
;*---------------------------------------------------------------------*/
;*    Contributions                                                    */
;*---------------------------------------------------------------------*/
(include "contribs.skb")

;*---------------------------------------------------------------------*/
;*    Examples                                                         */
;*---------------------------------------------------------------------*/
(include "examples.skb"))

download.skb
;*=====================================================================*/
;*    serrano/prgm/project/skribe/www/skb/download.skb                 */
;*    -------------------------------------------------------------    */
;*    Author      :  Manuel Serrano                                    */
;*    Creation    :  Tue Mar  9 06:33:59 2004                          */
;*    Last change :  Thu Dec  8 11:17:31 2005 (serrano)                */
;*    Copyright   :  2004-05 Manuel Serrano                            */
;*    -------------------------------------------------------------    */
;*    Skribe download                                                  */
;*=====================================================================*/

;*---------------------------------------------------------------------*/
;*    Download                                                         */
;*---------------------------------------------------------------------*/
(chapter :title "Download" :number #f :file #t
   
   :html-tabs-bar (linebreak)
   
   ;; download
   (subsection :title "Download" :number #f
      (linebreak)
      (table :width 100.
         (tr (td :width 45.
                (download-table 
                 :title "Stable version"
                 :color *stable-color*
                 (table :width 100.
                    (tr (td :align 'left "version:") 
                       (td :align 'left
                          (color :fg *stable-color* 
                             (bold *skribe-stable-release*))))
                    (tr (td :align 'left "source:")
                       (td  :align 'left (download *skribe-stable-src* #f)))
                    (tr (td)
                       (td :align 'left 
                          (it [(requires 
,(ref :url *bigloo-url* :text "Bigloo") ,(green "2.7a") or greater, 
,(ref :url *stklos-url* :text "STklos") ,(green "0.60") or greater)])))
                    (tr (td :align 'left "pre-compiled:")
                       (td :align 'left (download *skribe-stable-bin* #f)))
                    (tr (td)
                       (td :align 'left 
                          (it [(requires Java (JRE) ,(green "1.3") or greater)]))))))
            (td :width 45.
               (unless (string=? *skribe-unstable-release* "")
                  (download-table 
                   :title "Unstable version"
                   :color *unstable-color*
                   (table :width 100.
                      (tr (td :align 'left "version:") 
                         (td :align 'left
                            (color :fg *unstable-color* 
                               (bold *skribe-unstable-release*))))
                      (tr (td :align 'left "source:")
                         (td  :align 'left 
                            (download *skribe-unstable-src*
                                      #f
                                      *skribe-unstable-alias-src*)))
                      (tr (td)
                         (td :align 'left 
                            (it [(requires 
,(ref :url *bigloo-url* :text "Bigloo") ,(green "2.7a") or greater, 
,(ref :url *stklos-url* :text "STklos") ,(green "0.60") or greater)])))
                      (tr (td :align 'left "pre-compiled:")
                         (td :align 'left 
                            (download *skribe-unstable-bin*
                                      #f
                                      *skribe-unstable-alias-bin*)))
                      (tr (td)
                         (td :align 'left 
                            (it [(requires Java (JRE) ,(green "1.3") or greater)]))))))))))
   
   (linebreak)
   
   ;; other version
   (subsection :title "Ftp servers" :number #f
      (p [Older Skribe distributions can be found at:])
      (table :width 100.
         (tr (td :width 45. 
                (download-table 
                 :title "FTP servers"
                 :color *ftp-color*
                 (table :width 80.
                    (tr (td))
                    (tr (td :align 'left (tt (ref :url *skribe-ftp*))))
                    (tr (td :align 'left (tt (ref :url *mirror-ftp*))))
                    (tr (td)))))
            (td :width 45.)))))
    

mailing.skb
;*=====================================================================*/
;*    serrano/prgm/project/skribe/www/skb/mailing.skb                  */
;*    -------------------------------------------------------------    */
;*    Author      :  Manuel Serrano                                    */
;*    Creation    :  Tue Mar  9 06:35:03 2004                          */
;*    Last change :  Tue Mar  9 06:35:25 2004 (serrano)                */
;*    Copyright   :  2004 Manuel Serrano                               */
;*    -------------------------------------------------------------    */
;*    Skribe mailing list                                              */
;*=====================================================================*/

;*---------------------------------------------------------------------*/
;*    Mailing list                                                     */
;*---------------------------------------------------------------------*/
(chapter :title "Mailing list" :number #f :file #t
   :tabs-color "#a59dff"
   :html-tabs-bar (linebreak)
   
   (p [The Skribe mailing list is now hosted by
,(mailto "sympa@lists-sop.inria.fr?subject=HELP" 
    :text (tt "sophia.inria.fr")).
The new email address is ,(mailto "skribe@sophia.inria.fr"). Information 
requests, subcription/unsubscription to the mailing list must
be sent to ,(mailto "sympa@lists-sop.inria.fr").])
   
   (itemize (item [To ,(bold "subscribe") to the mailing list, simply send a
message with the  words ,(tt "subscribe skribe") in 
the ,(tt "Subject:") field to the above address. Alternatively
you can click the following link:
,(mailto "sympa@lists-sop.inria.fr?subject=subscribe%20skribe" 
    :text "subscribe now")])
      (item [To ,(bold "unsubscribe") to the mailing list, simply send
a message with the word ,(tt "unsubscribe skribe") in the 
,(tt "Subject:") field to ,(tt "sympa@lists-sop.inria.fr").
Alternatively you can click the following link:
,(mailto "sympa@lists-sop.inria.fr?subject=unsubscribe%20skribe" 
    :text "unsubscribe now")])
      (item [To get some ,(bold "help") with the mailing list, simply send
a message with the word ,(tt "HELP") in the ,(tt "Subject:")
field to ,(tt "sympa@lists-sop.inria.fr"). Alternatively you 
can click the following link:
,(mailto "sympa@lists-sop.inria.fr?subject=HELP" 
    :text "help now")])))


contribs.skb
;*=====================================================================*/
;*    serrano/prgm/project/skribe/www/skb/contribs.skb                 */
;*    -------------------------------------------------------------    */
;*    Author      :  Manuel Serrano                                    */
;*    Creation    :  Mon Mar  8 09:42:00 2004                          */
;*    Last change :  Tue Oct 31 16:39:23 2006 (serrano)                */
;*    Copyright   :  2004-06 Manuel Serrano                            */
;*    -------------------------------------------------------------    */
;*    The Skribe contributions                                         */
;*=====================================================================*/

;*---------------------------------------------------------------------*/
;*    *skribe-contributions* ...                                       */
;*---------------------------------------------------------------------*/
(define *skribe-contributions*
   '("html-navtabs"
     "html-gui"
     "fontsample"
     "skribeinfo"
     "skribecolsel"
     "longtable"))

;*---------------------------------------------------------------------*/
;*    *skribe-contributions-sorted*                                    */
;*---------------------------------------------------------------------*/
(define *skribe-contributions-sorted*
   (sort *skribe-contributions* string<?))

;*---------------------------------------------------------------------*/
;*    Right margin                                                     */
;*---------------------------------------------------------------------*/
(let ((he (find-engine 'html)))
   (engine-custom-set! he 'html-right-margin-contribs
      (lambda (n e)
         (list (menu-contrib 
                e
                (table (map (lambda (i) 
                               (tr (td :align 'right 
                                      (color :fg "blue" 
                                         (bold (ref :mark i))))))
                            *skribe-contributions-sorted*)))
               (linebreak 1)))))

;*---------------------------------------------------------------------*/
;*    untar ...                                                        */
;*---------------------------------------------------------------------*/
(define (untar contrib)
   (with-input-from-file 
         (format "| tar xfz contribs/~a.tgz ~a/CONTRIB.skb -O 2> /dev/null"
                 contrib contrib)
      (lambda ()
         `(,(skribe-read) ,(string-append "contribs/" contrib ".tgz")))))

;*---------------------------------------------------------------------*/
;*    Contributions                                                    */
;*---------------------------------------------------------------------*/
(chapter :title "Contributions" :number #f :file #t
   :class "right-margin" :ident "contribs"
   :tabs-color "#dedeff"
   :html-tabs-bar (linebreak)
   (let* ((contribs *skribe-contributions-sorted*)
          (len (length contribs))
          (split (list-split contribs 
                             (+ (inexact->exact (truncate (/ len 2)))
                                (remainder len 2))
                             #f)))
      (table :width 100. :cellpadding 2
         (map (lambda (c1 c2)
                 (tprint "untar=" (untar c1))
                 (tr (td :valign 'top :align 'center :width 45.
                        (and c1 (eval (untar c1)) ))
                    (td :valign 'top :align 'center :width 45.
                       (and c2 (eval (untar c2))))))
              (car split) (cadr split)))))

examples.skb
;*=====================================================================*/
;*    serrano/prgm/project/skribe/www/skb/examples.skb                 */
;*    -------------------------------------------------------------    */
;*    Author      :  Manuel Serrano                                    */
;*    Creation    :  Tue Mar  9 06:20:01 2004                          */
;*    Last change :  Tue Mar  9 19:23:42 2004 (serrano)                */
;*    Copyright   :  2004 Manuel Serrano                               */
;*    -------------------------------------------------------------    */
;*    Skribe examples                                                  */
;*=====================================================================*/

;*---------------------------------------------------------------------*/
;*    Right margin                                                     */
;*---------------------------------------------------------------------*/
(let ((he (find-engine 'html)))
   (engine-custom-set! he 'right-margin-size "150")
   (engine-custom-set! he 'html-right-margin-examples
      (lambda (n e)
         (let* ((c (car (filter (lambda (s)
                                   (and (markup? s)
                                        (is-markup? s 'chapter)))
                                (find-markup-ident "examples"))))
                (s (container-search-down (lambda (s)
                                             (and (markup? s)
                                                  (is-markup? s 'section)))
                                          c)))
            (list (menu-example
                   e
                   (table (map (lambda (s)
                                  (tr (td :align 'right
                                         (color :fg "blue"
                                            (bold 
                                               (ref :handle (handle s)
                                                  :text (markup-ident s)))))))
                               s))
                   (linebreak 1)))))))

;*---------------------------------------------------------------------*/
;*    Examples ...                                                     */
;*---------------------------------------------------------------------*/
(chapter :title "Examples" :number #f :file #t 
   :class "right-margin" :ident "examples"
   :tabs-color "#dedeff"
   :html-tabs-bar (linebreak)
   
   (section :title "Letter" :number #f :file #f
      (p [This example illustrates how to compose a simple letter 
with Skribe.])
   
      (example :directory "examples/letter/"     
               :sources '("letter.skb")
               :outputs '("letter.pdf" "letter.html")))
   
;*---------------------------------------------------------------------*/
;*    slides                                                           */
;*---------------------------------------------------------------------*/
(section :title "Slides" :number #f :file #t :no-tabs #t
   :class "right-margin"
   :tabs-color "#dedeff"
   :html-tabs-bar (linebreak)
   
   (p [This example illustrates how to authoring slides with Skribe. 
The DVI version must be projected with ,(ref :url *advi-url* :text "Advi").])
   
   (example :directory "examples/slide/"     
            :sources '("slide.skb" "skribe.skb" "syntax.skb" 
                                   "itemize.skb" "fact.skb" "factb.skb" 
                                   "style.skr")
            :outputs '("slide.dvi" "slide.pdf" "slide.html")))
   
;*---------------------------------------------------------------------*/
;*    article                                                          */
;*---------------------------------------------------------------------*/
(section :title "Article" :number #f :file #t :no-tabs #t 
   :class "right-margin"
   :tabs-color "#dedeff"
   :html-tabs-bar (linebreak)
   
   (p [This example is an scientific article written in Skribe.
This example is pretty simple since it does not uses any introspection
facilities. The outputs shows that with a single source file, it is possible
to produce output files with different shapes. For this example, we
have used the ,(code "-p") option that forces the Skribe engine
to pre-loads a configuration file before processing a source file. The
configuration files used for this example contain setting for the LNCS
and ACMPROC Latex styles.])
   
   (example :directory "examples/article/"
            :sources '("article.skb")
            :outputs '("article.html" "article-lncs.pdf" 
                                      "article-acmproc.pdf")))
   
;*---------------------------------------------------------------------*/
;*    Meta-circular                                                    */
;*---------------------------------------------------------------------*/
(section :title "Web pages" :number #f :file #t :no-tabs #t 
   :class "right-margin"
   :tabs-color "#dedeff"
   :html-tabs-bar (linebreak)

   (p [This is the source file for this web pages. The Skribe Web page is 
implemented in Skribe (hence the name 
,(emph  "meta-circular Skribe homepage")).])
   
   (example :sources '("skb/index.skb"
                       "skb/download.skb"
                       "skb/mailing.skb"
                       "skb/contribs.skb"
                       "skb/examples.skb"
                       "skr/skribehp.skr"
                       "skr/changelog.skr"
                       "skr/skribehp-html.skr"
                       "skr/skribehp-rmargin.skr"))))


skribehp.skr
;*=====================================================================*/
;*    serrano/prgm/project/skribe/www/skr/skribehp.skr                 */
;*    -------------------------------------------------------------    */
;*    Author      :  Manuel Serrano                                    */
;*    Creation    :  Sat Mar  6 06:28:42 2004                          */
;*    Last change :  Mon Sep 12 18:19:19 2005 (serrano)                */
;*    Copyright   :  2004-05 Manuel Serrano                            */
;*    -------------------------------------------------------------    */
;*    Skribe Home Page settings                                        */
;*=====================================================================*/

;*---------------------------------------------------------------------*/
;*    menu ...                                                         */
;*---------------------------------------------------------------------*/
(define-markup (menu e #!rest opt #!key title)
   (table :width 95. :cellpadding 0 :cellspacing 0
          :class "menu"
          (tr (th :align 'left 
                 (list (! "<div class=\"header\">")
                       (bold title)
                       (! "</div>"))))
          (tr :bg (engine-custom e 'background) 
              (td (list (! "<div class=\"body\">")
                        (the-body opt)
                        (! "</div>"))))))

;*---------------------------------------------------------------------*/
;*    download-table ...                                               */
;*---------------------------------------------------------------------*/
(define-markup (download-table #!rest opt #!key title color)
   (table :width 95. :cellpadding 0 :cellspacing 0
      :class "download"
      (tr (th :align 'left
             (list (! (format
                       "<div class=\"header\" style=\"background: ~a; border-color: ~a\">" 
                       color color))
                   (bold title)
                   (! "</div>"))))
      (tr (td :align 'left 
             (list (! (format 
                       "<div class=\"body\" style=\"border-color: ~a\">" 
                       color))
                   (the-body opt)
                   (! "</div>"))))))

;*---------------------------------------------------------------------*/
;*    download ...                                                     */
;*---------------------------------------------------------------------*/
(define (download file dir . alias)
   (let ((afile (if (pair? alias) (car alias) file))
         (ftp (if (string? dir)
                  (make-file-name *skribe-ftp* dir)
                  *skribe-ftp*)))
      (if (and (string? afile) (not (string=? afile "")))
          (if (not (file-exists? afile))
              (begin
                 (skribe-warning 0 'download "File does not exist: " afile)
                 "")
              [,(ref :url (make-file-name ftp 
                                          (if (or (null? alias)
                                                  (null? (cdr alias)))
                                              (basename file)
                                              (make-file-name 
                                               (cadr alias)
                                               (basename file))))
                     :text (bold (basename file)))
(,(inexact->exact (/ (file-size afile) 1024))k)])
          "")))

;*---------------------------------------------------------------------*/
;*    menu-contrib ...                                                 */
;*---------------------------------------------------------------------*/
(define-markup (menu-contrib e #!rest opt)
   (flush :side 'right
      (table :width 95. :cellpadding 0 :cellspacing 0
         :class "menu-contrib"
         (tr (th :align 'left 
                (list (! "<div class=\"header\">")
                      (bold "All Contributions")
                      (! "</div>"))))
         (tr :bg (engine-custom e 'background) 
            (td :align 'right (list (! "<div class=\"body\">")
                                    (the-body opt)
                                    (! "</div>")))))))


;*---------------------------------------------------------------------*/
;*    menu-example ...                                                 */
;*---------------------------------------------------------------------*/
(define-markup (menu-example e #!rest opt)
   (flush :side 'right
      (table :width 95. :cellpadding 0 :cellspacing 0
         :class "menu-contrib"
         (tr (th :align 'left 
                (list (! "<div class=\"header\">")
                      (bold "All Examples")
                      (! "</div>"))))
         (tr :bg (engine-custom e 'background) 
            (td :align 'right (list (! "<div class=\"body\">")
                                    (the-body opt)
                                    (! "</div>")))))))


;*---------------------------------------------------------------------*/
;*    contribution ...                                                 */
;*---------------------------------------------------------------------*/
(define-markup (contribution #!rest opt 
                             #!key title 
                             version
                             date
                             author
                             description
                             type
                             skribe-version
                             requirements)
   (lambda (tarball)
      (let* ((hdsym (cond
                       ((symbol? type) type)
                       ((string? type) (string->symbol type))
                       (else #f)))
             (hdcolor (case hdsym
                         ((ext-html) "#ffc11a")
                         ((ext-latex) "#ff1124")
                         (else "#b8ff5c")))
             (type (case hdsym
                      ((ext-html) "HTML extension")
                      ((ext-latex) "LaTeX extension")
                      (else (string-capitalize (symbol->string hdsym)))))
             (sversion (with-output-to-string
                          (lambda () (display skribe-version)))))
         (list
          (mark (string-downcase title))
          (table :width 95. :cellpadding 0 :cellspacing 0
             :class "contribution"
             (tr (th :align 'left
                    (list (! "<div class=\"header\" style=\"background: $1; border-color: $1\">"
                             hdcolor)
                          (bold title)
                          (! "</div>"))))
             (tr (td :align 'left 
                    (list (! "<div class=\"body\" style=\"border-color: $1\">" hdcolor)
                          (table :width 100.
                             (tr (th :colspan 2 :align 'left description))
                             (tr (td :colspan 2))
                             (tr (td :align 'left [download:])
                                (td :align 'right (download (basename tarball)
                                                            "contribs"
                                                            tarball)))
                             (tr (td :align 'left [version:])
                                (td :align 'right (color :fg *stable-color*
                                                     (bold version))))
                             (tr (td :align 'left [date:])
                                (td :align 'right (bold date)))
                             (tr (td :align 'left [author:])
                                (td :align 'right (bold author)))
                             (tr (td :align 'left [type:])
                                (td :align 'right (bold type)))
                             (tr (td :align 'left [skribe version:])
                                (td :align 'right (bold sversion)))
                             (tr (td :align 'left [requirements:])
                                (td :align 'right requirements)))
                          (! "</div>")))))))))

;*---------------------------------------------------------------------*/
;*    prog-table ...                                                   */
;*---------------------------------------------------------------------*/
(define-markup (prog-table #!rest opt 
                           #!key title (color "#8248b1") (bg "#d5d0ff"))
   (case (string->symbol (suffix title))
      ((skr) (set! bg "#ffeeff"))
      ((skb) (set! bg "#ffffee")))
   (table :width 95. :cellpadding 0 :cellspacing 0
      :class "prog"
      (tr (th :align 'left
             (list (! (format 
                       "<div class=\"header\" style=\"background: ~a; border-color: ~a\">" 
                       color color))
                   (bold title)
                   (! "</div>"))))
      (tr (td :align 'left 
             (list (! (format
                       "<div class=\"body\" style=\"background: ~a; border-color: ~a\">" 
                       bg color))
                   (the-body opt)
                   (! "</div>"))))))

;*---------------------------------------------------------------------*/
;*    example ...                                                      */
;*---------------------------------------------------------------------*/
(define-markup (example #!rest opt #!key (directory "") sources outputs)
   (list
    (when (pair? outputs)
       (table (tr (td "View demo...")
                 (td (js-tricks-multirefs 
                      :label "select format" 
                      (map (lambda (s) 
                              (list (string-append directory s)
                                    (case (string->symbol (suffix s))
                                       ((ps ps.gz) "PostScript")
                                       ((dvi dvi.gz) "DVI")
                                       ((pdf) "PDF")
                                       ((html) "HTML")
                                       (else s))))
                           outputs))))
          (tr (td (linebreak)))))
    (apply table :width 100. :cellpadding 0 :cellspacing 0
           (tr (td :width 100.
                  (list
                   (prog-table :title (car sources)
                               (prog :line #f
                                  (source :language skribe 
                                     :file (string-append directory 
                                                          (car sources)))))
                   (linebreak))))
           (map (lambda (s)
                   (tr (td :width 100.
                          (list
                           (prog-table :title (basename s)
                                       (prog :line #f
                                          (source :language skribe 
                                             :file (string-append directory s))))
                           (linebreak)))))
                (cdr sources)))))

;*---------------------------------------------------------------------*/
;*    button ...                                                       */
;*---------------------------------------------------------------------*/
(define-markup (button #!rest opt #!key (color "red"))
   (list (! (format "<div class=\"button\" style=\"background: ~a\">" color))
         (bold (the-body opt))
         (! "</div>")))

changelog.skr
;*=====================================================================*/
;*    serrano/prgm/project/skribe/www/skr/changelog.skr                */
;*    -------------------------------------------------------------    */
;*    Author      :  Manuel Serrano                                    */
;*    Creation    :  Wed Jan  9 14:08:15 2002                          */
;*    Last change :  Tue Dec 20 18:30:53 2005 (serrano)                */
;*    Copyright   :  2002-05 Manuel Serrano                            */
;*    -------------------------------------------------------------    */
;*    ChangeLog style                                                  */
;*=====================================================================*/

;*---------------------------------------------------------------------*/
;*    changelog-fontifier ...                                          */
;*---------------------------------------------------------------------*/
(define changelog-fontifier
   (let ((g (regular-grammar ()
               ((bol (: (in ("AZ")) (+ all) #\:))
                ;; release date
                (let* ((str (the-string))
                       (pos (pregexp-match-positions "\\([^)]+\\):" str)))
                   (match-case pos
                      (((?start . ?stop))
                       (cons* (substring str 0 start)
                              (bold (substring str start (-fx stop 1)))
                              ":"
                              (ignore)))
                      (else
                       (cons str (ignore))))))
               ((bol (: (+ (in " \t")) (>= 4 #\*)))
                ;; distribution
                (let* ((dist (the-string))
                       (s (let loop ((i (- (string-length dist) 1)))
                             (cond
                                ((char=? (string-ref dist i) #\*)
                                 (loop (- i 1)))
                                (else
                                 (substring dist 0 (+ i 1)))))))
                   (rgc-context 'release)
                   (cons (color :fg "#0000ff" (bold (string-append s "***")))
                         (ignore))))
               ((context release (* all))
                (rgc-context)
                (let ((release (the-string)))
                   (cons (color :fg "#0000ff" (bold (it release)))
                         (ignore))))
               ((bol (: (+ (in " \t")) #\* (out #\*)))
                ;; new features
                (let ((chg (the-string))
                      (len (the-length)))
                   (cons (color :fg "#00cc00"
                                (bold (string-append
                                       (substring chg 0 (-fx len 1))
                                       "** ")))
                         (ignore))))
               ((bol (: (+ (in " \t")) (= 3 #\*) (out #\*)))
                ;; bug fix
                (let ((distrib (the-string)))
                   (cons (color :fg "#ff0000" (bold distrib)) (ignore))))
               ((+ (out #\* #\Newline))
                ;; plain strings
                (let ((str (the-string)))
                   (cons str (ignore))))
               ((+ (or #\Newline #\*))
                ;; new lines
                (let ((nl (the-string)))
                   (cons nl (ignore))))
               (else
                ;; default
                (let ((c (the-failure)))
                   (if (eof-object? c)
                       '()
                       (skribe-error 'changelog "Unexpected character" c)))))))
      (lambda (s)
         (apply append
                (map (lambda (s)
                        (with-input-from-string s
                           (lambda ()
                              (cons "\n" (read/rp g (current-input-port))))))
                     (with-input-from-string s
                        (lambda ()
                           (read-lines (current-input-port)))))))))

;*---------------------------------------------------------------------*/
;*    changelog ...                                                    */
;*---------------------------------------------------------------------*/
(define changelog
   (new language
      (name "changelog")
      (fontifier changelog-fontifier)
      (extractor #f)))

skribehp-html.skr
;*=====================================================================*/
;*    serrano/prgm/project/skribe/www/skr/skribehp-html.skr            */
;*    -------------------------------------------------------------    */
;*    Author      :  Manuel Serrano                                    */
;*    Creation    :  Sat Mar  6 06:28:42 2004                          */
;*    Last change :  Mon Mar 15 10:54:36 2004 (serrano)                */
;*    Copyright   :  2004 Manuel Serrano                               */
;*    -------------------------------------------------------------    */
;*    Skribe Home Page HTML settings                                   */
;*=====================================================================*/

;*---------------------------------------------------------------------*/
;*    Default engine                                                   */
;*---------------------------------------------------------------------*/
(push-default-engine (find-engine 'html))

;*---------------------------------------------------------------------*/
;*    &html-skribehp-generic-title ...                                 */
;*---------------------------------------------------------------------*/
(define (&html-skribehp-generic-title n e)
   (let ((title (markup-body n))
         (authors (markup-option n 'author)))
      (print "<div class=\"header\">")
      (print "<table cellspacing=\"0\" cellpadding=\"0\">")
      (print "<tr><td class=\"header\" align=\"left\" valign=\"top\">")
      (print "<div class=\"title\">")
      (output title e)
      (print "</div>")
      (print "</td></tr>")
      (print "</table>")
      (print "</div>")))

;*---------------------------------------------------------------------*/
;*    &html-document-title ...                                         */
;*---------------------------------------------------------------------*/
(markup-writer '&html-document-title :action &html-skribehp-generic-title)
(markup-writer '&html-chapter-title :action &html-skribehp-generic-title)
(markup-writer '&html-section-title :action &html-skribehp-generic-title)
(markup-writer '&html-subsection-title :action &html-skribehp-generic-title)
(markup-writer '&html-subsubsection-title :action &html-skribehp-generic-title)

;*---------------------------------------------------------------------*/
;*    HTML customizations                                              */
;*---------------------------------------------------------------------*/
(let* ((he (find-engine 'html))
       (tro (markup-writer-get 'tr he))
       (chapho (markup-writer-get '&html-chapter-header he))
       (o (engine-custom he 'left-margin-background)))
   (markup-writer 'tr
      :class 'download-header
      :options '(:width :bg)
      :action (lambda (n e)
                 (let ((c (engine-custom e 'title-background)))
                    (markup-option-add! n :bg c)
                    (output n e tro))))
   (markup-writer 'tr
      :class 'download-plain
      :options '(:width :bg)
      :action (lambda (n e)
                 (let ((c (engine-custom e 'section-title-background)))
                    (markup-option-add! n :bg c)
                    (output n e tro))))
   (markup-writer '&html-chapter-header
      :options 'all
      :action (lambda (n e)
                 (let ((c (markup-option (ast-parent n) :tabs-color)))
                    (engine-custom-set! e 'left-margin-background (or c o))
                    (engine-custom-set! e 'right-margin-background (or c o)))
                 (output n e chapho)))
   (let* ((img-html (engine-custom he 'html4-logo))
          (url-html (engine-custom he 'html4-validator))
          (img-css "http://jigsaw.w3.org/css-validator/images/vcss")
          (url-css "http://jigsaw.w3.org/css-validator/check/referer")
          (img-skribe "skribe.png")
          (bottom (list (table :width 100. :border 0
                           (tr
                              (td :align 'left :valign 'bottom
                                 (font :size -1 [Last update ,(it (date)).]))
                              (td :align 'right :valign 'top :width 95
                                 (ref :url (skribe-url)
                                    :text (image :file img-skribe :width 88 :height 31)))
;*                            (td :align 'right :valign 'top :width 95 */
;*                               (ref :url url-css                     */
;*                                  :text (image :url img-css :width 88 :height 31))) */
                              (td :align 'right :valign 'top :width 95
                                 (ref :url url-html
                                    :text (image :url img-html :width 88 :height 31))))))))
      (markup-writer '&html-ending
         :before "<div class=\"skribe-ending\">"
         :action (lambda (n e)
                    (let ((body (markup-body n)))
                       (if body
                           (output body #t)
                           (skribe-eval bottom e))))
         :after "</div>\n"))
   (let ((armed #f))
      (markup-writer 'prog
         :class 'example
         :predicate (lambda (n e) (not armed))
         :options 'all
         :action (lambda (n e)
                    (set! armed #t)
                    (skribe-eval
                     (color :bg "#ffffcc" :width 100. (font :size -1 n))
                     e)
                    (set! armed #f))))
   (engine-custom-set! he 'favicon "img/lambda.png")
   (engine-custom-set! he 'css "skribehp.css")
   (engine-custom-set! he 'margin-padding 0)
   (engine-custom-set! he 'left-margin-size 20.)
   (engine-custom-set! he 'left-margin (lambda (n e)
                                          (skribehp-left-margin n e)))
   (engine-custom-set! he 'javascript #t))

;*---------------------------------------------------------------------*/
;*    Restore default engine                                           */
;*---------------------------------------------------------------------*/
(pop-default-engine)

skribehp-rmargin.skr
;*=====================================================================*/
;*    serrano/prgm/project/skribe/www/skr/skribehp-rmargin.skr         */
;*    -------------------------------------------------------------    */
;*    Author      :  Manuel Serrano                                    */
;*    Creation    :  Sat Mar  6 06:28:42 2004                          */
;*    Last change :  Tue Mar  9 06:32:32 2004 (serrano)                */
;*    Copyright   :  2004 Manuel Serrano                               */
;*    -------------------------------------------------------------    */
;*    Skribe Home Page HTML settings                                   */
;*=====================================================================*/

;*---------------------------------------------------------------------*/
;*    Default engine                                                   */
;*---------------------------------------------------------------------*/
(push-default-engine (find-engine 'html))

;*---------------------------------------------------------------------*/
;*    HTML settings                                                    */
;*---------------------------------------------------------------------*/
(let ((he (find-engine 'html)))
   (engine-custom-set! he 'right-margin-size "20em")
   (markup-writer 'chapter
      :options 'all
      :class "right-margin"
      :predicate (lambda (n e)
                    (eq? (engine-ident e) 'html))
      :action (lambda (n e) 
                 (let ((e2 (copy-engine (gensym 'html) e)))
                    (engine-custom-set! e2 'right-margin
                       (engine-custom e 
                          (symbol-append 'html-right-margin-
                                         (string->symbol (markup-ident n)))))
                    (skribe-eval n e2)))))

;*---------------------------------------------------------------------*/
;*    Restore default engine                                           */
;*---------------------------------------------------------------------*/
(pop-default-engine)

Last update Wed Jun 30 08:26:02 2010.