mirror of
https://github.com/smarty-php/smarty.git
synced 2025-10-08 10:20:16 +02:00
393 lines
11 KiB
Plaintext
Executable File
393 lines
11 KiB
Plaintext
Executable File
;; $Id$
|
|
;;
|
|
;; This file is part of the Modular DocBook Stylesheet distribution.
|
|
;; See ../README or http://www.berkshire.net/~norm/dsssl/
|
|
;;
|
|
|
|
;; ======================================================================
|
|
;; HTML Linking...
|
|
;;
|
|
|
|
(define (element-id #!optional (nd (current-node)))
|
|
;; IDs of TITLEs are the IDs of the PARENTs
|
|
(let ((elem (if (equal? (gi nd)
|
|
(normalize "title"))
|
|
(parent nd)
|
|
nd)))
|
|
(if (attribute-string (normalize "id") elem)
|
|
(attribute-string (normalize "id") elem)
|
|
(generate-anchor elem))))
|
|
|
|
(define (link-target idstring)
|
|
;; Return the HTML HREF for the given idstring. For RefEntrys, this is
|
|
;; just the name of the file, for anything else it's the name of the file
|
|
;; with the fragment identifier for the specified id.
|
|
(href-to (element-with-id idstring)))
|
|
|
|
(define (generate-anchor #!optional (nd (current-node)))
|
|
(string-append "AEN" (number->string (all-element-number nd))))
|
|
|
|
(define (generate-xptr #!optional (nd (current-node)))
|
|
;; returns the location of the current node in a modified xptr
|
|
;; syntax. This used to be used to calculate unique anchor names
|
|
;; in the HTML document. all-element-number seems like a better
|
|
;; way to go...so this function is probably never called anymore.
|
|
(let loop ((suffix "")
|
|
(nd nd))
|
|
(let ((eid (id nd)))
|
|
(if eid
|
|
(string-append "I("
|
|
eid
|
|
")"
|
|
(if (= (string-length suffix) 0)
|
|
""
|
|
(string-append "C"
|
|
suffix)))
|
|
(let ((par (parent nd)))
|
|
(if (not (node-list-empty? par))
|
|
(loop (string-append "("
|
|
(number->string (child-number nd))
|
|
","
|
|
(gi nd)
|
|
")"
|
|
suffix)
|
|
par)
|
|
(string-append (if (= (string-length suffix) 0)
|
|
"R"
|
|
"R,C")
|
|
suffix)))))))
|
|
|
|
;; ======================================================================
|
|
;; HTML output
|
|
;;
|
|
|
|
(define (html-document title-sosofo body-sosofo)
|
|
(let* (;; Let's look these up once, so that we can avoid calculating
|
|
;; them over and over again.
|
|
(prev (prev-chunk-element))
|
|
(next (next-chunk-element))
|
|
(prevm (prev-major-component-chunk-element))
|
|
(nextm (next-major-component-chunk-element))
|
|
(navlist (list prev next prevm nextm))
|
|
|
|
;; Let's make it possible to control the output even in the
|
|
;; nochunks case. Note: in the nochunks case, (chunk?) will
|
|
;; return #t for only the root element.
|
|
(make-entity? (and (or (not nochunks) rootchunk)
|
|
(chunk?)))
|
|
|
|
(make-head? (or make-entity?
|
|
(and nochunks
|
|
(node-list=? (current-node)
|
|
(sgml-root-element)))))
|
|
(doc-sosofo
|
|
(if make-head?
|
|
(make element gi: "HTML"
|
|
(make element gi: "HEAD"
|
|
(make element gi: "TITLE" title-sosofo)
|
|
($standard-html-header$ prev next prevm nextm))
|
|
(make element gi: "BODY"
|
|
attributes: (append
|
|
(list (list "CLASS" (gi)))
|
|
%body-attr%)
|
|
(header-navigation (current-node) navlist)
|
|
body-sosofo
|
|
(footer-navigation (current-node) navlist)))
|
|
body-sosofo)))
|
|
(if make-entity?
|
|
(make entity
|
|
system-id: (html-entity-file (html-file))
|
|
(if %html-pubid%
|
|
(make document-type
|
|
name: "HTML"
|
|
public-id: %html-pubid%)
|
|
(empty-sosofo))
|
|
doc-sosofo)
|
|
(if (node-list=? (current-node) (sgml-root-element))
|
|
(make sequence
|
|
(if %html-pubid%
|
|
(make document-type
|
|
name: "HTML"
|
|
public-id: %html-pubid%)
|
|
(empty-sosofo))
|
|
doc-sosofo)
|
|
doc-sosofo))))
|
|
|
|
(define ($standard-html-header$ #!optional
|
|
(prev (prev-chunk-element))
|
|
(next (next-chunk-element))
|
|
(prevm (prev-major-component-chunk-element))
|
|
(nextm (next-major-component-chunk-element)))
|
|
;; A hook function to add additional tags to the HEAD of your HTML files
|
|
(let* ((info (info-element))
|
|
(kws (select-elements (descendants info) (normalize "keyword")))
|
|
(home (nav-home (current-node)))
|
|
(up (parent (current-node))))
|
|
(make sequence
|
|
;; Add the META NAME=GENERATOR tag
|
|
(make empty-element gi: "META"
|
|
attributes: (list (list "NAME" "GENERATOR")
|
|
(list "CONTENT" (stylesheet-version))))
|
|
|
|
;; Add the LINK REV=MADE tag
|
|
(if %link-mailto-url%
|
|
(make empty-element gi: "LINK"
|
|
attributes: (list (list "REV" "MADE")
|
|
(list "HREF" %link-mailto-url%)))
|
|
(empty-sosofo))
|
|
|
|
;; Add the LINK REL=HOME tag
|
|
(if (nav-home? (current-node))
|
|
(make empty-element gi: "LINK"
|
|
attributes: (append '(("REL" "HOME"))
|
|
(if (equal? (element-title-string home)
|
|
"")
|
|
'()
|
|
(list
|
|
(list "TITLE"
|
|
(element-title-string home))))
|
|
(list (list "HREF" (href-to home)))))
|
|
(empty-sosofo))
|
|
|
|
;; Add the LINK REL=UP tag
|
|
(if (nav-up? (current-node))
|
|
(if (or (node-list-empty? up)
|
|
(node-list=? up (sgml-root-element)))
|
|
(empty-sosofo)
|
|
(make empty-element gi: "LINK"
|
|
attributes: (append '(("REL" "UP"))
|
|
(if (equal? (element-title-string up)
|
|
"")
|
|
'()
|
|
(list
|
|
(list "TITLE"
|
|
(element-title-string up))))
|
|
(list (list "HREF" (href-to up))))))
|
|
(empty-sosofo))
|
|
|
|
;; Add the LINK REL=PREVIOUS tag
|
|
(if (node-list-empty? prev)
|
|
(empty-sosofo)
|
|
(make empty-element gi: "LINK"
|
|
attributes: (append '(("REL" "PREVIOUS"))
|
|
(if (equal? (element-title-string prev) "")
|
|
'()
|
|
(list
|
|
(list "TITLE"
|
|
(element-title-string prev))))
|
|
(list (list "HREF" (href-to prev))))))
|
|
|
|
;; Add the LINK REL=NEXT tag
|
|
(if (node-list-empty? next)
|
|
(empty-sosofo)
|
|
(make empty-element gi: "LINK"
|
|
attributes: (append '(("REL" "NEXT"))
|
|
(if (equal? (element-title-string next) "")
|
|
'()
|
|
(list
|
|
(list "TITLE"
|
|
(element-title-string next))))
|
|
(list (list "HREF" (href-to next))))))
|
|
|
|
;; Add META NAME=KEYWORD tags
|
|
(let loop ((nl kws))
|
|
(if (node-list-empty? nl)
|
|
(empty-sosofo)
|
|
(make sequence
|
|
(make empty-element gi: "META"
|
|
attributes: (list (list "NAME" "KEYWORD")
|
|
(list "CONTENT" (data (node-list-first nl)))))
|
|
(loop (node-list-rest nl)))))
|
|
|
|
;; Add LINK REL=STYLESHEET tag
|
|
(if %stylesheet%
|
|
(make empty-element gi: "LINK"
|
|
attributes: (list (list "REL" "STYLESHEET")
|
|
(list "TYPE" %stylesheet-type%)
|
|
(list "HREF" %stylesheet%)))
|
|
(empty-sosofo))
|
|
|
|
($user-html-header$ home up prev next))))
|
|
|
|
(define ($user-html-header$ #!optional
|
|
(home (empty-node-list))
|
|
(up (empty-node-list))
|
|
(prev (empty-node-list))
|
|
(next (empty-node-list)))
|
|
;; Add additional header tags.
|
|
(let loop ((tl %html-header-tags%))
|
|
(if (null? tl)
|
|
(empty-sosofo)
|
|
(make sequence
|
|
(make empty-element gi: (car (car tl))
|
|
attributes: (cdr (car tl)))
|
|
(loop (cdr tl))))))
|
|
|
|
(define ($html-body-start$)
|
|
(empty-sosofo))
|
|
|
|
(define ($html-body-content-start$)
|
|
(empty-sosofo))
|
|
|
|
(define ($html-body-content-end$)
|
|
(empty-sosofo))
|
|
|
|
(define ($html-body-end$)
|
|
(empty-sosofo))
|
|
|
|
(define (dingbat usrname)
|
|
;; Print dingbats and other characters selected by name
|
|
(let ((name (case-fold-down usrname)))
|
|
(case name
|
|
;; For backward compatibility
|
|
(("copyright") "(C)")
|
|
(("trademark") "TM")
|
|
|
|
;; Straight out of Unicode
|
|
(("ldquo") "\"")
|
|
(("rdquo") "\"")
|
|
(("lsquo") "'")
|
|
(("rsquo") "'")
|
|
(("ldquor") "\"")
|
|
(("rdquor") "\"")
|
|
(("raquo") ">>")
|
|
(("laquo") "<<")
|
|
(("rsaquo") ">")
|
|
(("lsaquo") "<")
|
|
(("nbsp") " ")
|
|
(("en-dash") "-")
|
|
(("em-dash") "--")
|
|
(("en-space") " ")
|
|
(("em-space") " ")
|
|
(("bullet") "*")
|
|
(("copyright-sign") "(C)")
|
|
(("registered-sign") "(R)")
|
|
(else
|
|
(let ((err (debug (string-append "No dingbat defined for: " name))))
|
|
"*")))))
|
|
|
|
(define (dingbat-sosofo usrname)
|
|
;; Print dingbats and other characters selected by name
|
|
(let ((name (case-fold-down usrname)))
|
|
(case name
|
|
;; For backward compatibility
|
|
(("copyright") (make entity-ref name: "copy"))
|
|
(("trademark") (make entity-ref name: "trade"))
|
|
|
|
;; Straight out of Unicode
|
|
(("ldquo") (literal "\""))
|
|
(("rdquo") (literal "\""))
|
|
(("lsquo") "'")
|
|
(("rsquo") "'")
|
|
(("raquo") (literal "\""))
|
|
(("laquo") (literal "\""))
|
|
(("rsaquo") (literal "\""))
|
|
(("lsaquo") (literal "\""))
|
|
(("nbsp") (make entity-ref name: "nbsp"))
|
|
(("en-dash") (literal "-"))
|
|
(("em-dash") (literal "--"))
|
|
(("en-space") (make entity-ref name: "nbsp"))
|
|
(("em-space") (make sequence
|
|
(make entity-ref name: "nbsp")
|
|
(make entity-ref name: "nbsp")))
|
|
(("bullet") (literal "*"))
|
|
(("copyright-sign") (make entity-ref name: "copy"))
|
|
(("registered-sign") (literal "(R)"))
|
|
(else
|
|
(let ((err (debug (string-append "No dingbat defined for: " name))))
|
|
(literal "*"))))))
|
|
|
|
(define (para-check #!optional (place 'stop))
|
|
(let ((inpara (equal? (gi (parent (current-node))) (normalize "para"))))
|
|
(if (and %fix-para-wrappers% inpara)
|
|
(if (equal? place 'stop)
|
|
(make formatting-instruction data: "</P>")
|
|
(make formatting-instruction data: "<P>"))
|
|
(empty-sosofo))))
|
|
|
|
;; ======================================================================
|
|
;; HTML element functions
|
|
|
|
(define ($block-container$)
|
|
(make element gi: "DIV"
|
|
attributes: (list
|
|
(list "CLASS" (gi)))
|
|
(make element gi: "A"
|
|
attributes: (list (list "NAME" (element-id)))
|
|
(empty-sosofo))
|
|
(process-children)))
|
|
|
|
(define ($paragraph$ #!optional (para-wrapper "P"))
|
|
(let ((footnotes (select-elements (descendants (current-node))
|
|
(normalize "footnote")))
|
|
(tgroup (have-ancestor? (normalize "tgroup"))))
|
|
(make sequence
|
|
(make element gi: para-wrapper
|
|
attributes: (append
|
|
(if %default-quadding%
|
|
(list (list "ALIGN" %default-quadding%))
|
|
'()))
|
|
(process-children))
|
|
(if (or %footnotes-at-end% tgroup (node-list-empty? footnotes))
|
|
(empty-sosofo)
|
|
(make element gi: "BLOCKQUOTE"
|
|
attributes: (list
|
|
(list "CLASS" "FOOTNOTES"))
|
|
(with-mode footnote-mode
|
|
(process-node-list footnotes)))))))
|
|
|
|
(define ($indent-para-container$)
|
|
(make element gi: "BLOCKQUOTE"
|
|
attributes: (list
|
|
(list "CLASS" (gi)))
|
|
(process-children)))
|
|
|
|
(define ($bold-seq$ #!optional (sosofo (process-children)))
|
|
(make element gi: "B"
|
|
attributes: (list
|
|
(list "CLASS" (gi)))
|
|
sosofo))
|
|
|
|
(define ($italic-seq$ #!optional (sosofo (process-children)))
|
|
(make element gi: "I"
|
|
attributes: (list
|
|
(list "CLASS" (gi)))
|
|
sosofo))
|
|
|
|
(define ($bold-italic-seq$ #!optional (sosofo (process-children)))
|
|
(make element gi: "B"
|
|
attributes: (list
|
|
(list "CLASS" (gi)))
|
|
(make element gi: "I"
|
|
sosofo)))
|
|
|
|
(define ($mono-seq$ #!optional (sosofo (process-children)))
|
|
(make element gi: "TT"
|
|
attributes: (list
|
|
(list "CLASS" (gi)))
|
|
sosofo))
|
|
|
|
(define ($italic-mono-seq$ #!optional (sosofo (process-children)))
|
|
(make element gi: "TT"
|
|
attributes: (list
|
|
(list "CLASS" (gi)))
|
|
(make element gi: "I"
|
|
sosofo)))
|
|
|
|
(define ($bold-mono-seq$ #!optional (sosofo (process-children)))
|
|
(make element gi: "TT"
|
|
attributes: (list
|
|
(list "CLASS" (gi)))
|
|
(make element gi: "B"
|
|
sosofo)))
|
|
|
|
(define ($charseq$ #!optional (sosofo (process-children)))
|
|
(make element gi: "SPAN"
|
|
attributes: (list
|
|
(list "CLASS" (gi)))
|
|
sosofo))
|
|
|
|
;; EOF dbhtml.dsl
|
|
|
|
|