From e9509518623d016880392237a298d4561a3b6a0b Mon Sep 17 00:00:00 2001 From: Ludovic Courtes Date: Mon, 31 Oct 2005 16:03:18 +0000 Subject: Removed useless files, integrated packages. * src/guile/skribilo/packages: New directory and files. * bin: Removed. * skr: Removed (files moved to `src/guile/skribilo/packages'). * skribe: Removed. * doc/skr/env.skr (*courtes-mail*): New. * doc/user/user.skb: Removed postal addresses, added my name. * src/guile/skribilo/engine/lout.scm: Uncommented the slide-related markup writers. * src/guile/skribilo/evaluator.scm (%evaluate): Try weird things with source properties. * src/guile/skribilo/reader/skribe.scm: Comply with the new guile-reader API. * src/guile/skribilo/types.scm: Removed the special `initialize' method for ASTs which was supposed to set their location. git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-7 --- skr/web-article.skr | 230 ---------------------------------------------------- 1 file changed, 230 deletions(-) delete mode 100644 skr/web-article.skr (limited to 'skr/web-article.skr') diff --git a/skr/web-article.skr b/skr/web-article.skr deleted file mode 100644 index e33328b..0000000 --- a/skr/web-article.skr +++ /dev/null @@ -1,230 +0,0 @@ -;*=====================================================================*/ -;* serrano/prgm/project/skribe/skr/web-article.skr */ -;* ------------------------------------------------------------- */ -;* Author : Manuel Serrano */ -;* Creation : Sat Jan 10 09:09:43 2004 */ -;* Last change : Wed Mar 24 16:45:08 2004 (serrano) */ -;* Copyright : 2004 Manuel Serrano */ -;* ------------------------------------------------------------- */ -;* A Skribe style for producing web articles */ -;*=====================================================================*/ - -;*---------------------------------------------------------------------*/ -;* &web-article-load-options ... */ -;*---------------------------------------------------------------------*/ -(define &web-article-load-options (skribe-load-options)) - -;*---------------------------------------------------------------------*/ -;* web-article-body-width ... */ -;*---------------------------------------------------------------------*/ -(define (web-article-body-width e) - (let ((w (engine-custom e 'body-width))) - (if (or (number? w) (string? w)) w 98.))) - -;*---------------------------------------------------------------------*/ -;* html-document-title-web ... */ -;*---------------------------------------------------------------------*/ -(define (html-document-title-web n e) - (let* ((title (markup-body n)) - (authors (markup-option n 'author)) - (tbg (engine-custom e 'title-background)) - (tfg (engine-custom e 'title-foreground)) - (tfont (engine-custom e 'title-font))) - (printf "
\n" - (html-width (web-article-body-width e))) - (if (string? tbg) - (printf "
" tbg) - (display "")) - (if (string? tfg) - (printf "" tfg)) - (if title - (begin - (display "
") - (if (string? tfont) - (begin - (printf "" tfont) - (output title e) - (display "")) - (begin - (printf "

") - (output title e) - (display "

"))) - (display "
\n"))) - (if (not authors) - (display "\n") - (html-title-authors authors e)) - (if (string? tfg) - (display "
")) - (display "
\n"))) - -;*---------------------------------------------------------------------*/ -;* web-article-css-document-title ... */ -;*---------------------------------------------------------------------*/ -(define (web-article-css-document-title n e) - (let* ((title (markup-body n)) - (authors (markup-option n 'author)) - (id (markup-ident n))) - ;; the title - (printf "
\n" - (string-canonicalize id)) - (output title e) - (display "
\n") - ;; the authors - (printf "
\n" - (string-canonicalize id)) - (for-each (lambda (a) (output a e)) - (cond - ((is-markup? authors 'author) - (list authors)) - ((list? authors) - authors) - (else - '()))) - (display "
\n"))) - -;*---------------------------------------------------------------------*/ -;* web-article-css-author ... */ -;*---------------------------------------------------------------------*/ -(define (web-article-css-author n e) - (let ((name (markup-option n :name)) - (title (markup-option n :title)) - (affiliation (markup-option n :affiliation)) - (email (markup-option n :email)) - (url (markup-option n :url)) - (address (markup-option n :address)) - (phone (markup-option n :phone)) - (nfn (engine-custom e 'author-font)) - (align (markup-option n :align))) - (when name - (printf "" - (string-canonicalize (markup-ident n))) - (output name e) - (display "\n")) - (when title - (printf "" - (string-canonicalize (markup-ident n))) - (output title e) - (display "\n")) - (when affiliation - (printf "" - (string-canonicalize (markup-ident n))) - (output affiliation e) - (display "\n")) - (when (pair? address) - (printf "" - (string-canonicalize (markup-ident n))) - (for-each (lambda (a) - (output a e) - (newline)) - address) - (display "\n")) - (when phone - (printf "" - (string-canonicalize (markup-ident n))) - (output phone e) - (display "\n")) - (when email - (printf "" - (string-canonicalize (markup-ident n))) - (output email e) - (display "\n")) - (when url - (printf "" - (string-canonicalize (markup-ident n))) - (output url e) - (display "\n")))) - -;*---------------------------------------------------------------------*/ -;* HTML settings */ -;*---------------------------------------------------------------------*/ -(define (web-article-modern-setup he) - (let ((sec (markup-writer-get 'section he)) - (ft (markup-writer-get '&html-footnotes he))) - ;; &html-document-title - (markup-writer '&html-document-title he - :action html-document-title-web) - ;; section - (markup-writer 'section he - :options 'all - :before "
" - :action (lambda (n e) - (let ((e1 (make-engine 'html-web :delegate e)) - (bg (engine-custom he 'section-background))) - (markup-writer 'section e1 - :options 'all - :action (lambda (n e2) (output n e sec))) - (skribe-eval - (center (color :width (web-article-body-width e) - :margin 5 :bg bg n)) - e1)))) - ;; &html-footnotes - (markup-writer '&html-footnotes he - :options 'all - :before "
" - :action (lambda (n e) - (let ((e1 (make-engine 'html-web :delegate e)) - (bg (engine-custom he 'section-background)) - (fg (engine-custom he 'subsection-title-foreground))) - (markup-writer '&html-footnotes e1 - :options 'all - :action (lambda (n e2) - (invoke (writer-action ft) n e))) - (skribe-eval - (center (color :width (web-article-body-width e) - :margin 5 :bg bg :fg fg n)) - e1)))))) - -;*---------------------------------------------------------------------*/ -;* web-article-css-setup ... */ -;*---------------------------------------------------------------------*/ -(define (web-article-css-setup he) - (let ((sec (markup-writer-get 'section he)) - (ft (markup-writer-get '&html-footnotes he))) - ;; &html-document-title - (markup-writer '&html-document-title he - :before (lambda (n e) - (printf "
\n" - (string-canonicalize (markup-ident n)))) - :action web-article-css-document-title - :after "
\n") - ;; author - (markup-writer 'author he - :options '(:name :title :affiliation :email :url :address :phone :photo :align) - :before (lambda (n e) - (printf "\n" - (string-canonicalize (markup-ident n)))) - :action web-article-css-author - :after "" - (string-canonicalize (markup-ident n)))) - :action (lambda (n e) (output n e sec)) - :after "\n") - ;; &html-footnotes - (markup-writer '&html-footnotes he - :options 'all - :before (lambda (n e) - (printf "
" - (string-canonicalize (markup-ident n)))) - :action (lambda (n e) - (output n e ft)) - :after "
\n"))) - -;*---------------------------------------------------------------------*/ -;* Setup ... */ -;*---------------------------------------------------------------------*/ -(let* ((opt &web-article-load-options) - (p (memq :style opt)) - (css (memq :css opt)) - (he (find-engine 'html))) - (cond - ((and (pair? p) (pair? (cdr p)) (eq? (cadr p) 'css)) - (web-article-css-setup he)) - ((and (pair? css) (pair? (cdr css)) (string? (cadr css))) - (engine-custom-set! he 'css (cadr css)) - (web-article-css-setup he)) - (else - (web-article-modern-setup he)))) -- cgit v1.2.3