<!doctype style-sheet PUBLIC "-//James Clark//DTD DSSSL Style Sheet//EN" [
<!-- System Font Name -->
<!entity mincho PUBLIC "JIS TR X 0013-1998//TEXT Font Name - Mincho//EN"
-- 明朝系のシステムフォント名 -->
<!entity gothic PUBLIC "JIS TR X 0013-1998//TEXT Font Name - Gothic//EN"
-- ゴシック系のシステムフォント名 -->
<!-- System Dependant Paramaters for the LOGO & Mark -->
<!entity jis.logo PUBLIC "JIS TR X 0013-1998//TEXT Name - JIS Logo//EN">
<!entity jis.not PUBLIC "JIS TR X 0013-1998//TEXT Notation Name - JIS Logo//EN">
<!entity jis.xsz PUBLIC "JIS TR X 0013-1998//TEXT X Size - JIS Logo//EN">
<!entity jis.ysz PUBLIC "JIS TR X 0013-1998//TEXT Y Size - JIS Logo//EN">
<!entity jtr.logo PUBLIC "JIS TR X 0013-1998//TEXT Name - JTR Logo//EN">
<!entity jtr.not PUBLIC "JIS TR X 0013-1998//TEXT Notation Name - JTR Logo//EN">
<!entity jtr.xsz PUBLIC "JIS TR X 0013-1998//TEXT X Size - JTR Logo//EN">
<!entity jtr.ysz PUBLIC "JIS TR X 0013-1998//TEXT Y Size - JTR Logo//EN">
<!entity jcm.logo PUBLIC "JIS TR X 0013-1998//TEXT Name - JIS Mark Commidity//EN">
<!entity jcm.not PUBLIC "JIS TR X 0013-1998//TEXT Notation Name - JIS Mark Commidity//EN">
<!entity jcm.xsz PUBLIC "JIS TR X 0013-1998//TEXT X Size - JIS Mark Commidity//EN">
<!entity jcm.ysz PUBLIC "JIS TR X 0013-1998//TEXT Y Size - JIS Mark Commidity//EN">
<!entity jpr.logo PUBLIC "JIS TR X 0013-1998//TEXT Name - JIS Mark Process//EN">
<!entity jpr.not PUBLIC "JIS TR X 0013-1998//TEXT Notation Name - JIS Mark Process//EN">
<!entity jpr.xsz PUBLIC "JIS TR X 0013-1998//TEXT X Size - JIS Mark Process//EN">
<!entity jpr.ysz PUBLIC "JIS TR X 0013-1998//TEXT Y Size - JIS Mark Process//EN">
<!-- Specific to this DSSSL Specification -->
<!entity contact SYSTEM "contact.txt">
<!entity revision SYSTEM "revision.txt">
]>
<![ IGNORE [
;
; Debug Flag & Procedures (Only for Jade)
;
(define debug-flag 1)
(define debug
(if (= debug-flag 1)
(external-procedure "UNREGISTERED::James Clark//Procedure::debug")
(lambda (x) x) ))
(define (print-context #!optional (node (current-node)))
(if (= debug-flag 1)
(let loop ((current node) (name (debug "== current element context ==")))
(cond
((node-list-empty? current) node)
(else
(loop (parent current) (debug (gi current))) )))
node ))
]]>
;
; defining Non-Standard UNIT Name
;
(define-unit q 0.25mm)
;
; Standard procedures that are not implemented in Jade 1.1.1
;
(define (caar ll)
(car (car ll)) )
(define (cadr ll)
(car (cdr ll)) )
(define (cdar ll)
(cdr (car ll)) )
(define (cddr ll)
(cdr (cdr ll)) )
(define (assoc obj alist)
(cond
((null? alist) #f)
((not (pair? (car alist))) (error "alist shall be a list of pairs"))
((equal? obj (caar alist)) (car alist))
(else (assoc obj (cdr alist))) ))
(define (ancestors snl)
(node-list-reverse
(let body ((nd snl))
(cond
((node-list-empty? nd) (empty-node-list))
(else
(node-list (parent nd) (body (parent nd))) )))))
(define (first-descendant spec #!optional (nd (current-node)))
(let ((nds (select-elements (descendants nd) spec)))
(if nds
(case (node-list-count nds)
((0) (empty-node-list))
((1) nds)
(else (node-list-first nds)) )
(empty-node-list) )))
(define (node-list-count nlst)
(let loop ((nl nlst))
(cond
((node-list-empty? nl) 0)
(else (+ 1 (loop (node-list-rest nl)))) )))
(define (node-list-last nlst)
(let loop ((nl nlst) (prev (car nlst)))
(cond
((node-list-empty? nl) prev)
(else (loop (node-list-rest nl) (car nl))) )))
(define (string->list str)
(let loop ((len (string-length str))
(pos 0))
(cond
((= pos len) '())
(else
(cons (string-ref str pos)
(loop len (+ pos 1)) )))))
(define (list->string lst)
(let loop ((ll lst))
(cond
((null? ll) "")
(else
(string-append
(string (car ll))
(loop (cdr ll)) )))))
;
; Utilility Procedures
;
(define (ascii-char? c)
(case c
((#\space #\exclamation-mark #\quotation-mark #\number-sign
#\dollar-sign #\percent-sign #\ampersand #\apostrophe
#\left-parenthesis #\right-parenthesis #\asterisk #\plus-sign
#\comma #\hyphen-minus #\full-stop #\solidus
#\digit-zero #\digit-one #\digit-two #\digit-three #\digit-four
#\digit-five #\digit-six #\digit-seven #\digit-eight #\digit-nine
#\colon #\semicolon #\less-than-sign #\equals-sign
#\greater-than-sign #\question-mark #\commercial-at
#\latin-capital-letter-a #\latin-capital-letter-b
#\latin-capital-letter-c #\latin-capital-letter-d
#\latin-capital-letter-e #\latin-capital-letter-f
#\latin-capital-letter-g #\latin-capital-letter-h
#\latin-capital-letter-i #\latin-capital-letter-j
#\latin-capital-letter-k #\latin-capital-letter-l
#\latin-capital-letter-m #\latin-capital-letter-n
#\latin-capital-letter-o #\latin-capital-letter-p
#\latin-capital-letter-q #\latin-capital-letter-r
#\latin-capital-letter-s #\latin-capital-letter-t
#\latin-capital-letter-u #\latin-capital-letter-v
#\latin-capital-letter-w #\latin-capital-letter-x
#\latin-capital-letter-y #\latin-capital-letter-z
#\left-square-bracket #\reverse-solidus #\right-square-bracket
#\circumflex-accent #\low-line #\grave-accent
#\latin-small-letter-a #\latin-small-letter-b
#\latin-small-letter-c #\latin-small-letter-d
#\latin-small-letter-e #\latin-small-letter-f
#\latin-small-letter-g #\latin-small-letter-h
#\latin-small-letter-i #\latin-small-letter-j
#\latin-small-letter-k #\latin-small-letter-l
#\latin-small-letter-m #\latin-small-letter-n
#\latin-small-letter-o #\latin-small-letter-p
#\latin-small-letter-q #\latin-small-letter-r
#\latin-small-letter-s #\latin-small-letter-t
#\latin-small-letter-u #\latin-small-letter-v
#\latin-small-letter-w #\latin-small-letter-x
#\latin-small-letter-y #\latin-small-letter-z
#\left-curly-bracket #\vertical-line
#\right-curly-bracket #\tilde) #t)
(else #f) ))
(define (node-at-location lst #!optional (nd (current-node)))
(let loop ((root (ancestor (car lst) nd))
(ll (cdr lst)))
(cond
((not root) (empty-node-list))
((null? ll) root)
((not (node-list-empty? (select-elements (children root) (car ll))))
(loop (select-elements (children root) (car ll)) (cdr ll)))
(else (empty-node-list)) )))
(define (process-node-at-location lst #!optional (nd (current-node)))
(process-node-list (node-at-location lst nd)) )
(define (attribute-string+default name default #!optional (nd (current-node)))
(cond
((attribute-string name nd))
(else default) ))
(define (string->quantity s)
(let loop ((pos 0) (val 0) (unit ""))
(cond
((>= pos (string-length s))
(case unit
(("CM" "cm") (* val 1cm))
(("MM" "mm") (* val 1mm))
(("IN" "in") (* val 1in))
(("PT" "pt") (* val 1pt))
(("PICA" "pica") (* val 1pica))
(("Q" "q") (* val 0.25mm)) )) ; fool proof
((or (equal? (string-ref s pos) #\0)
(equal? (string-ref s pos) #\1)
(equal? (string-ref s pos) #\2)
(equal? (string-ref s pos) #\3)
(equal? (string-ref s pos) #\4)
(equal? (string-ref s pos) #\5)
(equal? (string-ref s pos) #\6)
(equal? (string-ref s pos) #\7)
(equal? (string-ref s pos) #\8)
(equal? (string-ref s pos) #\9))
(loop (+ pos 1) (+ (* val 10) (string->number (substring s pos (+ pos 1)))) unit))
(else
(loop (+ pos 1) val (string-append unit (substring s pos (+ pos 1))))) )))
(define (character-spacing str spaces)
(let loop ((cl (string->list str)))
(cond
((null? cl) "")
((= 1 (length cl)) (string (car cl)))
(else
(string-append (string (car cl)) spaces (loop (cdr cl)) )))))
(define (expand-to-fit str)
(let ((len (string-length str)))
(cond
((> len 10) str)
((> len 7) (character-spacing str "\space;\space;"))
((> len 5) (character-spacing str " "))
((> len 3) (character-spacing str "\space;\space; "))
((> len 1) (character-spacing str " ")) )))
(define (normalize-number-list lst)
(cond
((null? lst) '())
(else
(case (car lst)
((#\0 #\U-FF10) (cons #\0 (normalize-number-list (cdr lst))))
((#\1 #\U-FF11) (cons #\1 (normalize-number-list (cdr lst))))
((#\2 #\U-FF12) (cons #\2 (normalize-number-list (cdr lst))))
((#\3 #\U-FF13) (cons #\3 (normalize-number-list (cdr lst))))
((#\4 #\U-FF14) (cons #\4 (normalize-number-list (cdr lst))))
((#\5 #\U-FF15) (cons #\5 (normalize-number-list (cdr lst))))
((#\6 #\U-FF16) (cons #\6 (normalize-number-list (cdr lst))))
((#\7 #\U-FF17) (cons #\7 (normalize-number-list (cdr lst))))
((#\8 #\U-FF18) (cons #\8 (normalize-number-list (cdr lst))))
((#\9 #\U-FF19) (cons #\9 (normalize-number-list (cdr lst))))
(else (normalize-number-list (cdr lst))) ))))
(define (normalize-number str def)
(let* ((lst (string->list str))
(rlst (normalize-number-list lst)))
(if (null? rlst)
def
(list->string rlst) )))
;
; JIS-DTD Specific Procedures
;
; JIS Logo/JIS Mark Related procedures
(define logo-info-alist
`(("JIS"
(("UNSPECIFIED"
((name "&jis.logo;")
(notation "&jis.not;")
(x-size ,(string->quantity "&jis.xsz;"))
(y-size ,(string->quantity "&jis.ysz;")) ))
("COMMIDITY"
((name "&jcm.logo;")
(notation "&jcm.not;")
(x-size ,(string->quantity "&jcm.xsz;"))
(y-size ,(string->quantity "&jcm.ysz;")) ))
("PROCESS"
((name "&jpr.logo;")
(notation "&jpr.not;")
(x-size ,(string->quantity "&jpr.xsz;"))
(y-size ,(string->quantity "&jpr.ysz;")) ))))
("JTR"
(("UNSPECIFIED"
((name "&jtr.logo;")
(notation "&jtr.not;")
(x-size ,(string->quantity "&jtr.xsz;"))
(y-size ,(string->quantity "&jtr.ysz;")) ))))))
(define (logo-info status mark)
(cadr (assoc mark (cadr (assoc status logo-info-alist)))) )
(define (logo-info-field symbol info)
(cadr (assoc symbol info)) )
(define (doc-status)
(let ((stand (node-at-location '("standjis" "standard"))))
(if (node-list-empty? stand)
#f
(attribute-string+default "STATUS" "JIS" stand) )))
(define (publication-status)
(case (doc-status)
(("JIS" "jis") "JIS")
(("JTR" "jtr") "TR")
(else "JIS") ))
(define (mark-status)
(attribute-string
"JISmark"
(select-elements (children (ancestor "standjis")) "standard" ) ))
(define (make-logo)
(let ((info (logo-info (doc-status) (mark-status))))
(make paragraph
keep: 'page
line-spacing: (* (logo-info-field 'y-size info) 1.2)
(make external-graphic
scale: 'max-uniform
max-width: (logo-info-field 'x-size info)
max-height: (logo-info-field 'y-size info)
display-alignment: 'start
break-after-priority: 100
notation-system-id: (logo-info-field 'notation info)
entity-system-id: (logo-info-field 'name info) ))))
; UDC Related Procedures
(define (query-udc)
(node-at-location
'("standjis" "frontm" "titlep" "pubinfo" "udc") ))
(define (udc-data)
(let ((udc (query-udc)))
(if (node-list-empty? udc)
""
(data udc) )))
(define (udc-header-string)
(string-append "UDC\space;" (udc-data)) )
(define (new-style?)
(not (node-list-empty? (query-udc))) )
(define (format-type level)
(if (new-style?)
(case level
((1) "a")
((2) "1")
((3) "i")
((4) "A")
((5) "1")
((6) "I") )
(case level
((1) "1")
((2) "a")
((3) "i")
((4) "1")
((5) "A")
((6) "I") )))
;
; default specifications
;
(define default-paragraph-style
(style
;
; initial values for paragraph
;
; lines: wrap ; default
; asis-truncate-char: #f ; default
; asis-wrap-char: #f ; default
; asis-wrap-indent: #f ; default
; first-line-align: #f ; default
; alignment-point-offset: 50 ; default
ignore-record-end?: #t
expand-tabs?: 8
; line-spacing: default-line-spacing
; line-spacing-priority: 0 ; default
; min-pre-line-spacing: #f ; default
; min-post-line-spacing: #f ; default
; min-leading: #f ; default
first-line-start-indent: text-size
; last-line-end-indent: 0pt ; default
; hyphenation-char: #\- ; default
; hyphenation-ladder-count: 2 ; default
; hyphenation-remain-char-count: 2 ; default
; hyphenation-push-char-count: 2 ; default
; hyphenation-keep: page ; default
; hyphenation-exceptions: '() ; default
; line-breaking-method: #f ; default
; line-composition-method: #f ; default
; implicit-bidi-method: #f ; default
; glyph-alignment-mode: font ; default
font-family-name: text-font-family-name
; font-weight: medium ; default
; font-posture: upright ; default
; font-structure: solid ; default
; font-proportionate-width: medium ; default
; font-name: #f ; default
font-size: text-size
; numbered-lines: #f ; default
; line-number: #f ; default
line-number-side: 'start
line-number-sep: text-size
quadding: 'start
; last-line-quadding: relative ; default
; last-line-justify-limit: 0pt ; default
; justify-glyph-space-max-add: 0pt ; default
; justify-glyph-space-max-remove: 0pt ; default
hanging-punct?: #t
; widow-count: 2 ; default
; orphan-count: 2 ; default
language: 'JA
country: 'JP
; position-prefereence: #f ; default
; writing-mode: 'left-to-right ; default
; start-indent: 0pt ; default
; end-indent: 0pt ; default
; span: 1 ; default
; spapn-weak?: #f ; default
; keep-with-previous?: #f ; default
; keep-with-next?: #f ; default
; break-before: #f ; default
; break-after: #f ; default
; keep: #f ; default
; may-violate-keep-before?: #f ; default
; may-violate-keep-after: #f ; default
))
(define default-character-style
;
; initial values for character
;
(style
; char: ; special defaulting mechanism
; char-map: #f ; default
; glyph-id: #f ; default
; glyph-subst-table: #f ; default
; glyph-subst-method: #f ; default
; glyph-reorder-method: #f ; default
; writing-mode: 'left-to-right ; default
font-family-name: text-font-family-name ; default
; font-weight: medium ; default
; font-posture: upright ; default
; math-font-posture: upright ; default
; font-sturucture: solid ; default
; font-proportionate-width: medium ; default
; font-name: #f ; default
font-size: text-size
; stretch-factor: 1 ; default
; hyphenate?: #f ; default
; hyphenation-method: #f ; default
; kern?: #f ; default
; kern-mode: normal ; default
; ligature?: #f ; default
; allowed-ligatures: '() ; default
; space: ; special defaulting mechanism
; input-tab?: ; special defaulting mechanism
; input-whitespace-treatment: preserve ; default
; input-whitespace?: ; special defaulting mechanism
; punct?: ; special defaulting mechanism
; break-before-priority: ; special defaulting mechanism
; break-after-priority: ; special defaulting mechanism
; drop-after-line-break?: ; special defaulting mechanism
; drop-unless-before-line-break?: ; special defaulting mechanism
; math-class: ; special defaulting mechanism
; script: ; special defaulting mechanism
; position-point-shift: 0pt ; default
language: 'JA
country: 'JP
; color: ; special defaulting mechanism
; inhibit-line-breaks?: #f ; default
))
(define default-style
(merge-style default-paragraph-style default-character-style))
;
; default creation
;
(default (empty-sosofo))
;
; default paragraph creating procedure
;
(define (make-default-paragraph)
(make paragraph
space-before: text-size
line-spacing: (* text-size 2)
use: default-paragraph-style
(process-children) ))
;
; Style Paramaters
;
;
; font-names & font-sizes
;
(define jtitle-font gothic-font)
(define jtitle-size 24q)
(define jtitle-spacing (* 1.5 jtitle-size))
(define jptitle-font gothic-font)
(define jptitle-size 24q)
(define jptitle-spacing (* 1.5 jptitle-size))
(define body-title-font gothic-font)
(define body-title-size 20q)
(define body-title-spacing (* 1.5 body-title-size))
(define body-isnum-font gothic-font)
(define body-isnum-size 17q)
(define body-isnum-quadding 'end)
(define body-isnum-spacing (* 1.5 body-title-size))
(define text-font mincho-font)
(define text-size 13q)
(define text-spacing (* 2 text-size))
(define default-size 13q)
(define default-line-spacing (* text-size 2))
(define header-size 13q)
(define verso-title-p-note-size 10q)
(define smaller-size 9q)
(define mincho-font "&mincho;")
(define gothic-font "&gothic;")
(define title-font-family-name gothic-font)
(define text-font-family-name mincho-font)
(define section-space (display-space 10mm min: 10mm max: 20mm priority: 100))
;
; Spacing for lines
;
(define paragraph-line-spacing default-line-spacing)
;
; Spacing for Titles
;
; この手続きは、見出しの行数、見出しのサイズ、前後の空きの比を引数にとり、
; 前後の空きの量を計算する。
;
(define (title-spacing lines title-size ratio pri)
(display-space
(* (- (* lines paragraph-line-spacing) title-size) ratio)
priority: pri ))
(define h0t-space-before
(title-spacing 2.5 text-size (/ 3 4) 100) )
(define h0t-space-after
(title-spacing 2.5 text-size (/ 1 4) 100) )
(define h1t-space-before
(title-spacing 1.5 text-size (/ 2) 100) )
(define h1t-space-after
(title-spacing 1.5 text-size (/ 2) 100) )
(define h2t-space-before
(title-spacing 1.5 text-size (/ 2) 90) )
(define h2t-space-after
(title-spacing 1.5 text-size (/ 2) 90) )
(define h3t-space-before
(title-spacing 1.5 text-size (/ 2) 80) )
(define h3t-space-after
(title-spacing 1.5 text-size (/ 2) 80) )
(define h4t-space-before
(title-spacing 1.5 text-size (/ 2) 70) )
(define h4t-space-after
(title-spacing 1.5 text-size (/ 2) 70) )
(define h5t-space-before
(title-spacing 1.5 text-size (/ 2) 60) )
(define h5t-space-after
(title-spacing 1.5 text-size (/ 2) 60) )
(define h6t-space-before
(title-spacing 1.5 text-size (/ 2) 50) )
(define h6t-space-after
(title-spacing 1.5 text-size (/ 2) 50) )
(define a4p-page-style
(style
page-width: 210mm ; A4
page-height: 297mm ; A4
left-margin: 20mm
right-margin: 20mm
top-margin: 27mm
bottom-margin: 32mm
header-margin: 24mm
footer-margin: 32mm
writing-mode: 'left-to-right)
)
(define h1t-style
(style
font-family-name: gothic-font
font-name: gothic-font
font-size: text-size
line-spacing: default-line-spacing
first-line-start-indent: 0pt
use: default-paragraph-style ))
(define h2t-style
(style
font-family-name: gothic-font
font-name: gothic-font
font-size: text-size
line-spacing: default-line-spacing
first-line-start-indent: 0pt
use: default-paragraph-style ))
(define h3t-style
(style
font-family-name: gothic-font
font-name: gothic-font
font-size: text-size
line-spacing: default-line-spacing
first-line-start-indent: 0pt
use: default-paragraph-style ))
(define h4t-style
(style
font-family-name: gothic-font
font-name: gothic-font
line-spacing: default-line-spacing
first-line-start-indent: 0pt
use: default-paragraph-style ))
(define h5t-style
(style
font-family-name: gothic-font
font-name: gothic-font
line-spacing: default-line-spacing
first-line-start-indent: 0pt
use: default-paragraph-style ))
(define h6t-style
(style
font-family-name: gothic-font
font-name: gothic-font
line-spacing: default-line-spacing
first-line-start-indent: 0pt
use: default-paragraph-style ))
;
; SGML document root
;
(root
(make display-group
use: default-style
(process-children) ))
;
; <![ IGNORE [
; <!ENTITY % doctype "standjis" -- 文書型名 -->
;
; <!ELEMENT %doctype; O O (bibinfo*,%fm.d;,genwarn?,body,
; %annxs;,index*,backm?)
; -(%main.ex;) +(%ix;|%i.float;|revmark) >
; ]]>
(element standjis
(make display-group
(process-children)
(with-mode back-title
(process-node-list (select-elements (children (current-node)) "frontm")) )))
;
; <![ IGNORE [
; <!ELEMENT bibinfo - O (titles,edition,version?,language,refnums,
; sourceod?,notes?,endorsmt?,developc,replaces*,
; replaced*,abstract?,classifn*,keyword*,relstd*,
; prodinfo?,otherprm*,othertxt*) -(%i.float)
; -- bibliographic information -->
; ]]>
;
; ISO版の書誌情報なので無視する。
;
; (element (standjis bibinfo) (empty-sosofo))
;
; <![ IGNORE [
; <!ENTITY % fm.d "standard*, frontm*" -- 前書き類 -->
;
; <!ELEMENT standard - O EMPTY -- 書誌属性記述要素 -->
; <!ATTLIST standard
; status (JIS|DJIS|JTR|DJTR|AMS|DAMS|AMT|DAMT) #REQUIRED
; -- 規格種別及び作成段階
; JIS 日本工業規格 (Japanese Industrial Standard)
; DJIS JIS規格原案 (Draft JIS)
; JTR JIS標準情報 (JIS Technical Report)
; DJTR JIS標準情報原案 (Draft JIS Technical Report)
; AMS 規格追補 (Amendment (Standard))
; DAMS 規格追補原案 (Draft Amendment (Standard))
; AMT 技術報告追補 (Amendment (Technical Report))
; DAMT 技術報告追補原案 (Draft Amendment (Technical Report))
; --
; TRtype (1|2|3) #IMPLIED -- 標準情報のタイプ --
; notes CDATA #IMPLIED -- 追認、その他 --
; trnstype (JSPEC|TABST|TFULL) #REQUIRED
; -- 翻訳タイプ
; JSPEC JIS独自規格 (JIS specific)
; TABST 要訳規格 (abstract only translation)
; TFULL 全訳規格 (full text translation)
; --
; JISmark (commidity|process|unspecified) unspecified
; -- JISマーク種別
; commidity 指定商品に関する規格
; process 指定加工技術に関する規格
; unspecified その他の規格
; --
; >
; ]]>
;
;(element standard (empty-sosofo))
;
; <![ IGNORE [
; <!ELEMENT frontm -- 前書き --
; - O (titlep, toc?,
; jforeword?, foreword?, intro?)>
; ]]>
;
(element frontm
(make display-group
(process-matching-children 'titlep)
(process-matching-children 'toc)
(process-matching-children 'intro) ))
;
; <![ IGNORE [
; <!ELEMENT titlep -- 題目ページ --
; - O (refnum,
; jtitle, jptitle?, etitle, eptitle?,
; pubinfo)>
; ]]>
;
(element titlep
(make simple-page-sequence
right-header: (literal (udc-header-string))
use: a4p-page-style
(make-logo)
(process-matching-children 'jtitle)
(process-matching-children 'jptitle)
(process-matching-children 'refnum)
(process-matching-children 'pubinfo) ))
;
; <![ IGNORE [
; <!ELEMENT jtitle - O (tline+) -- 主題 (日本語) -->
; <!ELEMENT jptitle - O (tline+) -- 部題 (日本語) -->
; <!ELEMENT etitle - O (tline+) -- 主題 (英語) -->
; <!ELEMENT eptitle - O (tline+) -- 部題 (英語) -->
; ]]>
;
(define jtitle-style
(style
font-family-name: gothic-font
font-name: gothic-font
font-size: jtitle-size
line-spacing: jtitle-spacing
quadding: 'center
use: default-paragraph-style ))
(element jtitle
(make paragraph
space-before: (display-space 30mm max: 30mm min: 20mm priority: 100)
keep: 'page
keep-with-previous?: #t
use: jtitle-style
(process-children) ))
(define jptitle-style
(style
font-family-name: gothic-font
font-name: gothic-font
font-size: jptitle-size
line-spacing: jptitle-spacing
quadding: 'center
use: default-paragraph-style ))
(element jptitle
(make paragraph
keep: 'page
keep-with-previous?: #t
use: jptitle-style
(process-children)))
(define tline-style
(style
widow-count: 0
orphan-count: 0 ))
(element tline
(make paragraph
keep-with-previous?: #t
space-before: 0pt
space-after: 0pt
keep: 'page
keep-with-previous?: #t
(literal (expand-to-fit (data (current-node))) )))
; (element etitle (empty-sosofo))
; (element eptitle (empty-sosofo))
(define header-refnum-style
(style
font-size: header-size
quadding: 'end
use: default-paragraph-style ))
(mode header
(element refnum
(make paragraph
use: header-refnum-style
(process-children) ))
(element jisnum
(make sequence
(process-matching-children "divsym")
(literal "\space;")
(process-matching-children "divnum")
(literal "\colon;")
(process-matching-children "pubyear") ))
(element divsym (process-children))
(element divnum (process-children))
(element pubyear (process-children))
(element isnum
(make sequence
(literal "\space;\left-parenthesis")
(process-children-trim)
(literal "\right-parenthesis") ))
)
(define pubinfo-style
(style
font-name: gothic-font
font-size: 9pt
quadding: 'center
use: default-paragraph-style ))
(define (make-document-date)
(cond
((not (node-list-empty? (first-descendant "ablsdate")))
(process-matching-children 'ablsdate) )
((not (node-list-empty? (first-descendant "confdate")))
(process-matching-children 'confdate) )
(else (empty-sosofo)) ))
(define (jisnum-space-amount) default-line-spacing)
(define (isnum-space-amount)
(if (node-list-empty?
(node-at-location
'("standjis" "frontm" "titlep" "refnum" "isnum")))
0mm
isnum-spacing))
(define (jtitle-space-amount)
(* jtitle-spacing
(node-list-count
(children
(node-at-location
'("standjis" "frontm" "titlep" "jtitle") )))))
(define (jptitle-space-amount)
(* jptitle-spacing
(node-list-count
(children
(node-at-location
'("standjis" "frontm" "titlep" "jptitle") )))))
(define (document-title-spacing)
(- 80mm
(jisnum-space-amount)
(isnum-space-amount)
(jtitle-space-amount)
(jptitle-space-amount) ))
(define (make-document-date-2)
(cond
((not (node-list-empty? (first-descendant "revdate")))
(process-matching-children 'revdate) )
(else
(process-matching-children 'estdate) )))
(define title-fixed-style
(style
font-family-name: mincho-font
font-size: 17q
quadding: 'center ))
(define (make-document-date-paragaraph)
(make paragraph
keep: 'page
(make-document-date) ))
(define (make-discuss-body-paragraph)
(make paragraph
keep-with-previous?: #t
space-before: (display-space 10mm priority: 90)
use: title-fixed-style
(literal "日本工業標準調査会 審議")) )
(define (make-publication-body-paragraph)
(make paragraph
space-before: (display-space 10mm priority: 90)
keep-with-previous?: #t
(literal "\left-parenthesis;")
(literal "日本規格協会\space;発行\right-parenthesis;") ))
(define (make-title-page-lower-fixed)
(make display-group
space-before: (display-space 10mm priority: 90)
space-after: (display-space 10mm priority: 90)
keep-with-previous?: #t
use: title-fixed-style
(make-discuss-body-paragraph)
(make-publication-body-paragraph) ))
(define (make-title-page-lower-texts)
(make paragraph
keep: 'page
keep-with-previous?: #t
space-before:
(display-space (document-title-spacing) min: 20mm priority: 100)
(make-document-date-2)
(make-title-page-lower-fixed) ))
(define (make-verso-title-page)
(make simple-page-sequence
use: a4p-page-style
(with-mode verso-title-page
(process-node-list
(node-at-location '("standjis" "frontm" "titlep" "pubinfo")) ))))
(element pubinfo
(make display-group
use: pubinfo-style
(make-document-date-paragaraph)
(make-title-page-lower-texts)
(make-verso-title-page) ))
(element estdate
(make paragraph
keep-with-previous?: #t
(with-mode gengou1 (process-children))
(literal " 制定") ))
(element revdate
(make paragraph
keep-with-previous?: #t
(literal "\left-parenthesis;")
(with-mode gengou1 (process-children))
(literal " 改正")
(literal "\right-parenthesis;") ))
(element confdate
(make paragraph
keep-with-previous?: #t
(literal "\left-parenthesis;")
(with-mode gengou1 (process-children))
(literal " 確認")
(literal "\right-parenthesis;") ))
(element ablsdate
(make paragraph
keep-with-previous?: #t
(process-children)
(literal "\left-parenthesis;")
(literal " 廃止")
(literal "\right-parenthesis;") ))
;(element divch (empty-sosofo))
(element udc (process-children))
;
; <![ IGNORE [
; <!ELEMENT pubinfo -- 出版情報 --
; - O (minister,
; estdate, (revdate | confdate)*,
; ablsdate?, fanndate,
; drftbody, authcomm, divch, price,
; (udc|ics), kwset?)>
; <!ELEMENT minister - O (#PCDATA) -- 主務大臣 (minister in charge) -->
; <!ELEMENT estdate - O (date) -- 制定日付 (date of establishment) -->
; <!ELEMENT revdate - O (date) -- 改正日付 (date of revision) -->
; <!ELEMENT confdate - O (date) -- 確認日付 (date of confermation) -->
; <!ELEMENT ablsdate - O (date) -- 廃止日付 (date of abolishment) -->
; <!ELEMENT fanndate - O (date) -- 官報公示日付
; (date of formal announcement) -->
; <!ELEMENT drftbody - O (#PCDATA) -- 原案作成協力者 (drafting body) -->
; <!ELEMENT authcomm - O (#PCDATA) -- 審議部会 (authorization committee) --
; >
; <!ELEMENT divch - O (#PCDATA) -- 担当部署 (division in charge) -->
; <!ELEMENT price - O (#PCDATA) -- 価格(円) -->
; <!ELEMENT udc - O (#PCDATA) -- UDC番号 -->
; <!ELEMENT ics - O (#PCDATA) -- ICS番号 -->
; <!ELEMENT kwset - O (kw+) -- キーワード集合 -->
; <!ELEMENT kw O O (#PCDATA) -- キーワード -->
; ]]>
;
(define verso-title-p-note-style
(style
font-family-name: mincho-font
font-size: verso-title-p-note-size
line-spacing: (* 2 verso-title-p-note-size)
use: default-paragraph-style ))
(define (make-contact-paragraph)
(make paragraph
first-line-start-indent: verso-title-p-note-size
start-indent: verso-title-p-note-size
keep: 'page
keep-with-previous?: #t
use: verso-title-p-note-style
(literal "&contact;") ))
(define (make-revision-paragraph)
(make paragraph
first-line-start-indent: verso-title-p-note-size
start-indent: verso-title-p-note-size
keep: 'page
keep-with-previous?: #t
use: verso-title-p-note-style
(literal "&revision;") ))
(define (make-standard-notice)
(make display-group
use: verso-title-p-note-style
(make-contact-paragraph)
(make-revision-paragraph) ))
(mode gengou2
(default (empty-sosofo))
(element date
(literal
(date-to-gengou2
(string->number
(normalize-number (data (first-descendant "YEAR")) "1"))
(string->number
(normalize-number (data (first-descendant "MONTH")) "1"))
(string->number
(normalize-number (data (first-descendant "DAY")) "1")) )))
)
(define (make-pubinfo-rule)
(make display-group
(make paragraph
space-before: (display-space 170mm min: 100mm priority: 100)
space-after: (display-space 10mm min: 10mm priority: 100)
use: verso-title-p-note-style
(literal " "))
(make rule
orientation: 'horizontal
length: 90mm
line-thickness: 1pt
break-before-priority: 100
break-after-priority: 100
space-after: (display-space 10mm priority: 100)
display-alignment: 'center )))
(mode verso-title-page
(default (empty-sosofo))
(element pubinfo
(make sequence
(make-pubinfo-rule)
(process-matching-children 'minister)
(process-matching-children 'fanndate)
(process-matching-children 'drftbody)
(process-matching-children 'authcomm)
(make-standard-notice) ))
(element minister
(make paragraph
keep-with-previous?: #t
use: verso-title-p-note-style
(literal "主務大臣\colon;\space;")
(process-children)
(process-node-at-location
'("standjis" "frontm" "titlep" "pubinfo" "estdate") )
(process-node-at-location
'("standjis" "frontm" "titlep" "pubinfo" "revdate") )
(process-node-at-location
'("standjis" "frontm" "titlep" "pubinfo" "confdate") )
(process-node-at-location
'("standjis" "frontm" "titlep" "pubinfo" "ablsdate") ) ))
(element estdate
(make sequence
use: verso-title-p-note-style
(literal " 制定\colon;\space;")
(with-mode gengou2 (process-children) )))
(element revdate
(make sequence
use: verso-title-p-note-style
(literal " 改定\colon;\space;")
(with-mode gengou2 (process-children) )))
(element confdate
(make sequence
use: verso-title-p-note-style
(literal " 確認\colon;\space;")
(with-mode gengou2 (process-children) )))
(element ablsdate
(make sequence
use: verso-title-p-note-style
(literal " 廃止\colon;\space;")
(with-mode gengou2 (process-children) )))
(element fanndate
(make paragraph
keep-with-previous?: #t
use: verso-title-p-note-style
(literal "官報公示\colon;\space;")
(with-mode gengou2 (process-children) )))
(element drftbody
(make paragraph
keep-with-previous?: #t
use: verso-title-p-note-style
(literal "原案作成協力者\colon;\space;")
(process-children) ))
(element authcomm
(make paragraph
keep-with-previous?: #t
use: verso-title-p-note-style
(literal "審議部会\colon;\space;")
(process-children) ))
)
;
; <![ IGNORE [
; <!ELEMENT genwarn - - (p,(%s.zz;)*) -- General Warning -->
; ]]>
;
(element genwarn (empty-sosofo))
;
; <![ IGNORE [
; <!ELEMENT body - O ((gensec,section*)|(scopesec,section*)|
; (scope, conf?, refs?, defs?, (symabb|syms)?,
; h1*)) >
; ]]>
;
(define (title-lines #!optional (nd (current-node)))
(let loop ((ndl (children nd)))
(cond
((node-list-empty? ndl) (literal ""))
(else
(make sequence
(make paragraph
font-family-name: gothic-font
font-name: gothic-font
font-size: 14pt
quadding: 'center
line-spacing: (* text-size 2)
use: default-paragraph-style
(literal (expand-to-fit (data (node-list-first ndl)))) )
(loop (node-list-rest ndl)) )))))
(define body-title-style
(style
font-family-name: gothic-font
font-name: gothic-font
font-size: body-title-size
quadding: 'end
line-spacing: body-title-spacing
use: default-paragraph-style ))
(define (make-body-jis-paragraph)
(make paragraph
space-before: (display-space text-size priority: 10)
end-indent: (* text-size 10)
use: body-title-style
(literal " 日 本 工 業 規 格 ")
(literal (publication-status)) ))
(define (make-body-jisnum)
(make paragraph
start-indent: (* text-size 4)
end-indent: (* text-size 6)
(process-matching-children "jisnum") ))
(define body-isnum-style
(style
font-family-name: body-isnum-font
font-size: body-isnum-size
quadding: body-isnum-quadding
line-spacing: body-isnum-spacing
use: default-paragraph-style) )
(define (make-body-isnum)
(make paragraph
start-indent: (* text-size 4)
end-indent: (* text-size 4)
use: body-isnum-style
(process-matching-children "isnum") ))
(define (make-body-jisnum-paragraph)
(make paragraph
use: body-title-style
(make sequence
(process-matching-children "divsym")
(literal "\space;")
(process-matching-children "divnum") )
(make sequence
font-size: 13q
(literal "\colon;")
(process-matching-children "pubyear") )))
(define (make-body-isnum-paragraph)
(make paragraph
use: body-title-style
(literal "\left-parenthesis")
(process-children-trim)
(literal "\right-parenthesis") ))
(mode bodytitle
(element refnum
(make display-group
(make-body-jis-paragraph)
(make-body-jisnum)
(make-body-isnum) ))
(element jisnum (make-body-jisnum-paragraph))
(element divsym (process-children-trim))
(element divnum (process-children-trim))
(element pubyear (process-children-trim))
(element isnum (make-body-isnum-paragraph))
(element jtitle
(make paragraph
font-family-name: gothic-font
font-name: gothic-font
font-size: 24q
quadding: 'center
start-indent: (* text-size 4)
end-indent: (* text-size 4)
line-spacing: (* text-size 2)
space-before: (display-space (* text-size 2) priority: 10)
use: default-paragraph-style
(title-lines (current-node)) ))
(element etitle
(make paragraph
font-family-name: gothic-font
font-name: gothic-font
font-size: 24q
quadding: 'center
start-indent: (* text-size 4)
end-indent: (* text-size 4)
line-spacing: (* text-size 2)
space-before: (display-space (* text-size 2) priority: 10)
space-after:
(if (node-list-empty?
(node-at-location '("standjis" "frontm" "titlep" "eptitle")))
(display-space (* text-size 4) priority: 10)
0pt)
use: default-paragraph-style
(title-lines (current-node)) ))
(element jptitle
(make paragraph
font-family-name: gothic-font
font-name: gothic-font
font-size: 24q
quadding: 'center
start-indent: (* text-size 4)
end-indent: (* text-size 4)
line-spacing: (* text-size 2)
use: default-paragraph-style
(title-lines (current-node)) ))
(element eptitle
(make paragraph
font-family-name: gothic-font
font-name: gothic-font
font-size: 24q
quadding: 'center
start-indent: (* text-size 4)
end-indent: (* text-size 4)
line-spacing: (* text-size 2)
space-after: (display-space (* text-size 4) priority: 10)
use: default-paragraph-style
(title-lines (current-node)) ))
)
(element body
(make simple-page-sequence
right-header:
(with-mode
header
(process-node-list
(node-at-location
'("standjis" "frontm" "titlep" "refnum") )))
center-footer:
(make sequence
font-name: gothic-font
font-size: header-size
quadding: 'center
(literal "\hyphen-minus;\space;")
(page-number-sosofo)
; (literal
; (number->string
; (- (page-number)
; (- (page-number
; first-area-of-node:
; (node-at-location '("standjis" "body")))
; 1) )))
(literal "\space;\hyphen-minus;") )
use: a4p-page-style
(with-mode bodytitle
(process-node-list
(node-list
(node-at-location '("standjis" "frontm" "titlep" "refnum"))
(node-at-location '("standjis" "frontm" "titlep" "jtitle"))
(node-at-location '("standjis" "frontm" "titlep" "jptitle"))
(node-at-location '("standjis" "frontm" "titlep" "etitle"))
(node-at-location '("standjis" "frontm" "titlep" "eptitle")) )))
(process-node-list
(node-at-location '("standjis" "frontm" "jforeword")) )
(process-children) ))
(element jforeword
(make paragraph
first-line-start-indent: 0pt
line-spacing: (* text-size 2)
space-before: h1t-space-before
space-after: h1t-space-after
keep-with-next?: #t
use: default-paragraph-style
(make sequence
line-spacing: (* text-size 2)
font-family-name: gothic-font
font-name: gothic-font
font-size: text-size
line-spacing: (* text-size 1.2)
use: default-paragraph-style
(literal "序文 ") )
(process-children) ))
(element (jforeword p)
(if (absolute-first-sibling?)
(process-children)
(make-default-paragraph) ))
(element intro
(make display-group
(make paragraph
line-spacing: (* text-size 2)
font-family-name: gothic-font
font-name: gothic-font
font-size: text-size
space-before: h1t-space-before
space-after: h1t-space-after
line-spacing: (* text-size 1.2)
keep-with-next?: #t
use: default-paragraph-style
(literal "導入") )
(make paragraph
line-spacing: (* text-size 2)
use: default-paragraph-style
(process-children) )))
;
; Section Level Elements
;
(define (internals nd)
(cond
((string=? "gensec" (gi nd))
(node-list-length (children nd)) )
(else 1) ))
(define (map+ ll)
(let loop ((lst ll))
(cond
((null? lst) 0)
(else (+ (car lst) (loop (cdr lst)))) )))
(define (section-number #!optional (nl (current-node)))
(case (gi nl)
(("GENSEC" "SCOPESEC" "SCOPE" "CONF" "REFS" "DEFS" "SYMABB" "SYMS")
(string-append
(number->string
(map+
(element-number-list
'("GENSEC" "SCOPESEC" "SCOPE" "CONF" "REFS" "DEFS" "SYMABB" "SYMS"))))
"\full-stop;") )
(("JFOREWORD") "")
(("ANNEXN") "")
(("ANNEXI") "")
(("TUTORIAL") "")
(("H1")
(if (or (not (node-list-empty? (ancestor "ANNEXI" nl)))
(not (node-list-empty? (ancestor "ANNEXN" nl)))
(not (node-list-empty? (ancestor "TUTORIAL" nl))) )
(string-append
(number->string (child-number nl)) "\full-stop;")
(string-append
(number->string
(map+
(element-number-list
'("GENSEC" "SCOPESEC" "SCOPE" "CONF" "REFS" "DEFS" "H1"))))
"\full-stop;" )))
(("H2")
(string-append (section-number (ancestor "H1" nl))
(number->string (child-number nl))))
(("H3")
(string-append
(section-number (ancestor "H2" nl))
"\full-stop;"
(number->string (child-number nl))))
(("H4")
(string-append
(section-number (ancestor "H3" nl))
"\full-stop;"
(number->string (child-number nl))))
(("H5")
(string-append
(section-number (ancestor "H4" nl))
"\full-stop;"
(number->string (child-number nl))))
(("H6")
(string-append
(section-number (ancestor "H5" nl))
"\full-stop;"
(number->string (child-number nl))))
(("H1T") (section-number (parent)))
(("H2T") (section-number (parent)))
(("H3T") (section-number (parent)))
(("H4T") (section-number (parent)))
(("H5T") (section-number (parent)))
(("H6T") (section-number (parent))) ))
;
; <![ IGNORE [
; <!ELEMENT gensec - O (scope, conf?, refs?, defs?,
; (symabb|syms)?,h1*) >
; ]]>
;
(element gensec (process-children))
;
; <![ IGNORE [
; <!ELEMENT scopesec - O ((%s.zz;)*) -- section with only scope -->
; ]]>
;
(element scopesec
(make display-group
(make paragraph
space-before: h1t-space-before
space-after: h1t-space-after
keep-with-next?: #t
use: h1t-style
(literal (section-number))
(literal
(cond
((attribute-string "stitle"))
(else "\space;適用範囲") ))
(process-children) )))
;
; <![ IGNORE [
; <!ELEMENT (annexn|annexi) - O (h0t, (%s.zz;)*, (h1*|p1*)) >
; ]]>
;
(define (annex-heading #!optional (nd (current-node)))
(string-append
"付属書"
(format-number
(+ 1 (node-list-count (select-elements (preced (current-node)) "ANNEXN"))
(node-list-count (select-elements (preced (current-node)) "ANNEXI")) )
"A")))
(element annexn
(make paragraph
break-before: 'page
font-family-name: gothic-font
font-name: gothic-font
font-size: 20q
line-spacing: (* 20q 1.2)
first-line-start-indent: 0pt
quadding: 'center
space-before: (display-space text-size priority: 10)
use: default-paragraph-style
(literal (annex-heading))
(literal ":(規定) ")
(process-children) ))
(element annexi
(make paragraph
break-before: 'page
font-family-name: gothic-font
font-name: gothic-font
font-size: 20q
line-spacing: (* 20q 1.2)
first-line-start-indent: 0pt
quadding: 'center
space-before: (display-space text-size priority: 10)
use: default-paragraph-style
(literal (annex-heading))
(literal ":(参考) ")
(process-children) ))
(element (annexn h0t) (process-children))
(element (annexi h0t) (process-children))
;
; <![ IGNORE [
; <!ENTITY % bd.d "scope|conf|symabb|syms" -- Body elements-->
;
; <!ELEMENT (%bd.d;) - O ((%s.zz;)*, (h2*|p2*))
; -- Clauses with fix title -->
; ]]>
;
(element scope
(make display-group
(make paragraph
keep-with-next?: #t
use: h1t-style
(literal (section-number))
(literal
(cond
((attribute-string "stitle"))
(else "\space;適用範囲") ))
(process-children) )))
(element (scope p)
(if (first-sibling?)
(make sequence
font-family-name: mincho-font
(literal " ")
(process-children) )
(make paragraph
use: default-paragraph-style
(process-children) )))
(element conf
(make display-group
(make paragraph
keep-with-next?: #t
use: h1t-style
(literal (section-number))
(literal
(cond
((attribute-string "stitle"))
(else "\space;適合性") ))
(process-children) )))
(element (conf p)
(if (first-sibling?)
(make sequence
font-family-name: mincho-font
use: default-paragraph-style
(process-children))
(make paragraph
use: default-paragraph-style
(process-children)) ))
(element symabb
(make display-group
(make paragraph
keep-with-next?: #t
use: h1t-style
(literal (section-number))
(literal
(cond
((attribute-string "stitle"))
(else "略語") ))
(process-children) )))
(element (symabb p)
(if (first-sibling?)
(make sequence
font-family-name: mincho-font
use: default-paragraph-style
(literal " ")
(process-children))
(make paragraph
use: default-paragraph-style
(process-children)) ))
(element syms
(make display-group
(make paragraph
keep-with-next?: #t
use: h1t-style
(literal (section-number))
(literal
(cond
((attribute-string "stitle"))
(else "記号") ))
(process-children) )))
(element (syms p)
(if (first-sibling?)
(make sequence
font-family-name: mincho-font
use: default-paragraph-style
(literal " ")
(process-children))
(make paragraph
use: default-paragraph-style
(process-children)) ))
;
; <![ IGNORE [
; <!ELEMENT refs - O (reflist) -- normative references -->
; <!ELEMENT reflist O O ((refref,reftit?)+) -- list of references -->
; <!ELEMENT refref - O (#PCDATA|note)* -(%i.float) -- reference -->
; <!ELEMENT reftit - O (%m.ph;) -(refref) -- title of reference -->
; ]]>
;
(element refs
(make display-group
(make paragraph
keep-with-next?: #t
use: h1t-style
(literal (section-number))
(literal
(cond
((attribute-string "stitle"))
(else "\space;引用規格") ))
(process-children) )))
(element (refs p)
(if (first-sibling?)
(make sequence
font-family-name: mincho-font
use: default-paragraph-style
(literal " ")
(process-children))
(make paragraph
use: default-paragraph-style
(process-children)) ))
(element reflist (process-children))
(element refref
(make paragraph
use: default-paragraph-style
(process-children)))
(element (refref note)
(make paragraph
use: default-paragraph-style
(make sequence
font-family-name: gothic-font
font-name: gothic-font
(literal "備考 "))
(process-children) ))
(element reftit
(make paragraph
font-family-name: gothic-font
font-name: gothic-font
use: default-paragraph-style
(process-children)))
;
; <![ IGNORE [
; <!ELEMENT defs - O (defref*,dl?) -- definitions -->
; <!ELEMENT defref - O (#PCDATA) -(%i.float) -- reference -->
; ]]>
;
(element defs
(make display-group
(make paragraph
keep-with-next?: #t
use: h1t-style
(literal (section-number))
(literal
(cond
((attribute-string "stitle"))
(else "\space;定義") ))
(process-children) )))
(element (defs p)
(if (first-sibling?)
(make sequence
font-family-name: mincho-font
use: default-paragraph-style
(literal " ")
(process-children))
(make paragraph
use: default-paragraph-style
(process-children)) ))
(element defref
(make paragraph
font-family-name: gothic-font
font-name: gothic-font
line-spacing: default-line-spacing
use: default-paragraph-style
(process-children)))
;
; <![ IGNORE [
; <!ELEMENT section - O (h0t, (%s.zz;)*, h1*) -- Section -->
; ]]>
;
(element section (process-children))
;
; <![ IGNORE [
; <!ELEMENT h1 - O (h1t, (%s.zz;)*, (h2*|p2*)) -- Clause -->
;
; <!ELEMENT h2 - O (h2t, (%s.zz;)*, (h3*|p3*)) -- Subclause -->
; <!ELEMENT h3 - O (h3t, (%s.zz;)*, (h4*|p4*)) -- S.s.clause -->
; <!ELEMENT h4 - O (h4t, (%s.zz;)*, (h5*|p5*)) -- ...clause -->
; <!ELEMENT h5 - O (h5t, (%s.zz;)*, (h6*|p6*)) -- ...clause -->
; <!ELEMENT h6 - O (h6t, (%s.zz;)*) -- ...clause -->
; <!ELEMENT (h0t|h1t|h2t|h3t|h4t|h5t|h6t)
; O O %m.ph; -(fig|tab|%ix;) -- Clause titles -->
; ]]>
;
(define (format-number-list num-list)
(cond
((null? num-list) "")
(else
(string-append
(number->string (car num-list))
"."
(format-number-list (cdr num-list)) ))))
(element h0t
(make paragraph
font-family-name: gothic-font
font-name: gothic-font
font-size: text-size
space-before: h0t-space-before
space-after: h0t-space-after
quadding: 'center
keep-with-next?: #t
first-line-start-indent: 0pt
use: default-paragraph-style
(process-children)))
;
; (define (my-number dom nmlist)
; (node-list-length
; (let body ((d dom) (nml nmlist))
; (cond
; ((null? nml) (empty-node-list))
; (else
; (node-list
; (select-elements
; (preced (descendants (ancestor d))) (car nml))
; (body d (cdr nml)) ))))))
(element h1
(make paragraph
use: h1t-style
(literal (section-number))
(literal "\space;")
(process-children) ))
(element h1t
(make sequence
use: h1t-style
(process-children) ))
(element (h1 p)
(cond
((and (first-sibling?)
(= 0 (node-list-length (children (node-at-location '("h1" "h1t"))))))
(make sequence
use: default-paragraph-style
(process-children) ))
(else
(make paragraph
use: default-paragraph-style
(process-children) ))))
(element h2
(make paragraph
space-before: h2t-space-before
space-after: h2t-space-after
use: h2t-style
(literal (section-number))
(literal "\space;")
(process-children) ))
(element h2t
(make sequence
use: h2t-style
(process-children) ))
(element (h2 p)
(cond
((and (first-sibling?)
(= 0 (node-list-length (children (node-at-location '("h2" "h2t"))))))
(make sequence
use: default-paragraph-style
(process-children) ))
(else
(make paragraph
use: default-paragraph-style
(process-children) ))))
(element h3
(make paragraph
space-before: h3t-space-before
space-after: h3t-space-after
keep-with-next?: #t
use: h3t-style
(literal (section-number))
(literal "\space;")
(process-children) ))
(element h3t
(make sequence
use: h3t-style
(process-children) ))
(element (h3 p)
(cond
((and (first-sibling?)
(= 0 (node-list-length (children (node-at-location '("h3" "h3t"))))))
(make sequence
use: default-paragraph-style
(process-children) ))
(else
(make paragraph
use: default-paragraph-style
(process-children) ))))
(element h4
(make paragraph
space-before: h4t-space-before
space-after: h4t-space-after
keep-with-next?: #t
use: h4t-style
(literal (section-number))
(literal "\space;")
(process-children) ))
(element h4t
(make sequence
use: h4t-style
(process-children) ))
(element (h4 p)
(cond
((and (first-sibling?)
(= 0 (node-list-length (children (node-at-location '("h4" "h4t"))))))
(make sequence
use: default-paragraph-style
(process-children) ))
(else
(make paragraph
use: default-paragraph-style
(process-children) ))))
(element h5
(make paragraph
space-before: h5t-space-before
space-after: h5t-space-after
keep-with-next?: #t
use: h5t-style
(literal (section-number))
(literal "\space;")
(process-children) ))
(element h5t
(make sequence
use: h5t-style
(process-children) ))
(element (h5 p)
(cond
((and (first-sibling?)
(= 0 (node-list-length (children (node-at-location '("h5" "h5t"))))))
(make sequence
use: default-paragraph-style
(process-children) ))
(else
(make paragraph
use: default-paragraph-style
(process-children) ))))
(element h6
(make paragraph
space-before: h6t-space-before
space-after: h6t-space-after
keep-with-next?: #t
use: h6t-style
(literal (section-number))
(literal "\space;")
(process-children) ))
(element h6t
(make sequence
use: h6t-style
(process-children) ))
(element (h6 p)
(cond
((and (first-sibling?)
(= 0 (node-list-length (children (node-at-location '("h6" "h6t"))))))
(make sequence
use: default-paragraph-style
(process-children) ))
(else
(make paragraph
use: default-paragraph-style
(process-children) ))))
;
; <![ IGNORE [
; <!ELEMENT p1 - O (p, (%s.zz;)*, (h2*|p2*)) -- Clause -->
; <!ELEMENT p2 - O (p, (%s.zz;)*, (h3*|p3*)) -- Subclause -->
; <!ELEMENT p3 - O (p, (%s.zz;)*, (h4*|p4*)) -- Subsubclause -->
; <!ELEMENT p4 - O (p, (%s.zz;)*, (h5*|p5*)) -- ...clause -->
; <!ELEMENT p5 - O (p, (%s.zz;)*, (h6*|p6*)) -- ...clause -->
; <!ELEMENT p6 - O (p, (%s.zz;)*) -- ...clause -->
; ]]>
;
(element p1
(make paragraph
space-before: text-size
line-spacing: (* text-size 2)
use: default-paragraph-style
(process-children)))
(element p2
(make paragraph
space-before: text-size
line-spacing: (* text-size 2)
use: default-paragraph-style
(process-children)))
(element p3
(make paragraph
space-before: text-size
line-spacing: (* text-size 2)
use: default-paragraph-style
(process-children)))
(element p4
(make paragraph
space-before: text-size
line-spacing: (* text-size 2)
use: default-paragraph-style
(process-children)))
(element p5
(make paragraph
space-before: text-size
line-spacing: (* text-size 2)
use: default-paragraph-style
(process-children)))
(element p6
(make paragraph
space-before: text-size
line-spacing: (* text-size 2)
use: default-paragraph-style
(process-children)))
;
; <![ IGNORE [
; <!ELEMENT (p|lp) O O ((%m.p1;|%m.p2;)*) -- Paragraphs -->
; ]]>
;
(element p (make-default-paragraph))
(element lp
(make paragraph
space-before: text-size
line-spacing: (* text-size 2)
use: default-paragraph-style
(process-children) ))
;
; <![ IGNORE [
; <!ELEMENT tutorial - O ((%s.zz)*, h1*, drftcom*) -- 解説 -->
; <!ELEMENT drftcom - - (c-name, cm-list) -- 原案作成委員会 -->
; <!ELEMENT c-name - O (#PCDATA) -- 委員会名 -->
; <!ELEMENT cm-list - - (c-mem*) -- 委員リスト -->
; <!ELEMENT c-mem - O (cm-name, cm-org) -- 委員 -->
; <!ELEMENT cm-name - O (#PCDATA) -- 委員氏名 -->
; <!ELEMENT cm-org - O (#PCDATA) -- 委員所属 -->
; ]]>
;
(element backm (process-children))
(mode tutorial-title
(default (empty-sosofo))
(element frontm (process-children))
(element titlep
(make paragraph
break-before: 'page
font-family-name: gothic-font
font-name: gothic-font
font-size: 20q
line-spacing: (* 20q 2)
first-line-start-indent: 0pt
space-before: (display-space text-size priority: 10)
start-indent: (* text-size 4)
end-indent: (* text-size 4)
quadding: 'center
use: default-paragraph-style
(process-matching-children 'refnum)
(process-matching-children 'jtitle)
(process-matching-children 'jptitle) ))
(element refnum (process-children))
(element jisnum
(make paragraph
(make sequence
font-size: 20q
(literal (publication-status))
(literal "\space;")
(process-matching-children 'divsym)
(literal "\space;")
(process-matching-children 'divnum) )
(make sequence
font-size: 13q
(literal "\colon;")
(process-matching-children 'pubyear) )))
(element divsym (process-children-trim))
(element divnum (process-children-trim))
(element pubyear (process-children-trim))
(element isnum
(make paragraph
font-family-name: gothic-font
font-size: 20q
(literal "\left-parenthesis;")
(process-children-trim)
(literal "\right-parenthesis;") ))
(element jtitle (process-children))
(element jptitle (process-children))
(element (jtitle tline)
(if (and
(absolute-last-sibling?)
(node-list-empty?
(node-at-location '("standjis" "frontm" "titlep" "jptitle")) ))
(make paragraph
(process-children)
(literal " 解説") )
(make paragraph
(process-children) )))
(element (jptitle tline)
(if (absolute-last-sibling?)
(make paragraph
(process-children)
(literal " 解説") )
(make paragraph
(process-children) )))
)
(element tutorial
(sosofo-append
(with-mode tutorial-title
(process-node-list
(node-at-location '("standjis" "frontm")) ))
(process-children) ))
(element drftcom (process-children))
(element c-name
(make paragraph
quadding: 'center
use: default-paragraph-style
space-before: text-size
space-after: text-size
(process-children)
(literal " 構成表") ))
(define (string-width str)
(let loop ((lst (string->list str)))
(cond
((null? lst) 0)
((ascii-char? (car lst))
(+ 1 (loop (cdr lst))) )
(else
(+ 2 (loop (cdr lst))) ))))
(define (inline-space-char n)
(cond
((<= n 0) "")
(else
(string-append " " (inline-space-char (- n 1))) )))
(element cm-list
(make paragraph
start-indent: 30mm
use: default-paragraph-style
(literal "氏名")
(literal (inline-space-char (- 20 (string-width "氏名"))))
(literal "所属")
(process-children) ))
(element c-mem
(let* ((role (attribute-string "ROLE"))
(tag (if role (string-append role " ") "")) )
(make paragraph
start-indent: (- 30mm (* (/ text-size 2) (string-width tag)) )
use: default-paragraph-style
(literal tag)
(process-children) )))
(element cm-name
(let ((name (data (current-node))))
(make sequence
(literal name)
(literal (inline-space-char (- 20 (string-width name)))) )))
(element cm-org (process-children))
;
; <![ IGNORE [
; <!ELEMENT hrule - O EMPTY -- horizontal rule -->
; ]]>
;
(element hrule
(make rule
orientation: 'horizontal
break-before-priority: 100
break-after-priority: 100
space-before: (/ (- text-size 1pt) 2)
space-after: (/ (- text-size 1pt) 2) ))
(mode back-title
(default (empty-sosofo))
(element frontm
(make simple-page-sequence
use: a4p-page-style
(make paragraph
font-family-name: gothic-font
font-size: 14pt
line-spacing: (* 1.2 14pt)
quadding: 'center
space-before: 20mm
use: default-paragraph-style
(literal "JAPANESE INDUSTRIAL STANDARD"))
(process-children)
(make paragraph
font-family-name: gothic-font
font-size: 14pt
line-spacing: (* 1.2 14pt)
keep: 'page
keep-with-previous?: #t
quadding: 'center
space-before: 5mm
use: default-paragraph-style
(literal "Investigated by") )
(make paragraph
font-family-name: gothic-font
font-size: 14pt
line-spacing: (* 1.2 14pt)
keep: 'page
keep-with-previous?: #t
quadding: 'center
space-before: 5mm
use: default-paragraph-style
(literal "Japanese Industrial Standards Commitee") )
(make rule
orientation: 'horizontal
length: 90mm
line-thickness: 1pt
quadding: 'center
break-before-priority: 100
break-after-priority: 100
space-before: (display-space 10mm priority: 100)
space-after: (display-space 10mm priority: 100)
keep: 'page
keep-with-previous?: #t
display-alignment: 'center )
(make paragraph
font-family-name: gothic-font
font-size: 10.5pt
line-spacing: 12pt
keep: 'page
keep-with-previous?: #t
quadding: 'center
space-before: 5mm
use: default-paragraph-style
(literal "Published by"))
(make paragraph
font-family-name: gothic-font
font-size: 10.5pt
line-spacing: 12pt
keep: 'page
keep-with-previous?: #t
quadding: 'center
space-before: 5mm
use: default-paragraph-style
(literal "Japanese Standards Association"))
(process-node-list (first-descendant "price"))
(if (not (node-list-empty? (first-descendant "ics")))
(make display-group
(make rule
orientation: 'horizontal
length: 180mm
line-thickness: 1pt
quadding: 'center
keep: 'page
keep-with-previous?: #t
break-before-priority: 100
break-after-priority: 100
space-before: 10mm
space-after: (display-space 10mm priority: 100)
display-alignment: 'center )
(process-node-list (first-descendant "ics"))
(process-node-list (first-descendant "kwset"))
(make paragraph
font-family-name: gothic-font
font-size: 10.5pt
line-spacing: 12pt
keep: 'page
keep-with-previous?: #t
quadding: 'start
use: default-paragraph-style
(literal
(string-append
"Reference number\colon;\space;JIS\space;"
(data (first-descendant "divsym"))
"\space;"
(data (first-descendant "divnum"))
"\colon;"
(data (first-descendant "pubyear"))
"(J)") )))
(empty-sosofo) )))
(element titlep
(make display-group
(process-matching-children "etitle")
(process-matching-children "eptitle")
(process-matching-children "refnum")
(if (node-list-empty? (first-descendant "revdate"))
(process-node-list (first-descendant "estdate"))
(process-node-list (first-descendant "revdate")) )))
(element etitle
(make paragraph
font-family-name: gothic-font
font-size: 24pt
line-spacing: (* 1.2 24pt)
keep: 'page
keep-with-previous?: #t
space-before: 25mm
quadding: 'center
use: default-paragraph-style
(process-children) ))
(element tline
(make paragraph
keep-with-previous?: #t
widow-count: 0
orphan-count: 0
(process-children) ))
(element eptitle
(make paragraph
font-family-name: gothic-font
font-size: 24pt
line-spacing: (* 1.2 24pt)
keep: 'page
keep-with-previous?: #t
quadding: 'center
use: default-paragraph-style
(process-children) ))
(element refnum (process-children))
(element jisnum
(make paragraph
font-family-name: gothic-font
font-size: 18pt
line-spacing: (* 1.2 18pt)
keep: 'page
keep-with-previous?: #t
quadding: 'center
space-before: 20mm
use: default-paragraph-style
(literal "JIS\space;")
(process-matching-children "divsym")
(literal "\space;")
(process-matching-children "divnum")
(make sequence
font-family-name: mincho-font
font-size: 10.5pt
(literal "\colon;")
(process-matching-children "pubyear") )
(process-matching-children "isnum") ))
(element divsym (process-children))
(element divnum (process-children))
(element pubyear (process-children))
(element isnum
(make paragraph
font-family-name: gothic-font
font-size: 18pt
line-spacing: (* 1.2 18pt)
quadding: 'center
use: default-paragraph-style
(literal "\left-parenthesis;")
(process-children)
(literal "\right-parenthesis;") ))
(element estdate
(make paragraph
font-family-name: gothic-font
font-size: 10.5pt
line-spacing: 12pt
quadding: 'center
space-before: 20mm
use: default-paragraph-style
(literal "Established ")
(if (new-style?)
(make sequence
(process-node-list (first-descendant "year"))
(literal "\hyphen-minus;")
(process-node-list (first-descendant "month"))
(literal "\hyphen-minus;")
(process-node-list (first-descendant "day")) )
(make sequence
(process-node-list (first-descendant "month"))
(literal "\space;")
(process-node-list (first-descendant "day"))
(literal "\comma;\space;")
(process-node-list (first-descendant "year")) ))))
(element revdate
(make paragraph
font-family-name: gothic-font
font-size: 10.5pt
line-spacing: 12pt
quadding: 'center
space-before: 15mm
use: default-paragraph-style
(literal "Revised ")
(if (node-list-empty?
(node-at-location
'("standjis" "frontm" "titlep" "pubinfo" "ics")) )
(make sequence
(process-node-list (first-descendant "month"))
(literal "\space;")
(process-node-list (first-descendant "day"))
(literal "\comma;\space;")
(process-node-list (first-descendant "year")) )
(make sequence
(process-node-list (first-descendant "year"))
(literal "\hyphen-minus;")
(process-node-list (first-descendant "month"))
(literal "\hyphen-minus;")
(process-node-list (first-descendant "day")) ))))
(element year (process-children))
(element month
(literal
(if (node-list-empty?
(node-at-location
'("standjis" "frontm" "titlep" "pubinfo" "ics")) )
(case (data (current-node))
(("1" "１") "Jan.")
(("2" "２") "Feb.")
(("3" "３") "Mar.")
(("4" "４") "Apr.")
(("5" "５") "May")
(("6" "６") "Jun.")
(("7" "７") "Jul.")
(("8" "８") "Aug.")
(("9" "９") "Sep.")
(("10" "１０") "Oct.")
(("11" "１１") "Nov.")
(("12" "１２") "Dec.")
(else "Jan.") )
(case (data (current-node))
(("1" "１") "01")
(("2" "２") "02")
(("3" "３") "03")
(("4" "４") "04")
(("5" "５") "05")
(("6" "６") "06")
(("7" "７") "07")
(("8" "８") "08")
(("9" "９") "09")
(("10" "１０") "10")
(("11" "１１") "11")
(("12" "１２") "12")
(else "01") ))))
(element day (process-children))
(element price
(make paragraph
font-family-name: gothic-font
font-size: 10.5pt
line-spacing: 12pt
quadding: 'end
space-before: 5mm
use: default-paragraph-style
(literal "価格\colon;\space本体")
(process-children)
(literal "円\left-parenthesis;税別\right-parenthesis;") ))
(element ics
(make paragraph
font-size: 10.5pt
line-spacing: 12pt
quadding: 'start
use: default-paragraph-style
(make sequence
font-family-name: gothic-font
(literal "ICS\space;") )
(make sequence
font-family-name: mincho-font
(process-children) )))
(element kwset
(make paragraph
font-size: 10.5pt
line-spacing: 12pt
quadding: 'start
use: default-paragraph-style
(make sequence
font-family-name: gothic-font
(literal "Descriptors\space;") )
(make sequence
font-family-name: mincho-font
(process-node-list (first-descendant "kw"))
(process-children) )))
(element kw
(make sequence
(literal "\comma;")
(process-children) ))
)
;
; <![ IGNORE [
; <!ELEMENT date O O (year, month, day) -- 日付 -->
; <!ELEMENT year O O (#PCDATA) -- 年(西暦)-->
; <!ELEMENT month O O (#PCDATA) -- 月 -->
; <!ELEMENT day O O (#PCDATA) -- 日 -->
; ]]>
;
(define (date-to-gengou1 year month day)
(cond
((<= year 1988)
(string-append
"昭和\space;"
(number->string (- year 1925)) "\space;年\space;"
(number->string month) "\space;月\space;"
(number->string day) "\space;日" ))
((= year 1989)
(if (and (= month 1) (< day 8))
(string-append
"昭和\space;"
(number->string (- year 1925)) "\space;年\space;"
(number->string month) "\space;月\space;"
(number->string day) "\space;日")
(string-append
"平成\space;"
(number->string (- year 1988)) "\space;年\space;"
(number->string month) "\space;月\space;"
(number->string day) "\space;日")))
(else
(string-append
"平成\space;"
(number->string (- year 1988)) "\space;年\space;"
(number->string month) "\space;月\space;"
(number->string day) "\space;日"))))
(define (date-to-gengou2 year month day)
(cond
((<= year 1988)
(string-append
"昭和\space;"
(number->string (- year 1925)) "\full-stop;"
(number->string month) "\full-stop;"
(number->string day) "\full-stop;" ))
((= year 1989)
(if (and (= month 1) (< day 8))
(string-append
"昭和\space;"
(number->string (- year 1925)) "\full-stop;"
(number->string month) "\full-stop;"
(number->string day) "\full-stop;")
(string-append
"平成\space;"
(number->string (- year 1987)) "\full-stop;"
(number->string month) "\full-stop;"
(number->string day) "\full-stop;")))
(else
(string-append
"平成\space;"
(number->string (- year 1987)) "年"
(number->string month) "月"
(number->string day) "日"))))
(element date (process-children))
(element year
(make sequence
(process-children)
(literal "年") ))
(element month
(make sequence
(process-children)
(literal "月") ))
(element day
(make sequence
(process-children)
(literal "日") ))
;
; <![ IGNORE [
; <!ELEMENT refnum - O (jisnum, isnum?) -- 参照番号 -->
; <!ELEMENT jisnum - O (divsym, divnum, pubyear) -- JIS規格番号 -->
; <!ELEMENT divsym - O (#PCDATA) -- 部門記号 -->
; <!ELEMENT divnum - O (#PCDATA) -- 部門内番号 -->
; <!ELEMENT isnum - O (#PCDATA) -- 対応国際規格の番号 -->
; ]]>
;
(element refnum
(make paragraph
font-name: gothic-font
font-size: 20q
keep: 'page
keep-with-previous?: #t
quadding: 'center
space-before: (display-space 42pt priority: 100)
space-after: (display-space 14pt priority: 100)
use: default-paragraph-style
(process-matching-children 'jisnum)
(process-matching-children 'isnum) ))
(define isnum-spacing default-line-spacing)
(element isnum
(make paragraph
space-before: (display-space 14pt priority: 90)
(literal "\left-parenthesis;")
(make sequence
font-size: 12pt
(process-children))
(literal "\right-parenthesis;") ))
(element jisnum
(make paragraph
(make sequence
(literal (publication-status))
(literal "\space;")
(process-matching-children 'divsym)
(literal " ")
(process-matching-children 'divnum)
(make sequence
font-size: 7pt
(literal ":")
(process-matching-children 'pubyear) ))))
(element divsym (process-children))
(element divnum (process-children))
(mode gengou1
(default (empty-sosofo))
(element date
(literal
(date-to-gengou1
(string->number
(normalize-number (data (first-descendant "YEAR")) "1"))
(string->number
(normalize-number (data (first-descendant "MONTH")) "1"))
(string->number
(normalize-number (data (first-descendant "DAY")) "1")) )))
)
(element pubyear
(with-mode gengou1 (process-children)))
;
; <![ IGNORE [
; <!ELEMENT dl - - (((dt+, (dd|ddg))|(dth,dl))*) >
; <!ELEMENT dt - O %m.ph; -- Definition term -->
; <!ELEMENT dth - O %m.ph; -- Definition term head-->
; <!ELEMENT dd - O %m.pseq; -- Definition description -->
; <!ELEMENT ddg - O (dd+) -- Definition description group -->
; ]]>
;
(element dl (process-children))
(element dt
(make paragraph
font-family-name: gothic-font
font-name: gothic-font
line-spacing: (* text-size 1.2)
keep-with-next?: #t
use: default-paragraph-style
(literal "\left-parenthesis;")
(literal
(format-number
(child-number)
(format-type
(node-list-length (ancestor-recursive "dl" (current-node))) )))
(literal "\right-parenthesis;\space;")
(process-children)))
(define (ancestor-recursive name #!optional (start (current-node)))
(let loop ((nl (empty-node-list))
(nd start) )
(cond
((node-list-empty? (ancestor name nd)) nl)
(else
(loop (node-list (ancestor name nd) nl) (ancestor name nd)) ))))
(define (count-nesting-level start)
(+ (node-list-length (ancestor-recursive (gi start) start)) 1))
(element dd
(make paragraph
start-indent: (* text-size (count-nesting-level (current-node)))
space-after: (display-space text-size priority: 100)
line-spacing: (* text-size 1.2)
keep-with-next?: #t
use: default-paragraph-style
(process-children)))
(element (dd p)
(make paragraph
start-indent: (* text-size (count-nesting-level (current-node)))
line-spacing: (* text-size 1.2)
use: default-paragraph-style
(process-children)))
(element ddg (process-children))
(element dth
(make paragraph
start-indent: (inline-space
(* text-size (count-nesting-level (current-node))) )
line-spacing: (* text-size 1.2)
use: default-paragraph-style
(process-children)))
;
; <![ IGNORE [
; <!ELEMENT artwork - O EMPTY >
; <!ATTLIST artwork name ENTITY #REQUIRED
; place (inline|line) line
; height CDATA #IMPLIED >
; ]]>
;
(element artwork
(make external-graphic
display?:
(case (attribute-string "place")
(("inline") #f)
(else #t) )
scale: 'max-uniform
max-height:
(if (attribute-string "height")
(string->quantity (attribute-string "height"))
72pt)
entity-system-id: (attribute-string "name")
display-alignment: 'center
position-point-x: 0pt
position-point-y:
(if (attribute-string "height")
(/ (string->quantity (attribute-string "height")) 2)
36pt)
escapement-direction: 'left-to-right
break-before-priority: 10
break-after-priority: 10
space-before: (display-space 10mm min: 5mm max: 20mm priority: 100)
space-after: (display-space 20mm min: 10mm max: 40mm priority: 100) ))
;
; <![ IGNORE [
; <!ELEMENT syml - - ((sym, desc)*) -- Symbols list -->
; <!ELEMENT sym - O (#PCDATA|(%p.zz.ph;)|artwork)*
; -- Symbol or abbreviation -->
; <!ELEMENT desc - O %m.pseq; -- Symbol description -->
; ]]>
;
(element syml (process-children))
(element sym
(make paragraph
font-family-name: gothic-font
font-name: gothic-font
use: default-paragraph-style
(process-matching-children "sym") ))
(element (syml desc)
(make paragraph
use: default-paragraph-style
(process-matching-children "desc") ))
;
; <![ IGNORE [
; <!ELEMENT varl - - ((var, desc)*) -- Variables list-->
; <!ELEMENT var - O %m.ph; -- Symbol or abbreviation -->
; ]]>
;
(element varl (process-children))
(element var
(make paragraph
font-family-name: gothic-font
font-name: gothic-font
use: default-paragraph-style
(process-matching-children "sym") ))
(element (varl desc)
(make paragraph
use: default-paragraph-style
(process-matching-children "desc") ))
;
; <![ IGNORE [
; <!ENTITY % ps.ul.d1 "ol|ul|sl" -- Unit-item lists (1) -->
; <!ENTITY % ps.ul.d2 "nl" -- Unit-item lists (2) -->
; <!ENTITY % ps.ul.d "%ps.ul.d1;|%ps.ul.d2" -- Unit-item lists -->
;
; <!ELEMENT (%ps.ul.d;) - - (li*) -- Unit item lists -->
; ]]>
;
; ol: ordered-list - 項目番号を振る。
; ul: unordered-list - 各項目に項目のレベルに応じたマークをいれる。
; sl: simple-list - olと同じに扱う。
; nl: note-list - 属性typeによって、タイトルをつけた。
;
;
; Level Marks of the List(UL)
;
(define level-marks '("-" "*" "+" "=" "@" "#" ))
(define (nearest-ancestor lst #!optional (nd (current-node)))
(let loop ((current (parent nd)))
(cond
((node-list-empty? current) #f)
((let lst-loop ((rest lst))
(cond
((null? rest) #f)
((string=? (car rest) (gi current)) current)
(else
(lst-loop (cdr rest)) ))))
(else (loop (parent current))) )))
(define (li-heading #!optional (nd (current-node)))
(let* ((nl (nearest-ancestor '("OL" "SL" "UL" "NL")))
(type (if nl (gi nl) #f)))
(case type
((#f) (error "Tree-structure corrupted"))
(("OL" "SL")
(string-append (format-item-heading) "\right-parenthesis;" ))
(("NL") (note-heading))
(("UL") (level-mark "li" level-marks (current-node)))
(else
(node-list-error "unknown list type" nl) ))))
(element ol (process-children))
(element ul (process-children))
(element sl (process-children))
(element nl (process-children))
;
; <![ IGNORE [
; <!ELEMENT li - O %m.pseq; -- List item -->
; ]]>
;
(define (format-item-heading #!optional (nd (current-node)))
(let ((level (node-list-length (ancestor-recursive "li"))))
(format-number
(child-number)
(format-type (+ level 1)) )))
(element (ol li)
(let ((level (node-list-length (ancestor-recursive "li"))))
(make paragraph
first-line-start-indent:
(- text-size (* (/ text-size 2) (string-length (li-heading))))
start-indent:
(+ (* (/ text-size 2) (string-length (li-heading)))
(* text-size
(+ 1 (node-list-length (ancestor-recursive "li" (current-node)))))
(- (* (/ text-size 2) (string-length (li-heading))))
text-size)
; (+ (* (/ text-size 2) (string-length (li-heading)))
; (* text-size
; (+ 1 (node-list-length (ancestor-recursive "li" (current-node)))) ))
; (+ (* text-size 2 (+ level 1 )) (* text-size 2))
use: default-paragraph-style
(make sequence
font-family-name: gothic-font
(literal (li-heading)))
(process-children) )))
(element (nl li)
(let* ((str (li-heading))
(heading
(string-append
str (number->string (child-number)) ))
(indent (* (/ text-size 2) (string-length str))) )
(make paragraph
use: default-paragraph-style
first-line-start-indent: (note-first-line-start-indent indent)
start-indent: (note-start-indent indent)
(make sequence
font-family-name: gothic-font
font-name: gothic-font
(literal heading))
(process-children-trim) )))
(element (sl li)
(make paragraph
use: default-paragraph-style
first-line-start-indent:
(- text-size (* (/ text-size 2) (string-length (li-heading))))
start-indent:
(+ (* (/ text-size 2) (string-length (li-heading)))
(* text-size
(+ 1 (node-list-length (ancestor-recursive "li" (current-node)))) ))
(make sequence
font-family-name: gothic-font
font-name: gothic-font
(literal (li-heading)))
(process-children) ))
(define (level-mark name lst nd)
(list-ref lst (node-list-length (ancestor-recursive name nd))) )
(element li
(make paragraph
first-line-start-indent:
(- text-size (* (/ text-size 2) (string-length (li-heading))))
start-indent:
(+ (* (/ text-size 2) (string-length (li-heading)))
(* text-size
(+ 1 (node-list-length (ancestor-recursive "li" (current-node)))) ))
line-spacing: (* text-size 1.2)
space-before: 0pt
space-after: 0pt
use: default-paragraph-style
(literal (li-heading))
(process-children) ))
(element (li p)
(if (absolute-first-sibling?)
(make sequence
(literal " ")
(process-children))
(make paragraph
start-indent:
(+ (* (/ text-size 2) (string-length (li-heading)))
(* text-size
(+ 1 (node-list-length (ancestor-recursive "li" (current-node)))) ))
(process-children) )))
;
; <![ IGNORE [
; <!ELEMENT (note|caution|warning) - - (p,(%s.zz;)*) -- Notes -->
; ]]>
;
(define (count-notes type #!optional (nd (ancestor "standjis" (current-node))))
(let loop ((nds (descendants nd))
(counter 0)
(type-str (if type type "NORM")))
(cond
((node-list-empty? nds) counter)
((not (gi (node-list-first nds)))
(loop (node-list-rest nds) counter type-str))
((string=? (gi (node-list-first nds)) "NOTE")
(cond
((equal? nd (node-list-first nds)) counter)
((string=?
(attribute-string+default
"TYPE" "NORM" (node-list-first nds)) type-str)
(loop (node-list-rest nds) (+ 1 counter) type-str) )
(else
(loop (node-list-rest nds) counter type-str) )))
((and (string=? (gi (node-list-first nds)) "LI")
(ancestor "nl"))
(cond
((equal? nd (node-list-first nds)) counter)
((string=?
(attribute-string+default
"TYPE" "NORM" (node-list-first nds)) type-str)
(loop (node-list-rest nds) (+ 1 counter) type-str))
(else
(loop (node-list-rest nds) counter type-str) )))
((string=? (gi (node-list-first nds)) "FN")
(cond
((string=?
(attribute-string+default
"TYPE" "COM" (node-list-first nds)) type-str)
(loop (node-list-rest nds) (+ 1 counter) type-str) )
(else
(loop (node-list-rest nds) counter type-str) )))
(else
(loop (node-list-rest nds) counter type-str) ))))
;(define (note-heading #!optional (nd (current-node)))
; (string-append
; (case (attribute-string "TYPE" nd)
; (("NORM") "備考")
; (("INFO") "参考")
; (("COM") "注")
; (else "備考") )
; (number->string (count-notes (attribute-string "TYPE"))) ))
(define (note-heading #!optional (nd (current-node)))
(case (attribute-string "TYPE" nd)
(("NORM") "備考")
(("INFO") "参考")
(("COM") "注")
(else "備考") ))
(define (note-first-line-start-indent indent)
(- indent) )
(define (note-start-indent indent)
(+ (inherited-start-indent) (actual-font-size) indent) )
(element note
(let* ((str (note-heading))
(heading (string-append str " "))
(indent (* (/ text-size 2) (string-length str))) )
(make paragraph
font-family-name: mincho-font
first-line-start-indent: (note-first-line-start-indent indent)
start-indent: (note-start-indent indent)
use: default-paragraph-style
(make sequence
font-family-name: gothic-font
(literal heading))
(process-children) )))
(element (note p) (process-children))
(element caution
(make sequence
(make paragraph
font-family-name: gothic-font
font-name: gothic-font
use: default-paragraph-style
(literal "注意")
(literal ": ") )
(process-children) ))
(element (caution p) (process-children))
(element warning
(make sequence
(make paragraph
font-family-name: gothic-font
font-name: gothic-font
use: default-paragraph-style
(literal "警告")
(literal ": ") )
(process-children) ))
(element (warning p) (process-children))
;
; <![ IGNORE [
; <!ELEMENT lines O O %m.pseq; -- Line elements -->
; ]]>
;
(element lines
(make line-field
field-width: (- 210mm 20mm 20mm)
field-align: 'start
writing-mode: 'left-to-right
inhibit-line-breaks?: #t
break-before-priority: 100
break-after-priority: 100
use: default-paragraph-style
(process-children) ))
;
; <![ IGNORE [
; <!ELEMENT lq - - %m.pseq; -(%i.float;) -- Long quotation -->
; ]]>
;
(element lq
(make paragraph
first-line-start-indent:
(if (string=? "p" (gi (parent)))
(* text-size (- 1))
0pt)
start-indent: (* 4 text-size (count-nesting-level (current-node)))
end-indent: (* 4 text-size (count-nesting-level (current-node)))
font-size: smaller-size
line-spacing: (* smaller-size 1.2)
use: default-paragraph-style
(process-children) ))
;
; <![ IGNORE [
; <!ELEMENT q - - %m.ph; -- Quotation -->
; ]]>
;
(element q
(make sequence
(literal "'")
(process-children)
(literal "'") ))
;
; <![ IGNORE [
; <!ELEMENT xmps - - (xmp+) -- Examples -->
; <!ELEMENT xmp - - %m.pseq; -(%i.float;) -- Example -->
; ]]>
;
(define (xmp-heading #!optional (nd (current-node)))
(string-append
"例"
(number->string (element-number)) ))
(element xmps (process-children))
(element xmp
(make paragraph
font-family-name: gothic-font
font-name: gothic-font
line-spacing: (* text-size 1.2)
start-indent: (* text-size (count-nesting-level (current-node)))
end-indent: (* text-size (count-nesting-level (current-node)))
lines: 'asis-wrap
inline-space-space: (* text-size 0.6)
expand-tabs?: 8
(literal "\left-square-bracket;")
(literal (xmp-heading))
(literal "\right-square-bracket;")
(make rule
orientation: 'escapement
length: 170mm
line-thickness: 1pt
break-before-priority: 100
break-after-priority: 0
display-alignment: 'start )
(process-children)
(make rule
orientation: 'escapement
length: 170mm
line-thickness: 1pt
break-before-priority: 0
break-after-priority: 100
display-alignment: 'start ) ))
;
; <![ IGNORE [
; <!ELEMENT extref - - (refref,reftit?,refspec?,%EHyTime;)
; -- external reference -->
; <!ELEMENT refspec - O (#PCDATA) -- specific part referred to -->
; ]]>
;
(element extref
(make sequence
(process-matching-children "refref")
(literal "(")
(process-matching-children "reftit")
(process-matching-children "refspec")
(literal ")") ))
(element (extref refref) (process-children))
(element (extref refspec)(process-children))
;
; <![ IGNORE [
; <!ELEMENT flmat - - %m.ph; -- Foreign language material -->
; ]]>
;
; jadeは、現状ではchar-upcaseをサポートしない。したがって、SGML解析系
; がupper-case変換すると仮定する。
;
(element flmat
(make sequence
language: (attribute-string "langcode")
(process-children) ))
;
; <![ IGNORE [
; <!ELEMENT cptr - - %m.ph; -- Computer example -->
; ]]>
;
(element cptr
(make paragraph
font-name: "Courier"
font-size: 9pt
first-line-start-indent: 0pt
start-indent: (* text-size (+ 1 (count-nesting-level (current-node))))
lines: 'asis-wrap
asis-wrap-indent:
(+ (* text-size (+ 1 (count-nesting-level (current-node))))
(* text-size 2) )
use: default-paragraph-style
(process-children) ))
;
; <![ IGNORE [
; <!ELEMENT syn - - ((synt,synd)+) --(SGML) syntax productions-->
; <!ELEMENT synt - O (#PCDATA) -- term -->
; <!ELEMENT synd - O ((sv|sk|sd|sdr|stv|stc|#PCDATA)*)
; -- definition -->
; ]]>
;
(element syn
(make paragraph
first-line-start-indent: (* text-size (- 4))
start-indent: (* text-size 8)
end-indent: (* text-size 4)
line-spacing: (* text-size 1.2)
space-after: (display-space text-size priority: 5)
use: default-paragraph-style
(process-children) ))
(element synt
(make sequence
font-family-name: "Times Roman"
font-weight: 'medium
font-posture: 'upright
(make paragraph-break
space-before: (* text-size 1.2) )
(literal "[")
(literal (number->string (element-number)))
(literal "] ")
(process-children)
(literal " = ") ))
(element synd
(make sequence
font-family-name: "Times Roman"
font-weight: 'medium
font-posture: 'upright
use: default-paragraph-style
(process-children) ))
;
; <![ IGNORE [
; <!ELEMENT sv - O (#PCDATA) -- variable -->
; <!ELEMENT sk - O (#PCDATA) -- literal -->
; <!ELEMENT sd - O (#PCDATA) -- syntax delimiter -->
; <!ELEMENT sdr - O (#PCDATA) -- syntax delimiter role -->
; <!ELEMENT stv - O (#PCDATA) -- syntax terminal, variable -->
; <!ELEMENT stc - O (#PCDATA) -- syntax terminal, constant -->
; ]]>
;
(element sv
(make sequence
font-family-name: "Times Roman"
font-posture: 'italic
(process-children) ))
(element sk
(make sequence
font-family-name: "Courier"
(process-children) ))
(element sd
(make sequence
font-family-name: "Times Roman"
font-weight: 'bold
(process-children) ))
(element sdr
(make sequence
font-family-name: "Times Roman"
font-weight: 'bold
font-posture: 'italic
(process-children) ))
(element stv
(make sequence
font-family-name: "Helvetica"
font-weight: 'bold
font-posture: 'oblique
(process-children) ))
(element stc
(make sequence
font-family-name: "Helvetica"
font-weight: 'bold
(process-children) ))
;
; <![ IGNORE [
; <!ENTITY % p.em.ph "hp1|hp2|hp3|hp4|hp0|cit" -- Emphasized phrases -->
; <!ELEMENT (%p.em.ph;) - - %m.ph; -- Emphasized phrases -->
; ]]>
;
;
; 強調のためのパラメータ
;
(define under-line-thickness 1pt)
(define over-line-thickness 1pt)
(define through-line-thickness 1pt)
(define under-score-spaces #t)
(define over-score-spaces #t)
(define through-score-spaces #t)
(define hp0-type "under")
(define hp0-font mincho-font)
(define hp0-posture 'upright)
(define hp0-structure 'solid)
(define hp0-weight 'medium)
(define hp0-before "")
(define hp0-after "")
(define hp1-type "sequence")
(define hp1-font gothic-font)
(define hp1-posture 'upright)
(define hp1-structure 'solid)
(define hp1-weight 'medium)
(define hp1-before "")
(define hp1-after "")
(define hp2-type "sequence")
(define hp2-font mincho-font)
(define hp2-posture 'italic)
(define hp2-structure 'solid)
(define hp2-weight 'medium)
(define hp2-before "")
(define hp2-after "")
(define hp3-type "under")
(define hp3-font gothic-font)
(define hp3-posture 'upright)
(define hp3-structure 'solid)
(define hp3-weight 'medium)
(define hp3-before "")
(define hp3-after "")
(define hp4-type "under")
(define hp4-font gothic-font)
(define hp4-posture 'italic)
(define hp4-structure 'solid)
(define hp4-weight 'medium)
(define hp4-before "")
(define hp4-after "")
(define cit-type "sequence")
(define cit-font mincho-font)
(define cit-posture 'italic)
(define cit-structure 'solid)
(define cit-weight 'medium)
(define cit-before "“")
(define cit-after "”")
;
; 強調0のためのスタイル定義
;
(define hp0-style
(style
font-family-name: hp0-font ; フォントファミリ
font-weight: hp0-weight ; フォントの重み
font-posture: hp0-posture ; フォントの姿勢
font-structure: hp0-structure ; フォント構造
))
<!--
強調1のためのスタイル定義
-->
(define hp1-style
(style
font-family-name: hp1-font ; フォントファミリ
font-weight: hp1-weight ; フォントの重み
font-posture: hp1-posture ; フォントの姿勢
font-structure: hp1-structure ; フォント構造
))
;
; 強調2のためのスタイル定義
;
(define hp2-style
(style
font-family-name: hp2-font ; フォントファミリ
font-weight: hp2-weight ; フォントの重み
font-posture: hp2-posture ; フォントの姿勢
font-structure: hp2-structure ; フォントの構造
))
;
; 強調3のためのスタイル定義
;
(define hp3-style
(style
font-family-name: hp3-font ; フォントファミリ
font-weight: hp3-weight ; フォントの重み
font-posture: hp3-posture ; フォントの姿勢
font-structure: hp3-structure ; フォントの構造
))
;
; 強調4のためのスタイル定義
;
(define hp4-style
(style
font-family-name: hp4-font ; フォントファミリ
font-weight: hp4-weight ; フォントの重み
font-posture: hp4-posture ; フォントの姿勢
font-structure: hp4-structure ; フォントの構造
))
;
; Citのためのスタイル定義
;
(define cit-style
(style
font-family-name: cit-font ; フォントファミリ
font-weight: cit-weight ; フォントの重み
font-posture: cit-posture ; フォントの姿勢
font-structure: cit-structure ; フォントの構造
))
;
; 手続きmake-score-or-hp:
; 指定に従って、流し込みオブジェクトscore又は流し込みオブジェクトsequenceを生成する。
;
(define (make-score-or-hp type stl)
(case type
(("under") ; typeの値が"under"の場合
(make score ; 流し込みオブジェクトscoreを生成する
type: 'after ; scoreの型はアンダーライン
line-thickness: under-line-thickness ; アンダーラインの太さ
score-spaces?: under-score-spaces ; 空白にアンダーラインを引くか?
use: stl ; 指定されたスタイルの利用
(process-children) ; 子要素の処理結果を子とする
))
(("over") ; typeの値が"over"の場合
(make score ; 流し込みオブジェクトscoreを生成する
type: 'before ; scoreの型はオーバーライン
line-thickness: over-line-thickness ; オーバーラインの太さ
score-spaces?: over-score-spaces ; 空白にアンダーラインを引くか?
use: stl ; 指定されたスタイルの利用
(process-children) ; 子要素の処理結果を子とする
))
(("through") ; typeの値が"through"の場合
(make score ; 流し込みオブジェクトscoreを生成する
type: 'through ; scoreの型は抹消線
line-thickness: through-line-thickness ; 抹消線の太さ
score-spaces?: through-score-spaces ; 空白にアンダーラインを引くか?
use: stl ; 指定されたスタイルの利用
(process-children) ; 子要素の処理結果を子とする
))
(else ; typeの値が上記以外の場合
(make sequence ; 流し込みオブジェクトsequenceを生成する
use: stl ; 指定されたスタイルの利用
(process-children) ; 子要素の処理結果を子とする
))))
;
; make-emph: 強調した流し込みオブジェクトを生成する手続き
;
(define (make-emph type stl #!key (before "") (after ""))
(if (and (= 0 (string-length before)) (= 0 (string-length after)))
(make-score-or-hp type stl)
(make sequence
use: stl
(literal before)
(make-score-or-hp type stl)
(literal after) )))
;
; 要素hp1に関する規則
;
(element hp1
(make-emph hp1-type hp1-style before: hp1-before after: hp1-after))
;
; 要素hp2に関する規則
;
(element hp2
(make-emph hp2-type hp2-style before: hp2-before after: hp2-after))
;
; 要素hp3に関する規則
;
(element hp3
(make-emph hp3-type hp3-style before: hp3-before after: hp3-after))
;
; 要素hp4に関する規則
;
(element hp4
(make-emph hp4-type hp2-style before: hp4-before after: hp4-after))
;
; 要素citに関する規則
;
(element cit
(make-emph cit-type cit-style before: cit-before after: cit-after))
;
; <![ IGNORE [
; <!-- Includable Subelements -->
; <!-- ELEMENTS MIN CONTENT (EXCEPTIONS) -->
; <!ELEMENT fig - - (figbody, (figcap, figdesc?)?) -(%i.float;) >
; <!ELEMENT figbody O O (figcomm?,(%s.zz;)*) -- Figure body -->
; <!ELEMENT figcomm - O %m.ph; -- Figure comment -->
; <!ELEMENT figcap - O %m.ph; -- Figure caption -->
; <!ELEMENT figdesc - O %m.pseq; -- Figure description -->
; ]]>
;
(define (fig-heading #!optional (nd (current-node)))
(string-append
"図"
(number->string (element-number nd)) ))
(define (figcap-heading #!optional (nd (current-node)))
(string-append
"図"
(number->string (element-number (parent))) ))
(element fig
(make display-group
space-before: default-line-spacing
space-after: default-line-spacing
(process-children)))
(element figbody (process-children))
(element figcap
(if (= (node-list-length (children (current-node))) 0)
(empty-sosofo)
(make paragraph
start-indent: (* text-size 4)
end-indent: (* text-size 4)
quadding: 'center
use: default-paragraph-style
(literal (fig-heading))
(literal "\colon;\space;")
(process-children) )))
(element figdesc
(make paragraph
start-indent: (* text-size 4)
end-indent: (* text-size 4)
use: default-paragraph-style
(process-children)))
(define fn-heading-font gothic-font)
(define fn-heading-weight 'medium)
(define fn-heading-posture 'upright)
(define fn-heading-structure 'solid)
(define fn-heading-style
(style
font-family-name: fn-heading-font ; フォントファミリ
font-weight: fn-heading-weight ; フォントの重み
font-posture: fn-heading-posture ; フォントの姿勢
font-structure: fn-heading-structure ; フォント構造
))
(define (fn-heading #!optional (nd (current-node)))
(string-append
"注"
(count-notes "COM") ))
(element fn
(make paragraph
start-indent: (* text-size 2)
use: default-paragraph-style
(make sequence
use: fn-heading-style
(literal (fn-heading))
(literal "\colon; "))
(process-children) ))
;
; <![ IGNORE [
; <!ELEMENT form - - ((%s.zz;|fillin)*) -- Form -->
; <!ELEMENT fillin - - (item?,unit?,subitem*)
; -- Question to fill in -->
; <!ELEMENT item - O (%m.ph;) -(fillin) -- item in fillin -->
; <!ELEMENT unit - O (%m.ph;) -(fillin) -- unit of item -->
; <!ELEMENT subitem - O (%m.ph;) -(fillin) -- subitem in fillin -->
; ]]>
;
(element form (process-children))
(element fillin
(make paragraph
start-indent: (* text-size (count-nesting-level (current-node)))
end-indent: (* text-size (count-nesting-level (current-node)))
use: default-paragraph-style
(process-children)
(make line-field
field-width: 50mm
field-align: 'start
writing-mode: 'left-to-right
inhibit-line-breaks?: #t
break-before-priority: 0
break-after-priority: 100
use: default-paragraph-style
inline-space-space: (inline-space 50mm min: 40mm max: 50mm)
(literal "[ ]") )))
(element (fillin item)
(make sequence
font-family-name: gothic-font
font-name: gothic-font
(process-children) ))
(element (fillin unit)
(make sequence
font-family-name: gothic-font
font-name: gothic-font
(literal "(")
(process-children)
(literal ")") ))
(element (fillin subitem) (process-children))
;
; <![ IGNORE [
; <!-- ELEMENTS MIN CONTENT (EXCEPTIONS) -->
; <!ELEMENT compexp - - ((comp,exp)+) --Explanation of components-->
; <!ELEMENT comp - O (#PCDATA) -- Component -->
; <!ELEMENT exp - O %m.pseq; -- Explanation -->
; ]]>
;
(element compexp
(make paragraph
start-indent: (* text-size 4)
end-indent: (* text-size 4)
use: default-paragraph-style
(process-children) ))
(element comp
(make line-field
field-width: 50mm
field-align: 'start
writing-mode: 'left-to-right
break-before-priority: 100
break-after-priority: 0
escapement-space-after: (inline-space text-size min: text-size max: (* text-size 4))
use: default-paragraph-style
(literal "\bullet")
(process-children) ))
(element (comexp exp)
(make line-field
field-width: 100mm
field-align: 'start
writing-mode: 'left-to-right
break-before-priority: 0
break-after-priority: 100
use: default-paragraph-style
(process-children) ))
;
; <![ IGNORE [
; <!-- ELEMENTS MIN CONTENT (EXCEPTIONS) -->
; <!ELEMENT alterns - - ((cond?,altern?)+) -- alternatives -->
; <!ELEMENT cond - O %m.pseq; -- condition for alternative -->
; <!ELEMENT altern - O %m.pseq; -- text of alternative -->
; <!ATTLIST cond id ID #IMPLIED
; label CDATA #IMPLIED >
; <!ATTLIST altern refid IDREF #IMPLIED >
; ]]>
;
(element alterns
(make paragraph
start-indent: (* text-size 4)
end-indent: (* text-size 4)
use: default-paragraph-style
(process-children) ))
(element "cond"
(make line-field
field-width: 50mm
field-align: 'start
writing-mode: 'left-to-right
break-before-priority: 100
break-after-priority: 0
escapement-space-after: (inline-space text-size min: text-size max: (* text-size 4))
use: default-paragraph-style
(literal "・")
(process-children) ))
(element altern
(make line-field
field-width: 100mm
field-align: 'start
writing-mode: 'left-to-right
break-before-priority: 0
break-after-priority: 100
use: default-paragraph-style
(process-children) ))
;
; <![ IGNORE [
; <!ELEMENT tab - - (tabcap?, tabdesc?, tabcomm?, tabmat,
; (%s.zz;)*) -(%i.float;) >
; <!ATTLIST tab id ID #IMPLIED
; width CDATA page
; place (top|fixed|bottom) top
; align (left|center|right) center
; type (tab|chart|table|form|listing)
; tab
; number CDATA #IMPLIED >
; ]]>
;
(define (table-heading #!optional (nd (current-node)))
(string-append
"表"
(number->string (element-number)) ))
(element tab
(make display-group
keep: 'page
position-preference:
(case (attribute-string "place")
(("TOP" "top") 'top)
(("BOTTOM" "bottom") 'bottom)
(else #f) )
display-alignment:
(case (attribute-string "align")
(("LEFT" "left") 'start)
(("CENTER""center") 'center)
(("RIGHT" "right") 'end) )
(process-children) ))
;
; <![ IGNORE [
; <!ELEMENT tabcap - O %m.ph; -- Table caption -->
; <!ELEMENT tabdesc - O %m.pseq; -- Table description -->
; <!ELEMENT tabcomm - O %m.ph; -- Table comment -->
; ]]>
;
(element tabcap
(make paragraph
font-size: smaller-size
start-indent: (* text-size 4)
end-indent: (* text-size 4)
quadding: 'center
keep-with-next?: #t
space-before: (display-space text-size priority: 100)
space-before: (display-space 0pt priority: 100)
use: default-paragraph-style
(literal (table-heading))
(literal ": ")
(process-children)))
(element tabdesc
(make paragraph
font-size: smaller-size
start-indent: (* text-size 4)
end-indent: (* text-size 4)
keep-with-next?: #t
use: default-paragraph-style
(process-children) ))
(element tabcomm
(make paragraph
font-size: smaller-size
start-indent: (* text-size 4)
end-indent: (* text-size 4)
keep-with-next?: #t
use: default-paragraph-style
(literal "注: ")
(process-children) ))
;
; <![ IGNORE [
; <!ELEMENT tabmat - - (tabhead?, tabfoot?, tabbody)
; -(%i.float;|tabmat) -- Table matter -->
; <!ATTLIST tabmat rotate (0|90|180|270) 0
; width CDATA #IMPLIED
; compact (compact) #IMPLIED
; pointsz (6|7|8|9|10|11|12|14|16|18|20) %tab.pz;
; trules CDATA "T B L R"
; domains NMTOKENS none
; -- attributes specifying defaults for lower levels --
; gridx CDATA "*"
; gridy CDATA "*"
; arrange CDATA "none"
; rrules CDATA "T B L R"
; crules CDATA "T B L R"
; cvalign (T|C|B) "T"
; caligns CDATA "L"
; calignps CDATA "-"
; >
; ]]>
;
(element tabmat
(make table
line-thickness: 2pt
table-border: #t
space-before: (display-space text-size priority: 50)
space-after: (display-space text-size priority: 100)
font-size:
(if (attribute-string "pointsz")
(* 1pt (string->number (attribute-string "pointsz")))
smaller-size)
(make table-part
(process-children) )))
;
; <![ IGNORE [
; <!ELEMENT (tabhead|tabfoot) - O (arow) -- header/footer -->
;
; <!ATTLIST tabhead headhi (0|1|2|3) %tab.hhi;
; >
; ]]>
;
(element tabhead
(make sequence
font-size: (if (attribute-string "pointsz")
(* 1pt (string->number (attribute-string "pointsz")))
smaller-size)
label: 'header
(process-children) ))
(element tabfoot
(make sequence
font-size: (if (attribute-string "pointsz")
(* 1pt (string->number (attribute-string "pointsz")))
smaller-size)
label: 'footer
(process-children) ))
;
; <![ IGNORE [
; <!ELEMENT tabbody - O (arow+) --Body of tabular material -->
;
; <!ATTLIST tabbody -- brules CDATA "T B L R" --
; -- attributes specifying defaults for lower levels --
; gridx CDATA #IMPLIED
; gridy CDATA #IMPLIED
; arrange CDATA #IMPLIED
; rrules CDATA #IMPLIED
; crules CDATA #IMPLIED
; cvalign (T|C|B) #IMPLIED
; caligns CDATA #IMPLIED
; calignps CDATA #IMPLIED
; >
; ]]>
;
(element tabbody
(make sequence
font-size: (if (attribute-string "pointsz")
(* 1pt (string->number (attribute-string "pointsz")))
smaller-size)
table-border: #t
(process-children) ))
;
; <![ IGNORE [
; <!ELEMENT arow - O (c+) -- Arranged row -->
;
; <!ATTLIST arow pointsz (6|7|8|9|10|11|12|14|16|18|20) #IMPLIED
; split (yes|no) no
; gridx CDATA #IMPLIED
; gridy CDATA #IMPLIED
; arrange CDATA #IMPLIED
; rrules CDATA #IMPLIED
; -- attributes specifying defaults for lower levels --
; crules CDATA #IMPLIED
; cvalign (T|C|B) #IMPLIED
; caligns CDATA #IMPLIED
; calignps CDATA #IMPLIED
; >
; ]]>
;
(element arow
(make table-row
font-size: (if (attribute-string "pointsz")
(* 1pt (string->number (attribute-string "pointsz")))
smaller-size)
(process-children) ))
;
; <![ IGNORE [
; <!ELEMENT c - O (sc+) -- Table matter cell -->
;
; <!ATTLIST c nr NUTOKEN #IMPLIED
; pointsz (6|7|8|9|10|11|12|14|16|18|20) #IMPLIED
; type (head|body) body
; rotate (0|90|180|270) 0
; crules CDATA #IMPLIED
; cvalign (T|C|B) #IMPLIED
; calign CDATA #IMPLIED
; calignp CDATA #IMPLIED
; domain NMTOKEN "none"
; >
; ]]>
;
(element c
(make table-cell
font-size: (if (attribute-string "pointsz")
(* 1pt (string->number (attribute-string "pointsz")))
smaller-size)
cell-before-row-margin: (/ (inherited-font-size) 2)
cell-after-row-margin: (/ (inherited-font-size) 2)
cell-before-column-margin: (/ (inherited-font-size) 2)
cell-after-column-margin: (/ (inherited-font-size) 2)
cell-row-alignment: 'start
line-thickness: 1pt
cell-before-row-border: #t
cell-after-row-border: #t
cell-before-column-border: #t
cell-after-column-border: #t
(process-children) ))
;
; <![ IGNORE [
; <!ELEMENT sc O O (#PCDATA|hrule|%s.zz;|%p.zz.ph;)* +(tn)
; --Table matter sub-cell -->
; ]]>
;
(element sc (process-children))
;
; <![ IGNORE [
; <!ELEMENT tn - - %m.pseq; -- Tablenote -->
;
; <!ATTLIST tn id ID #IMPLIED>
; ]]>
;
(element tn
(make paragraph
font-size: (* 0.7 (inherited-font-size))
start-indent: (* 0.7 (inherited-font-size))
use: default-paragraph-style
(literal "注")
(process-children) ))
;
; <![ IGNORE [
; <!ELEMENT toc - O EMPTY -- 目次(自動生成) -->
; <!ATTLIST toc level NUMBER 1
; levela NUMBER #IMPLIED>
; ]]>
;
(define toc-entries-list '(
("JFOREWORD" "GENSEC" "SCOPESEC" "SCOPE" "CONF" "REFS" "DEFS" "SYMABB" "SYMS"
"ANNEXN" "ANNEXI" "TUTORIAL")
("H1")
("H2")
("H3")
("H4")
("H5")
("H6") ))
(define (toc-entries
#!optional
(n (case (gi (current-node))
(("ANNEXN" "ANNEXI" "TUTORIAL")
(string->number
(attribute-string+default
"LEVELA"
"3"
(node-at-location '("standjis" "frontm" "toc")) )))
(else
(string->number
(attribute-string+default
"LEVEL"
"3"
(node-at-location '("STANDJIS" "FRONTM" "TOC")) ))))))
(cond
((<= n 0) '())
(else (append (list-ref toc-entries-list n) (toc-entries (- n 1)))) ))
(define (toc-entry entry-string #!optional (nd (current-node)))
(make display-group
(make paragraph
start-indent: (* text-size 4)
first-line-start-indent: (* text-size 2)
quadding: 'start
use: h2t-style
(let ((number (section-number nd)))
(if (> (string-length number) 0)
(literal (string-append number "\space;"))
(empty-sosofo) ))
(literal entry-string)
(make leader (literal "\full-stop;"))
;; Works Only on Jade !!!
(current-node-page-number-sosofo) )
(apply process-matching-children (toc-entries) )))
(define (title-string)
(data
(select-elements (children (current-node))
(string-append (gi (current-node)) "T") )))
(mode making-toc
(default (empty-sosofo))
(element standjis (process-children))
(element frontm (process-children))
(element body (process-children))
(element backm (process-children))
(element JFOREWORD (toc-entry "序文"))
(element INTRO (toc-entry "導入"))
(element SCOPESEC (toc-entry "適用範囲"))
(element SCOPE (toc-entry "適用範囲"))
(element CONF (toc-entry "適合性"))
(element REFS (toc-entry "参照規格"))
(element DEFS (toc-entry "定義"))
(element SYMABB (toc-entry "略語"))
(element SYMS (toc-entry "記号"))
(element H1 (toc-entry (title-string)))
(element H2 (toc-entry (title-string)))
(element H3 (toc-entry (title-string)))
(element H4 (toc-entry (title-string)))
(element H5 (toc-entry (title-string)))
(element H6 (toc-entry (title-string)))
(element ANNEXN
(toc-entry
(string-append (annex-heading) "\colon;" "(規定)" )))
(element ANNEXI
(toc-entry
(string-append (annex-heading) "\colon;" "(参考)" )))
(element TUTORIAL (toc-entry "解説"))
)
(element toc
(make display-group
(make paragraph
break-before: 'page
font-family-name: gothic-font
font-posture: 'upright
font-size: text-size
line-spacing: default-line-spacing
start-indent: 0pt
quadding: 'start
keep-with-next?: #t
(literal "目次") )
(with-mode making-toc
(process-node-at-location '("standjis")) )))
<![ IGNORE [
<!ENTITY % p.rf.ph "hdref|figref|tabref|rtref|atref"
-- Reference phrases -->
<!ENTITY % p.rf.d "fnref|noteref|liref|iref|bibref|tnref|dfref|xmpref"
-- References (empty) -->
<!ELEMENT (%p.rf.ph;) - O %m.ph; -- Reference phrases -->
<!ELEMENT (%p.rf.d;) - O EMPTY -- Generated references -->
<!ATTLIST (%p.rf.ph;) refid %idrefs #CONREF
initial (uc|lc) lc
boolean (and|or) and
page (yes|no) no >
]]>
(mode refs
(default (empty-sosofo))
(element SECTION (literal (section-number)))
(element GENSEC (literal (section-number)))
(element SCOPESEC (literal (section-number)))
(element SCOPE (literal (section-number)))
(element CONF (literal (section-number)))
(element SYMABB (literal (section-number)))
(element SYMS (literal (section-number)))
(element REFS (literal (section-number)))
(element DEFS (literal (section-number)))
(element H1 (literal (section-number)))
(element H2 (literal (section-number)))
(element H3 (literal (section-number)))
(element H4 (literal (section-number)))
(element H5 (literal (section-number)))
(element H6 (literal (section-number)))
(element P1
(literal
(section-number (node-list-last (select-elements (preced (current-node)) "H1"))) ))
(element P2
(literal (section-number (ancestor "H1"))) )
(element P3
(literal (section-number (ancestor "H2"))) )
(element P4
(literal (section-number (ancestor "H3"))) )
(element P5
(literal (section-number (ancestor "H4"))) )
(element P6
(literal (section-number (ancestor "H5"))) )
(element ANNEXN (literal (annex-heading)))
(element ANNEXI (literal (annex-heading)))
(element fig (literal (fig-heading (current-node))))
(element tab (literal (table-heading)))
(element fn (literal (fn-heading)) )
(element note (literal (note-heading)))
(element li (literal (li-heading)))
(element dt (process-children))
(element dth (process-children))
(element (dt p) (process-children))
(element (dth p) (process-children))
(element xmp (xmp-heading))
)
(define hdref-font mincho-font)
(define hdref-weight 'medium)
(define hdref-posture 'italic)
(define hdref-structure 'solid)
(define hdref-style
(style
font-family-name: hdref-font
font-weight: hdref-weight
font-posture: hdref-posture
font-structure: hdref-structure
))
(element hdref
(make sequence
use: hdref-style
(with-mode refs
(process-node-list
(element-with-id (attribute-string "refid")) ))))
(define figref-font gothic-font)
(define figref-weight 'medium)
(define figref-posture 'upright)
(define figref-structure 'solid)
(define figref-style
(style
font-family-name: figref-font
font-weight: figref-weight
font-posture: figref-posture
font-structure: figref-structure
))
(element figref
(make sequence
use: figref-style
(with-mode refs
(process-node-list
(element-with-id (attribute-string "refid")) ))))
(define tabref-font mincho-font)
(define tabref-weight 'medium)
(define tabref-posture 'italic)
(define tabref-structure 'solid)
(define tabref-style
(style
font-family-name: tabref-font
font-weight: tabref-weight
font-posture: tabref-posture
font-structure: tabref-structure
))
(element tabref
(make sequence
use: tabref-style
(with-mode refs
(process-node-list
(element-with-id (attribute-string "refid")) ))))
(define fnref-font mincho-font)
(define fnref-weight 'medium)
(define fnref-posture 'italic)
(define fnref-structure 'solid)
(define fnref-style
(style
font-family-name: fnref-font
font-weight: fnref-weight
font-posture: fnref-posture
font-structure: fnref-structure
))
(element fnref
(make sequence
use: fnref-style
(with-mode refs
(process-node-list
(element-with-id (attribute-string "refid")) ))))
(define noteref-font mincho-font)
(define noteref-weight 'medium)
(define noteref-posture 'italic)
(define noteref-structure 'solid)
(define noteref-style
(style
font-family-name: noteref-font
font-weight: noteref-weight
font-posture: noteref-posture
font-structure: noteref-structure
))
(element noteref
(make sequence
use: noteref-style
(with-mode refs
(process-node-list
(element-with-id (attribute-string "refid")) ))))
(define tnref-font mincho-font)
(define tnref-weight 'medium)
(define tnref-posture 'italic)
(define tnref-structure 'solid)
(define tnref-style
(style
font-family-name: tnref-font
font-weight: tnref-weight
font-posture: tnref-posture
font-structure: tnref-structure
))
(element tnref
(make sequence
use: tnref-style
(with-mode refs
(process-node-list
(element-with-id (attribute-string "refid")) ))))
(define liref-font mincho-font)
(define liref-weight 'medium)
(define liref-posture 'italic)
(define liref-structure 'solid)
(define liref-style
(style
font-family-name: liref-font
font-weight: liref-weight
font-posture: liref-posture
font-structure: liref-structure
))
(element liref
(make sequence
use: liref-style
(with-mode refs
(process-node-list
(element-with-id (attribute-string "refid")) ))))
(define xmpref-font mincho-font)
(define xmpref-weight 'medium)
(define xmpref-posture 'italic)
(define xmpref-structure 'solid)
(define xmpref-style
(style
font-family-name: xmpref-font
font-weight: xmpref-weight
font-posture: xmpref-posture
font-structure: xmpref-structure
))
(element xmpref
(make sequence
use: xmpref-style
(with-mode refs
(process-node-list
(element-with-id (attribute-string "refid")) ))))