]> ; ; 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 10q) (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) )) ; ; ; ; ; ]]> (element standjis (make display-group (process-children) (with-mode back-title (process-node-list (select-elements (children (current-node)) "frontm")) ))) ; ; ; ]]> ; ; ISO版の書誌情報なので無視する。 ; ; (element (standjis bibinfo) (empty-sosofo)) ; ; ; ; ; ; ]]> ; ;(element standard (empty-sosofo)) ; ; ; ]]> ; (element frontm (make display-group (process-matching-children 'titlep) (process-matching-children 'toc) (process-matching-children 'intro) )) ; ; ; ]]> ; (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) )) ; ; ; ; ; ; ]]> ; (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)) ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ]]> ; (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) )) ) ; ; ; ]]> ; (element genwarn (empty-sosofo)) ; ; ; ]]> ; (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))) )) ; ; ; ]]> ; (element gensec (process-children)) ; ; ; ]]> ; (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) ))) ; ; ; ]]> ; (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)) ; ; ; ; ; ]]> ; (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)) )) ; ; ; ; ; ; ]]> ; (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))) ; ; ; ; ]]> ; (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))) ; ; ; ]]> ; (element section (process-children)) ; ; ; ; ; ; ; ; ; ; ]]> ; (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) )))) ; ; ; ; ; ; ; ; ]]> ; (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))) ; ; ; ]]> ; (element p (make-default-paragraph)) (element lp (make paragraph space-before: text-size line-spacing: (* text-size 2) use: default-paragraph-style (process-children) )) ; ; ; ; ; ; ; ; ; ]]> ; (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)) ; ; ; ]]> ; (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) )) ) ; ; ; ; ; ; ]]> ; (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 "日") )) ; ; ; ; ; ; ; ]]> ; (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))) ; ; ; ; ; ; ; ]]> ; (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))) ; ; ; ; ]]> ; (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) )) ; ; ; ; ; ]]> ; (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") )) ; ; ; ; ]]> ; (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") )) ; ; ; ; ; ; ; ]]> ; ; 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)) ; ; ; ]]> ; (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) ))) ; ; ; ]]> ; (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)) ; ; ; ]]> ; (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) )) ; ; ; ]]> ; (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) )) ; ; ; ]]> ; (element q (make sequence (literal "'") (process-children) (literal "'") )) ; ; ; ; ]]> ; (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 ) )) ; ; ; ; ]]> ; (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)) ; ; ; ]]> ; ; jadeは、現状ではchar-upcaseをサポートしない。したがって、SGML解析系 ; がupper-case変換すると仮定する。 ; (element flmat (make sequence language: (attribute-string "langcode") (process-children) )) ; ; ; ]]> ; (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) )) ; ; ; ; ; ]]> ; (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) )) ; ; ; ; ; ; ; ; ]]> ; (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) )) ; ; ; ; ]]> ; ; ; 強調のためのパラメータ ; (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 ; フォント構造 )) (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)) ; ; ; ; ; ; ; ; ; ]]> ; (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) )) ; ; ; ; ; ; ; ]]> ; (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)) ; ; ; ; ; ; ]]> ; (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) )) ; ; ; ; ; ; ; ; ]]> ; (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) )) ; ; ; ; ]]> ; (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) )) ; ; ; ; ; ]]> ; (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) )) ; ; ; ; ]]> ; (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) ))) ; ; ; ; ; ]]> ; (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) )) ; ; ; ; ; ]]> ; (element tabbody (make sequence font-size: (if (attribute-string "pointsz") (* 1pt (string->number (attribute-string "pointsz"))) smaller-size) table-border: #t (process-children) )) ; ; ; ; ; ]]> ; (element arow (make table-row font-size: (if (attribute-string "pointsz") (* 1pt (string->number (attribute-string "pointsz"))) smaller-size) (process-children) )) ; ; ; ; ; ]]> ; (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) )) ; ; ; ]]> ; (element sc (process-children)) ; ; ; ; ; ]]> ; (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) )) ; ; ; ; ]]> ; (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")) ))) ]]> (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")) ))))