From cd6ac77684194a5f0ee9a8672f207d1edfdd6640 Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Fri, 25 Aug 2023 23:56:09 +0100 Subject: html: Abstract out opening and closing of HTML tags. * src/guile/skribilo/engine/html.scm: Import (srfi srfi-26). (html-open, html-close): New functions. (html-markup-class, &html-head, &html-body, &html-page, &html-header-favicon, &html-header-css, &html-header-javascript, &html-generic-title, &html-footnotes, html-title-authors, author, toc, chapter, html-section-title, paragraph, footnote, linebreak, hrule, color, frame, font, flush, itemize, enumerate, description, item, blockquote, figure, &html-figure-legend, table, tr, tc, image, mailto, mark, ref, url-ref, &prog-line, &bib-entry-label, &the-index-header): Use html-open and html-close. --- src/guile/skribilo/engine/html.scm | 848 ++++++++++++++++++++++--------------- 1 file changed, 499 insertions(+), 349 deletions(-) (limited to 'src/guile') diff --git a/src/guile/skribilo/engine/html.scm b/src/guile/skribilo/engine/html.scm index da40475..088d168 100644 --- a/src/guile/skribilo/engine/html.scm +++ b/src/guile/skribilo/engine/html.scm @@ -44,6 +44,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-13) #:use-module (srfi srfi-14) + #:use-module (srfi srfi-26) #:use-module (srfi srfi-39) #:export (html-engine html-title-engine html-file @@ -574,14 +575,42 @@ (if (or (string? c) (symbol? c) (number? c)) (format #t " class=\"~a\"" c))))) +;*---------------------------------------------------------------------*/ +;* html-open ... */ +;*---------------------------------------------------------------------*/ +(define* (html-open tag #:optional (attributes '())) + "Output opening TAG with ATTRIBUTES, an association list mapping +attribute names to their values. Attribute names may be symbols or +strings. Values may be symbols, strings or numbers. Attributes with +unspecified or #f values are ignored." + (display "<") + (display tag) + (for-each (match-lambda + ((name . value) + (when (and value + (not (unspecified? value))) + (format #t " ~a=\"~a\"" name value)))) + attributes) + (display ">") + (newline)) + +;*---------------------------------------------------------------------*/ +;* html-close ... */ +;*---------------------------------------------------------------------*/ +(define (html-close tag) + "Output closing TAG." + (display "") + (newline)) + ;*---------------------------------------------------------------------*/ ;* html-markup-class ... */ ;*---------------------------------------------------------------------*/ (define (html-markup-class m) - (lambda (n e) - (format #t "<~a" m) - (html-class n) - (display ">"))) + (lambda (n e) + (html-open m + `((class . ,(markup-class n)))))) ;*---------------------------------------------------------------------*/ ;* html-color-spec? ... */ @@ -629,10 +658,12 @@ ;*---------------------------------------------------------------------*/ (markup-writer '&html-head :before (lambda (n e) - (display "\n") - (display "\n" (engine-custom (find-engine 'html) - 'charset)) + (html-open 'head) + (html-open 'meta + `((http-equiv . "Content-Type") + (content . "text/html;") + (charset . ,(engine-custom (find-engine 'html) + 'charset)))) (let ((head (engine-custom e 'head))) (when head (display head) @@ -655,10 +686,10 @@ (markup-writer '&html-body :before (lambda (n e) (let ((bg (engine-custom e 'background))) - (display "\n"))) + (html-open 'body + `((class . ,(markup-class n)) + (bgcolor . ,(and (html-color-spec? bg) + bg)))))) :after "\n") ;*---------------------------------------------------------------------*/ @@ -667,26 +698,30 @@ (markup-writer '&html-page :action (lambda (n e) (define (html-margin m fn size bg fg cla) - (format #t "" bg) - (display ">")) - (format #t "
\n" cla) - (cond - ((and (string? fg) (string? fn)) - (format #t "" fg fn)) - ((string? fg) - (format #t "" fg)) - ((string? fn) - (format #t "" fn))) - (if (procedure? m) - (evaluate-document (m n e) e) - (output m e)) - (if (or (string? fg) (string? fn)) - (display "")) - (display "
\n")) + (html-open 'td + `((align . "left") + (valign . "top") + (class . ,cla) + (width . ,(and size (html-width size))) + (bgcolor . ,(and (html-color-spec? bg) + bg)))) + (html-open 'div + `((class . ,cla))) + (cond + ((and (string? fg) (string? fn)) + (format #t "" fg fn)) + ((string? fg) + (html-open 'font + `((color . ,fg)))) + ((string? fn) + (format #t "" fn))) + (if (procedure? m) + (evaluate-document (m n e) e) + (output m e)) + (if (or (string? fg) (string? fn)) + (html-close 'font)) + (html-close 'div) + (html-close 'td)) (let ((body (markup-body n)) (lm (engine-custom e 'left-margin)) (lmfn (engine-custom e 'left-margin-font)) @@ -702,27 +737,45 @@ ((and lm rm) (let* ((ep (engine-custom e 'margin-padding)) (ac (if (number? ep) ep 0))) - (format #t "\n" ac)) + (html-open 'table + `((cellpadding . ,ac) + (cellspacing . "0") + (width . "100%") + (class . "skribilo-margins"))) + (html-open 'tr)) (html-margin lm lmfn lms lmbg lmfg "skribilo-left-margin") (html-margin body #f #f #f #f "skribilo-body") (html-margin rm rmfn rms rmbg rmfg "skribilo-right-margin") - (display "
")) + (html-close 'tr) + (html-close 'table)) (lm (let* ((ep (engine-custom e 'margin-padding)) (ac (if (number? ep) ep 0))) - (format #t "\n" ac)) + (html-open 'table + `((cellpadding . ,ac) + (cellspacing . "0") + (width . "100%") + (class . "skribilo-margins"))) + (html-open 'tr)) (html-margin lm lmfn lms lmbg lmfg "skribilo-left-margin") (html-margin body #f #f #f #f "skribilo-body") - (display "
")) + (html-close 'tr) + (html-close 'table)) (rm - (display "\n") + (html-open 'table + `((cellspacing . "0") + (width . "100%") + (class . "skribilo-margins"))) + (html-open 'tr) (html-margin body #f #f #f #f "skribilo-body") (html-margin rm rmfn rms rmbg rmfg "skribilo-right-margin") - (display "
")) + (html-close 'tr) + (html-close 'table)) (else - (display "
\n") + (html-open 'div + '((class . "skribilo-body"))) (output body e) - (display "
\n")))))) + (html-close 'div)))))) ;*---------------------------------------------------------------------*/ ;* &html-generic-header ... */ @@ -788,15 +841,20 @@ :action (lambda (n e) (let ((i (markup-body n))) (when i - (format #t " \n" i))))) + (html-open 'link + `((rel . "shortcut icon") + (href . ,i))))))) (markup-writer '&html-header-css :action (lambda (n e) (let ((css (markup-body n))) - (when (pair? css) - (for-each (lambda (css) - (format #t " \n" css)) - css))))) + (when (pair? css) + (for-each (lambda (css) + (html-open 'link + `((rel . "stylesheet") + (type . "text/css") + (href . ,css)))) + css))))) (markup-writer '&html-header-style :before "