mirror of
https://github.com/smarty-php/smarty.git
synced 2025-11-03 22:01:36 +01:00
422 lines
14 KiB
Plaintext
Executable File
422 lines
14 KiB
Plaintext
Executable File
;; $Id$
|
|
;;
|
|
;; This file is part of the Modular DocBook Stylesheet distribution.
|
|
;; See ../README or http://www.berkshire.net/~norm/dsssl/
|
|
;;
|
|
|
|
;; ========================= LINKS AND ANCHORS ==========================
|
|
|
|
(element link
|
|
(let* ((endterm (attribute-string (normalize "endterm")))
|
|
(linkend (attribute-string (normalize "linkend")))
|
|
(target (element-with-id linkend))
|
|
(etarget (if endterm
|
|
(element-with-id endterm)
|
|
(empty-node-list))))
|
|
;; It isn't necessary to catch either of these errors. The normal
|
|
;; ID/IDREF processing in Jade will catch them, and if -wno-idref
|
|
;; is used, then it's your gun, your bullet, and your foot.
|
|
;; (if (node-list-empty? target)
|
|
;; (error (string-append "Link to missing ID '" linkend "'"))
|
|
;; (empty-sosofo))
|
|
;; (if (and endterm (node-list-empty? etarget))
|
|
;; (error (string-append "EndTerm to missing ID '" endterm "' on Link"))
|
|
;; (empty-sosofo))
|
|
(if (node-list-empty? target)
|
|
(process-children)
|
|
(make element gi: "A"
|
|
attributes: (list (list "HREF" (href-to target)))
|
|
(if (and endterm (not (node-list-empty? etarget)))
|
|
(with-mode xref-endterm-mode (process-node-list etarget))
|
|
(process-children))))))
|
|
|
|
(element ulink
|
|
(make element gi: "A"
|
|
attributes: (list
|
|
(list "HREF" (attribute-string (normalize "url")))
|
|
(list "TARGET" "_top"))
|
|
(if (node-list-empty? (children (current-node)))
|
|
(literal (attribute-string (normalize "url")))
|
|
(process-children))))
|
|
|
|
(element anchor
|
|
(make element gi: "A"
|
|
attributes: (list
|
|
(list "NAME" (attribute-string (normalize "id"))))
|
|
(empty-sosofo)))
|
|
|
|
(element beginpage (empty-sosofo))
|
|
|
|
;; ======================================================================
|
|
|
|
(define (olink-link)
|
|
;; This is an olink without a TARGETDOCENT, treat it as a link within
|
|
;; the same document.
|
|
(let* ((localinfo (normalize (attribute-string (normalize "localinfo"))))
|
|
(target (element-with-id localinfo))
|
|
(linkmode (attribute-string (normalize "linkmode")))
|
|
(modespec (if linkmode (element-with-id linkmode) (empty-node-list)))
|
|
(xreflabel (if (node-list-empty? modespec)
|
|
#f
|
|
(attribute-string (normalize "xreflabel") modespec)))
|
|
(href (if (node-list-empty? target)
|
|
(error
|
|
(string-append "OLink to missing ID '" localinfo "'"))
|
|
(href-to target)))
|
|
(linktext (strip (data-of (current-node)))))
|
|
(make element gi: "A"
|
|
attributes: (list (list "HREF" href)
|
|
(list "CLASS" "OLINK"))
|
|
(if (equal? linktext "")
|
|
(if xreflabel
|
|
(xref-general target xreflabel)
|
|
(xref-general target))
|
|
(process-children)))))
|
|
|
|
(define (olink-href target modespec)
|
|
(let* ((pubid (entity-public-id target))
|
|
(sysid (system-id-filename target))
|
|
(localinfo (normalize (attribute-string (normalize "localinfo"))))
|
|
(qident (if pubid
|
|
(string-append %olink-pubid% (url-encode-string pubid))
|
|
(string-append %olink-sysid% (url-encode-string sysid))))
|
|
(qfragid (if localinfo
|
|
(string-append %olink-fragid%
|
|
(url-encode-string localinfo))
|
|
""))
|
|
(lb-href (string-append %olink-resolution% qident qfragid))
|
|
(modetext (if (node-list-empty? modespec) "" (data-of modespec)))
|
|
(href (if (equal? (strip modetext) "")
|
|
lb-href
|
|
(if localinfo
|
|
(string-append
|
|
modetext "#" (url-encode-string localinfo))
|
|
modetext))))
|
|
href))
|
|
|
|
(define (olink-simple)
|
|
;; Assumptions:
|
|
;; - The TARGETDOCENT is identified by a public ID
|
|
;; - LOLCALINFO contains the ID value (i.e. HREF fragment identifier) of
|
|
;; the target resource
|
|
;; - If the element has no content, the title extracted by
|
|
;; (olink-resource-title) should be used
|
|
;; - The (olink-resource-title) function can deduce the title from
|
|
;; the pubid and the sysid
|
|
;; - %olink-resolution% is the prefix to use on URLs (to point to a
|
|
;; cgi-bin script, or whatever you can make work for you)
|
|
;; - %olink-pubid% identifies the pubid in the query
|
|
;; - %olink-fragid% identifies the fragment identifier in the query
|
|
(let* ((target (attribute-string (normalize "targetdocent")))
|
|
(pubid (entity-public-id target))
|
|
(sysid (system-id-filename target))
|
|
(title (olink-resource-title pubid sysid))
|
|
(href (olink-href target (empty-node-list)))
|
|
(linktext (strip (data-of (current-node)))))
|
|
(make element gi: "A"
|
|
attributes: (list (list "HREF" href)
|
|
(list "CLASS" "OLINK"))
|
|
(if (equal? linktext "")
|
|
(make element gi: "I" (literal title))
|
|
(process-children)))))
|
|
|
|
(define (olink-outline-xref olroot target linktext)
|
|
(let* ((name (attribute-string (normalize "name") target))
|
|
(label (attribute-string (normalize "label") target))
|
|
(title (select-elements (children target) (normalize "ttl")))
|
|
(substitute (list
|
|
(list "%g" (if name (literal name) (literal "")))
|
|
(list "%n" (if label (literal label) (literal "")))
|
|
(list "%t" (with-mode olink-title-mode
|
|
(process-node-list title)))))
|
|
(tlist (match-split-list linktext (assoc-objs substitute))))
|
|
(string-list-sosofo tlist substitute)))
|
|
|
|
(define (olink-outline)
|
|
(let* ((target (attribute-string (normalize "targetdocent")))
|
|
(localinfo (normalize (attribute-string (normalize "localinfo"))))
|
|
(sysid (entity-generated-system-id target))
|
|
(basename (trim-string sysid '(".sgm" ".xml" ".sgml")))
|
|
(olinkfile (string-append basename %olink-outline-ext%))
|
|
(olinkdoc (sgml-parse olinkfile))
|
|
(olinkroot (node-property 'document-element olinkdoc))
|
|
(olnode (if localinfo
|
|
(element-with-id localinfo olinkroot)
|
|
olinkroot))
|
|
(linkmode (attribute-string (normalize "linkmode")))
|
|
(modespec (if linkmode (element-with-id linkmode) (empty-node-list)))
|
|
(xreflabel (if (node-list-empty? modespec)
|
|
""
|
|
(attribute-string (normalize "xreflabel") modespec)))
|
|
(href (if (equal? (attribute-string (normalize "type")) "href")
|
|
(attribute-string (normalize "href") olnode)
|
|
(olink-href target modespec)))
|
|
(linktext (strip (data-of (current-node)))))
|
|
(make element gi: "A"
|
|
attributes: (list (list "HREF" href)
|
|
(list "CLASS" "OLINK"))
|
|
(if (equal? linktext "")
|
|
(olink-outline-xref olinkroot olnode xreflabel)
|
|
(process-children)))))
|
|
|
|
(element olink
|
|
(if (not (attribute-string (normalize "targetdocent")))
|
|
(olink-link)
|
|
(if (attribute-string (normalize "linkmode"))
|
|
(olink-outline)
|
|
(olink-simple))))
|
|
|
|
(mode olink-title-mode
|
|
(default (process-children))
|
|
|
|
(element ttl
|
|
(make element gi: "I"
|
|
(process-children)))
|
|
|
|
(element it
|
|
(make element gi: "I"
|
|
(process-children)))
|
|
|
|
(element tt
|
|
(make element gi: "TT"
|
|
(process-children)))
|
|
|
|
(element sub
|
|
(make element gi: "SUB"
|
|
(process-children)))
|
|
|
|
(element sup
|
|
(make element gi: "SUP"
|
|
(process-children)))
|
|
)
|
|
|
|
;; ======================================================================
|
|
|
|
(element xref
|
|
(let* ((endterm (attribute-string (normalize "endterm")))
|
|
(linkend (attribute-string (normalize "linkend")))
|
|
(target (element-with-id linkend))
|
|
(xreflabel (if (node-list-empty? target)
|
|
#f
|
|
(attribute-string (normalize "xreflabel") target))))
|
|
(if (node-list-empty? target)
|
|
(error (string-append "XRef LinkEnd to missing ID '" linkend "'"))
|
|
(make element gi: "A"
|
|
attributes: (list
|
|
(list "HREF" (href-to target)))
|
|
(if xreflabel
|
|
(literal xreflabel)
|
|
(if endterm
|
|
(if (node-list-empty? (element-with-id endterm))
|
|
(error (string-append
|
|
"XRef EndTerm to missing ID '"
|
|
endterm "'"))
|
|
(with-mode xref-endterm-mode
|
|
(process-node-list (element-with-id endterm))))
|
|
(cond
|
|
((or (equal? (gi target) (normalize "biblioentry"))
|
|
(equal? (gi target) (normalize "bibliomixed")))
|
|
;; xref to the bibliography is a special case
|
|
(xref-biblioentry target))
|
|
((equal? (gi target) (normalize "co"))
|
|
;; callouts are a special case
|
|
($callout-mark$ target #f))
|
|
((equal? (gi target) (normalize "listitem"))
|
|
;; listitems are a special case
|
|
(if (equal? (gi (parent target)) (normalize "orderedlist"))
|
|
(literal (orderedlist-listitem-label-recursive target))
|
|
(error (string-append "XRef to LISTITEM only supported in ORDEREDLISTs"))))
|
|
((equal? (gi target) (normalize "question"))
|
|
;; questions and answers are (yet another) special case
|
|
(make sequence
|
|
(literal (gentext-element-name target))
|
|
(literal (gentext-label-title-sep target))
|
|
(literal (question-answer-label target))))
|
|
((equal? (gi target) (normalize "answer"))
|
|
;; questions and answers are (yet another) special case
|
|
(make sequence
|
|
(literal (gentext-element-name target))
|
|
(literal (gentext-label-title-sep target))
|
|
(literal (question-answer-label target))))
|
|
((equal? (gi target) (normalize "refentry"))
|
|
;; so are refentrys
|
|
(xref-refentry target))
|
|
((equal? (gi target) (normalize "refnamediv"))
|
|
;; and refnamedivs
|
|
(xref-refnamediv target))
|
|
((equal? (gi target) (normalize "glossentry"))
|
|
;; as are glossentrys
|
|
(xref-glossentry target))
|
|
((equal? (gi target) (normalize "author"))
|
|
;; and authors
|
|
(xref-author target))
|
|
((equal? (gi target) (normalize "authorgroup"))
|
|
;; and authorgroups
|
|
(xref-authorgroup target))
|
|
; this doesn't really work very well yet
|
|
; ((equal? (gi target) (normalize "substeps"))
|
|
; ;; and substeps
|
|
; (xref-substeps target))
|
|
(else
|
|
(xref-general target)))))))))
|
|
|
|
(define (xref-refentry target)
|
|
;; refmeta/refentrytitle, refmeta/manvolnum, refnamediv/refdescriptor,
|
|
;; refnamediv/refname
|
|
(let* ((refmeta (select-elements (children target)
|
|
(normalize "refmeta")))
|
|
(refnamediv (select-elements (children target)
|
|
(normalize "refnamediv")))
|
|
(rfetitle (select-elements (children refmeta)
|
|
(normalize "refentrytitle")))
|
|
(manvolnum (select-elements (children refmeta)
|
|
(normalize "manvolnum")))
|
|
(refdescrip (select-elements (children refnamediv)
|
|
(normalize "refdescriptor")))
|
|
(refname (select-elements (children refnamediv)
|
|
(normalize "refname")))
|
|
|
|
(title (if (node-list-empty? rfetitle)
|
|
(if (node-list-empty? refdescrip)
|
|
(node-list-first refname)
|
|
(node-list-first refdescrip))
|
|
(node-list-first rfetitle)))
|
|
|
|
(xsosofo (make sequence
|
|
(process-node-list (children title))
|
|
(if (and %refentry-xref-manvolnum%
|
|
(not (node-list-empty? manvolnum)))
|
|
(process-node-list manvolnum)
|
|
(empty-sosofo)))))
|
|
|
|
(make sequence
|
|
(if %refentry-xref-italic%
|
|
(make element gi: "I"
|
|
xsosofo)
|
|
xsosofo))))
|
|
|
|
(define (xref-refnamediv target)
|
|
(let* ((refname (select-elements (children target)
|
|
(normalize "refname")))
|
|
|
|
(title (node-list-first refname))
|
|
|
|
(xsosofo (make sequence
|
|
(process-node-list (children title)))))
|
|
(make sequence
|
|
(if %refentry-xref-italic%
|
|
(make element gi: "I"
|
|
xsosofo)
|
|
xsosofo))))
|
|
|
|
(define (xref-glossentry target)
|
|
(let ((glossterms (select-elements (children target)
|
|
(normalize "glossterm"))))
|
|
(with-mode xref-glossentry-mode
|
|
(process-node-list (node-list-first glossterms)))))
|
|
|
|
(define (xref-author target)
|
|
(literal (author-string target)))
|
|
|
|
(define (xref-authorgroup target)
|
|
;; it's a quirk of author-list-string that it needs to point to
|
|
;; one of the authors in the authorgroup, not the authorgroup.
|
|
;; go figure.
|
|
(let loop ((author (select-elements (children target) (normalize "author"))))
|
|
(if (node-list-empty? author)
|
|
(empty-sosofo)
|
|
(make sequence
|
|
(literal (author-list-string (node-list-first author)))
|
|
(loop (node-list-rest author))))))
|
|
|
|
;(define (xref-substeps target)
|
|
; (let* ((steps (select-elements (children target) (normalize "step")))
|
|
; (firststep (node-list-first steps))
|
|
; (laststep (node-list-last steps))
|
|
; (firstlabel (auto-xref-direct firststep))
|
|
; (lastlabel (auto-xref-direct laststep "%n")))
|
|
; (make sequence
|
|
; firstlabel
|
|
; (literal "-")
|
|
; lastlabel)))
|
|
|
|
(define (xref-general target #!optional (xref-string #f))
|
|
;; This function is used by both XREF and OLINK (when no TARGETDOCENT
|
|
;; is specified). The only case where xref-string is supplied is
|
|
;; on OLINK.
|
|
(let ((label (attribute-string (normalize "xreflabel") target)))
|
|
(if xref-string
|
|
(auto-xref target xref-string)
|
|
(if label
|
|
(xreflabel-sosofo label)
|
|
(auto-xref target)))))
|
|
|
|
(define (xref-biblioentry target)
|
|
(let* ((abbrev (node-list-first
|
|
(node-list-filter-out-pis (children target))))
|
|
(label (attribute-string (normalize "xreflabel") target)))
|
|
|
|
(if biblio-xref-title
|
|
(let* ((citetitles (select-elements (descendants target)
|
|
(normalize "citetitle")))
|
|
(titles (select-elements (descendants target)
|
|
(normalize "title")))
|
|
(title (if (node-list-empty? citetitles)
|
|
(node-list-first titles)
|
|
(node-list-first citetitles))))
|
|
(with-mode xref-title-mode
|
|
(process-node-list title)))
|
|
(if biblio-number
|
|
(make sequence
|
|
(literal "[" (number->string (bibentry-number target)) "]"))
|
|
(if label
|
|
(make sequence
|
|
(literal "[" label "]"))
|
|
(if (equal? (gi abbrev) (normalize "abbrev"))
|
|
(make sequence
|
|
(process-node-list abbrev))
|
|
(make sequence
|
|
(literal "[" (id target) "]"))))))))
|
|
|
|
(mode xref-endterm-mode
|
|
(default
|
|
(make element gi: "I"
|
|
(process-children-trim))))
|
|
|
|
(define (xreflabel-sosofo xreflabel)
|
|
(make element gi: "I"
|
|
(literal xreflabel)))
|
|
|
|
;; Returns the title of the element as a sosofo, italicized for xref.
|
|
;;
|
|
(define (element-title-xref-sosofo nd)
|
|
(make element gi: "I"
|
|
(element-title-sosofo nd)))
|
|
|
|
(mode xref-title-mode
|
|
(element title
|
|
(make element gi: "I"
|
|
(process-children-trim)))
|
|
|
|
(element citetitle
|
|
(make element gi: "I"
|
|
(process-children-trim)))
|
|
|
|
(element refname
|
|
(process-children-trim))
|
|
|
|
(element refentrytitle
|
|
(process-children-trim)))
|
|
|
|
(mode xref-glossentry-mode
|
|
(element glossterm
|
|
($italic-seq$)))
|
|
|
|
;; ======================================================================
|
|
|
|
(define (element-page-number-sosofo target)
|
|
(literal "???"))
|
|
|
|
;; ======================================================================
|
|
|