" (markup-ident n))
- (display "
\n"))
- :action (lambda (n e)
- (let ((nb (markup-option n :number))
- (t (markup-option n :title)))
- (skribe-eval
- (center
- (color :width (slide-body-width e)
- :bg (or (markup-option n :bg) "#ffffff")
- (table :width 100.
- (tr (th :align 'left
- (list
- (if nb
- (format "~a / ~a -- " nb
- (slide-number)))
- t)))
- (tr (td (hrule)))
- (tr (td :width 100. :align 'left
- (markup-body n))))
- (linebreak)))
- e)))
- :after "
")
- ;; slide-vspace
- (markup-writer 'slide-vspace he
- :action (lambda (n e) (display "
"))))
-
-;*---------------------------------------------------------------------*/
-;* latex */
-;*---------------------------------------------------------------------*/
-(define &latex-slide #f)
-(define &latex-pause #f)
-(define &latex-embed #f)
-(define &latex-record #f)
-(define &latex-play #f)
-(define &latex-play* #f)
-
-(let ((le (find-engine 'latex)))
- ;; slide-vspace
- (markup-writer 'slide-vspace le
- :options '(:unit)
- :action (lambda (n e)
- (display "\n\\vspace{")
- (output (markup-body n) e)
- (printf " ~a}\n\n" (markup-option n :unit))))
- ;; slide-slide
- (markup-writer 'slide le
- :options '(:title :number :transition :vfill :toc :vspace :image)
- :action (lambda (n e)
- (if (procedure? &latex-slide)
- (&latex-slide n e))))
- ;; slide-pause
- (markup-writer 'slide-pause le
- :options '()
- :action (lambda (n e)
- (if (procedure? &latex-pause)
- (&latex-pause n e))))
- ;; slide-embed
- (markup-writer 'slide-embed le
- :options '(:alt :command :geometry-opt :geometry
- :rgeometry :transient :transient-opt)
- :action (lambda (n e)
- (if (procedure? &latex-embed)
- (&latex-embed n e))))
- ;; slide-record
- (markup-writer 'slide-record le
- :options '(:tag :play)
- :action (lambda (n e)
- (if (procedure? &latex-record)
- (&latex-record n e))))
- ;; slide-play
- (markup-writer 'slide-play le
- :options '(:tag :color)
- :action (lambda (n e)
- (if (procedure? &latex-play)
- (&latex-play n e))))
- ;; slide-play*
- (markup-writer 'slide-play* le
- :options '(:tag :color :scolor)
- :action (lambda (n e)
- (if (procedure? &latex-play*)
- (&latex-play* n e)))))
-
-;*---------------------------------------------------------------------*/
-;* %slide-seminar-setup! ... */
-;*---------------------------------------------------------------------*/
-(define (%slide-seminar-setup!)
- (skribe-message "Seminar slides setup...\n")
- (let ((le (find-engine 'latex))
- (be (find-engine 'base)))
- ;; latex configuration
- (define (seminar-slide n e)
- (let ((nb (markup-option n :number))
- (t (markup-option n :title)))
- (display "\\begin{slide}\n")
- (if nb (printf "~a/~a -- " nb (slide-number)))
- (output t e)
- (display "\\hrule\n"))
- (output (markup-body n) e)
- (if (markup-option n :vill) (display "\\vfill\n"))
- (display "\\end{slide}\n"))
- (engine-custom-set! le 'documentclass
- "\\documentclass[landscape]{seminar}\n")
- (let ((o (engine-custom le 'predocument)))
- (engine-custom-set! le 'predocument
- (if (string? o)
- (string-append &slide-seminar-predocument o)
- &slide-seminar-predocument)))
- (engine-custom-set! le 'maketitle
- &slide-seminar-maketitle)
- (engine-custom-set! le 'hyperref-usepackage
- "\\usepackage[setpagesize=false]{hyperref}\n")
- ;; slide-slide
- (set! &latex-slide seminar-slide)))
-
-;*---------------------------------------------------------------------*/
-;* %slide-advi-setup! ... */
-;*---------------------------------------------------------------------*/
-(define (%slide-advi-setup!)
- (skribe-message "Generating `Advi Seminar' slides...\n")
- (let ((le (find-engine 'latex))
- (be (find-engine 'base)))
- (define (advi-geometry geo)
- (let ((r (pregexp-match "([0-9]+)x([0-9]+)" geo)))
- (if (pair? r)
- (let* ((w (cadr r))
- (w' (string->integer w))
- (w'' (number->string (/ w' *skribe-slide-advi-scale*)))
- (h (caddr r))
- (h' (string->integer h))
- (h'' (number->string (/ h' *skribe-slide-advi-scale*))))
- (values "" (string-append w "x" h "+!x+!y")))
- (let ((r (pregexp-match "([0-9]+)x([0-9]+)[+](-?[0-9]+)[+](-?[0-9]+)" geo)))
- (if (pair? r)
- (let ((w (number->string (/ (string->integer (cadr r))
- *skribe-slide-advi-scale*)))
- (h (number->string (/ (string->integer (caddr r))
- *skribe-slide-advi-scale*)))
- (x (cadddr r))
- (y (car (cddddr r))))
- (values (string-append "width=" w "cm,height=" h "cm")
- "!g"))
- (values "" geo))))))
- (define (advi-transition trans)
- (cond
- ((string? trans)
- (printf "\\advitransition{~s}" trans))
- ((and (symbol? trans)
- (memq trans '(wipe block slide)))
- (printf "\\advitransition{~s}" trans))
- (else
- #f)))
- ;; latex configuration
- (define (advi-slide n e)
- (let ((i (markup-option n :image))
- (n (markup-option n :number))
- (t (markup-option n :title))
- (lt (markup-option n :transition))
- (gt (engine-custom e 'transition)))
- (if (and i (engine-custom e 'advi))
- (printf "\\advibg[global]{image=~a}\n"
- (if (and (pair? i)
- (null? (cdr i))
- (string? (car i)))
- (car i)
- i)))
- (display "\\begin{slide}\n")
- (advi-transition (or lt gt))
- (if n (printf "~a/~a -- " n (slide-number)))
- (output t e)
- (display "\\hrule\n"))
- (output (markup-body n) e)
- (if (markup-option n :vill) (display "\\vfill\n"))
- (display "\\end{slide}\n\n\n"))
- ;; advi record
- (define (advi-record n e)
- (display "\\advirecord")
- (when (markup-option n :play) (display "[play]"))
- (printf "{~a}{" (markup-option n :tag))
- (output (markup-body n) e)
- (display "}"))
- ;; advi play
- (define (advi-play n e)
- (display "\\adviplay")
- (let ((c (markup-option n :color)))
- (when c
- (display "[")
- (display (skribe-get-latex-color c))
- (display "]")))
- (printf "{~a}" (markup-option n :tag)))
- ;; advi play*
- (define (advi-play* n e)
- (let ((c (skribe-get-latex-color (markup-option n :color)))
- (d (skribe-get-latex-color (markup-option n :scolor))))
- (let loop ((lbls (markup-body n))
- (last #f))
- (when last
- (display "\\adviplay[")
- (display d)
- (printf "]{~a}" last))
- (when (pair? lbls)
- (let ((lbl (car lbls)))
- (match-case lbl
- ((?id ?col)
- (display "\\adviplay[")
- (display (skribe-get-latex-color col))
- (printf "]{" ~a "}" id)
- (skribe-eval (slide-pause) e)
- (loop (cdr lbls) id))
- (else
- (display "\\adviplay[")
- (display c)
- (printf "]{~a}" lbl)
- (skribe-eval (slide-pause) e)
- (loop (cdr lbls) lbl))))))))
- (engine-custom-set! le 'documentclass
- "\\documentclass{seminar}\n")
- (let ((o (engine-custom le 'predocument)))
- (engine-custom-set! le 'predocument
- (if (string? o)
- (string-append &slide-seminar-predocument o)
- &slide-seminar-predocument)))
- (engine-custom-set! le 'maketitle
- &slide-seminar-maketitle)
- (engine-custom-set! le 'usepackage
- (string-append "\\usepackage{advi}\n"
- (engine-custom le 'usepackage)))
- ;; slide
- (set! &latex-slide advi-slide)
- (set! &latex-pause
- (lambda (n e) (display "\\adviwait\n")))
- (set! &latex-embed
- (lambda (n e)
- (let ((geometry-opt (markup-option n :geometry-opt))
- (geometry (markup-option n :geometry))
- (rgeometry (markup-option n :rgeometry))
- (transient (markup-option n :transient))
- (transient-opt (markup-option n :transient-opt))
- (cmd (markup-option n :command)))
- (let* ((a (string-append "ephemeral="
- (symbol->string (gensym))))
- (c (cond
- (geometry
- (string-append cmd " "
- geometry-opt " "
- geometry))
- (rgeometry
- (multiple-value-bind (aopt dopt)
- (advi-geometry rgeometry)
- (set! a (string-append a "," aopt))
- (string-append cmd " "
- geometry-opt " "
- dopt)))
- (else
- cmd)))
- (c (if (and transient transient-opt)
- (string-append c " " transient-opt " !p")
- c)))
- (printf "\\adviembed[~a]{~a}\n" a c)))))
- (set! &latex-record advi-record)
- (set! &latex-play advi-play)
- (set! &latex-play* advi-play*)))
-
-;*---------------------------------------------------------------------*/
-;* %slide-prosper-setup! ... */
-;*---------------------------------------------------------------------*/
-(define (%slide-prosper-setup!)
- (skribe-message "Generating `Prosper' slides...\n")
- (let ((le (find-engine 'latex))
- (be (find-engine 'base))
- (overlay-count 0))
- ;; transitions
- (define (prosper-transition trans)
- (cond
- ((string? trans)
- (printf "[~s]" trans))
- ((eq? trans 'slide)
- (printf "[Blinds]"))
- ((and (symbol? trans)
- (memq trans '(split blinds box wipe dissolve glitter)))
- (printf "[~s]"
- (string-upcase (symbol->string trans))))
- (else
- #f)))
- ;; latex configuration
- (define (prosper-slide n e)
- (let* ((i (markup-option n :image))
- (t (markup-option n :title))
- (lt (markup-option n :transition))
- (gt (engine-custom e 'transition))
- (pa (search-down (lambda (x) (is-markup? x 'slide-pause)) n))
- (lpa (length pa)))
- (set! overlay-count 1)
- (if (>= lpa 1) (printf "\\overlays{~a}{%\n" (+ 1 lpa)))
- (display "\\begin{slide}")
- (prosper-transition (or lt gt))
- (display "{")
- (output t e)
- (display "}\n")
- (output (markup-body n) e)
- (display "\\end{slide}\n")
- (if (>= lpa 1) (display "}\n"))
- (newline)
- (newline)))
- (engine-custom-set! le 'documentclass "\\documentclass[pdf,skribe,slideColor,nototal]{prosper}\n")
- (let* ((cap (engine-custom le 'slide-caption))
- (o (engine-custom le 'predocument))
- (n (if (string? cap)
- (format "~a\\slideCaption{~a}\n"
- &slide-prosper-predocument
- cap)
- &slide-prosper-predocument)))
- (engine-custom-set! le 'predocument
- (if (string? o) (string-append n o) n)))
- (engine-custom-set! le 'hyperref-usepackage "\\usepackage{hyperref}\n")
- ;; writers
- (set! &latex-slide prosper-slide)
- (set! &latex-pause
- (lambda (n e)
- (set! overlay-count (+ 1 overlay-count))
- (printf "\\FromSlide{~s}%\n" overlay-count)))))
-
-;*---------------------------------------------------------------------*/
-;* Setup ... */
-;*---------------------------------------------------------------------*/
-(let* ((opt &slide-load-options)
- (p (memq :prosper opt)))
- (if (and (pair? p) (pair? (cdr p)) (cadr p))
- ;; prosper
- (set! %slide-latex-mode 'prosper)
- (let ((a (memq :advi opt)))
- (if (and (pair? a) (pair? (cdr a)) (cadr a))
- ;; advi
- (set! %slide-latex-mode 'advi)))))
-
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 "\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))))
diff --git a/skr/web-book.skr b/skr/web-book.skr
deleted file mode 100644
index f907c8b..0000000
--- a/skr/web-book.skr
+++ /dev/null
@@ -1,107 +0,0 @@
-;*=====================================================================*/
-;* serrano/prgm/project/skribe/skr/web-book.skr */
-;* ------------------------------------------------------------- */
-;* Author : Manuel Serrano */
-;* Creation : Mon Sep 1 10:54:32 2003 */
-;* Last change : Mon Nov 8 10:43:46 2004 (eg) */
-;* Copyright : 2003-04 Manuel Serrano */
-;* ------------------------------------------------------------- */
-;* The Skribe web book style. */
-;*=====================================================================*/
-
-;*---------------------------------------------------------------------*/
-;* html customization */
-;*---------------------------------------------------------------------*/
-(define he (find-engine 'html))
-(engine-custom-set! he 'main-browsing-extra #f)
-(engine-custom-set! he 'chapter-file #t)
-
-;*---------------------------------------------------------------------*/
-;* main-browsing ... */
-;*---------------------------------------------------------------------*/
-(define main-browsing
- (lambda (n e)
- ;; search the document
- (let ((p (ast-document n)))
- (cond
- ((document? p)
- ;; got it
- (let* ((mt (markup-option p :margin-title))
- (r (ref :handle (handle p)
- :text (or mt (markup-option p :title))))
- (fx (engine-custom e 'web-book-main-browsing-extra)))
- (center
- (table :width 97. :border 1 :frame 'box
- :cellpadding 0 :cellspacing 0
- (tr :bg (engine-custom e 'title-background)
- (th (color :fg (engine-custom e 'background)
- (bold "main page"))))
- (tr :bg (engine-custom e 'background)
- (td (apply table :width 100. :border 0
- (tr (td :align 'left
- :valign 'top
- (bold "top:"))
- (td :align 'right
- :valign 'top r))
- (if (procedure? fx)
- (list (tr (td :width 100.
- :colspan 2
- (fx n e))))
- '()))))))))
- ((not p)
- ;; no document!!!
- #f)))))
-
-;*---------------------------------------------------------------------*/
-;* chapter-browsing ... */
-;*---------------------------------------------------------------------*/
-(define chapter-browsing
- (lambda (n e)
- (center
- (table :width 97. :border 1 :frame 'box
- :cellpadding 0 :cellspacing 0
- (tr :bg (engine-custom e 'title-background)
- (th (color :fg (engine-custom e 'background)
- (bold (markup-option n :title)))))
- (tr :bg (engine-custom e 'background)
- (td (toc (handle n) :chapter #t :section #t :subsection #t)))))))
-
-;*---------------------------------------------------------------------*/
-;* document-browsing ... */
-;*---------------------------------------------------------------------*/
-(define document-browsing
- (lambda (n e)
- (let ((chap (find1-down (lambda (n)
- (is-markup? n 'chapter))
- n)))
- (center
- (table :width 97. :border 1 :frame 'box
- :cellpadding 0 :cellspacing 0
- (tr :bg (engine-custom e 'title-background)
- (th (color :fg (engine-custom e 'background)
- (bold (if chap "Chapters" "Sections")))))
- (tr :bg (engine-custom e 'background)
- (td (if chap
- (toc (handle n) :chapter #t :section #f)
- (toc (handle n) :section #t :subsection #t)))))))))
-
-;*---------------------------------------------------------------------*/
-;* left margin ... */
-;*---------------------------------------------------------------------*/
-(engine-custom-set! he 'left-margin-size 20.)
-
-(engine-custom-set! he 'left-margin
- (lambda (n e)
- (let ((d (ast-document n))
- (c (ast-chapter n)))
- (list (linebreak 1)
- (main-browsing n e)
- (if (is-markup? c 'chapter)
- (list (linebreak 2)
- (chapter-browsing c e))
- #f)
- (if (document? d)
- (list (linebreak 2)
- (document-browsing d e))
- #f)))))
-
--
cgit v1.2.3