mirror of
				https://github.com/smarty-php/smarty.git
				synced 2025-10-31 04:11:37 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			383 lines
		
	
	
		
			9.7 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
			
		
		
	
	
			383 lines
		
	
	
		
			9.7 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
| ;; -*- Scheme -*-
 | |
| ;;
 | |
| ;; $Id$
 | |
| ;;
 | |
| 
 | |
| ;; Returns the depth of the auto-generated TOC (table of contents) that
 | |
| ;; should be made at the nd-level
 | |
| (define (toc-depth nd)
 | |
|   (if (string=? (gi nd) (normalize "book"))
 | |
|       3 ; the depth of the top-level TOC
 | |
|       1 ; the depth of all other TOCs
 | |
|       ))
 | |
| 
 | |
| 
 | |
| 
 | |
| 
 | |
| 
 | |
| 
 | |
| (element (funcdef function) 
 | |
|   ($bold-seq$
 | |
|    (make sequence
 | |
|      (process-children)
 | |
|      )
 | |
|    )
 | |
|   )
 | |
| 
 | |
| 
 | |
| (define (is-true-optional nl)
 | |
|   (and (equal? (gi (parent nl)) (normalize "parameter"))
 | |
|        (equal? 0 (string-length (strip (data (preced nl)))))
 | |
|        (equal? 0 (string-length (strip (data (follow nl)))))
 | |
|        )
 | |
|   )
 | |
| 
 | |
| 
 | |
| (define (has-true-optional nl)
 | |
|   (is-true-optional 
 | |
|    (node-list-first-element 
 | |
|     (select-elements 
 | |
|      (descendants nl) 
 | |
|      (normalize "optional"))
 | |
|     )
 | |
|    )
 | |
|   )
 | |
| 
 | |
| 
 | |
| (define (count-true-optionals nl)
 | |
|   (let loop 
 | |
|       ((result 0)
 | |
|        (nl (select-elements (descendants nl) (normalize "optional")))
 | |
|        )
 | |
|     (if(node-list-empty? nl)
 | |
|        result
 | |
|        (if(is-true-optional(node-list-first nl))
 | |
| 	  (loop (+ result 1) (node-list-rest nl))
 | |
| 	  (loop result (node-list-rest nl))
 | |
| 	  )
 | |
|        )
 | |
|     )
 | |
|   )
 | |
| 
 | |
| 
 | |
| ;; there are two different kinds of optionals
 | |
| ;; optional parameters and optional parameter parts
 | |
| ;; an optional parameter is identified by an optional tag
 | |
| ;; with a parameter tag as its parent 
 | |
| ;; and only whitespace between them
 | |
| (element optional 
 | |
|   ;;check for true optional parameter
 | |
|   (if (is-true-optional (current-node))
 | |
|       ;; yes - handle '[...]' in paramdef
 | |
|       (process-children-trim) 
 | |
|       ;; no - do '[...]' output
 | |
|       (make sequence
 | |
| 	(literal %arg-choice-opt-open-str%)
 | |
| 	(process-children-trim)
 | |
| 	(literal %arg-choice-opt-close-str%)
 | |
| 	)
 | |
|       )
 | |
|   )		
 | |
| 
 | |
| ;; now this is going to be tricky
 | |
| (element paramdef  
 | |
|   (make sequence
 | |
|     ;; special treatment for first parameter in funcsynopsis
 | |
|     (if (equal? (child-number (current-node)) 1)
 | |
| 	;; is first ?
 | |
| 	(make sequence
 | |
| 	  ;; start parameter list
 | |
| 	  (literal "(") 
 | |
| 	  ;; is optional ?
 | |
| 	  ( if (has-true-optional (current-node))
 | |
| 	       (literal %arg-choice-opt-open-str%)
 | |
| 	       (empty-sosofo)
 | |
| 	       )
 | |
| 	  )
 | |
| 	;; not first
 | |
| 	(empty-sosofo)
 | |
| 	)
 | |
|     
 | |
|     ;;
 | |
|     (process-children-trim)
 | |
|     
 | |
|     ;; special treatment for last parameter 
 | |
|     (if (equal? (gi (ifollow (current-node))) (normalize "paramdef"))					
 | |
| 	;; more parameters will follow
 | |
| 	(make sequence
 | |
| 	  ;; next is optional ?
 | |
| 	  ( if (has-true-optional (ifollow (current-node)))
 | |
| 	       ;; optional
 | |
| 	       (make sequence
 | |
| 		 (literal " ")
 | |
| 		 (literal %arg-choice-opt-open-str%)
 | |
| 		 )
 | |
| 	       ;; not optional
 | |
| 	       (empty-sosofo)
 | |
| 	       )
 | |
| 	  (literal ", " )				 				 
 | |
| 	  )
 | |
| 	;; last parameter
 | |
| 	(make sequence
 | |
| 	  (literal 
 | |
| 	   (let loop ((result "")(count (count-true-optionals (parent (current-node)))))
 | |
| 	     (if (<= count 0)
 | |
| 		 result
 | |
| 		 (loop (string-append result %arg-choice-opt-close-str%)(- count 1))
 | |
| 		 )
 | |
| 	     )
 | |
| 	   )
 | |
| 	  ( literal ")" )
 | |
| 	  )
 | |
| 	)
 | |
|     )
 | |
|   )
 | |
| 
 | |
| 
 | |
| (element function
 | |
|   (let* ((function-name (data (current-node)))
 | |
| 	 (linkend 
 | |
| 	  (string-append
 | |
| 	   "function." 
 | |
| 	   (string-replace
 | |
| 	    (string-replace function-name "_" "-")
 | |
| 	    "::" ".")))
 | |
| 	 (target (element-with-id linkend))
 | |
| 	 (parent-gi (gi (parent))))
 | |
|     (cond
 | |
|      ;; function names should be plain in FUNCDEF
 | |
|      ((equal? parent-gi "funcdef")
 | |
|       (process-children))
 | |
|      
 | |
|      ;; if a valid ID for the target function is not found, or if the
 | |
|      ;; FUNCTION tag is within the definition of the same function,
 | |
|      ;; make it bold, add (), but don't make a link
 | |
|      ((or (node-list-empty? target)
 | |
| 	  (equal? (case-fold-down
 | |
| 		   (data (node-list-first
 | |
| 			  (select-elements
 | |
| 			   (node-list-first
 | |
| 			    (children
 | |
| 			     (select-elements
 | |
| 			      (children
 | |
| 			       (ancestor-member (parent) (list "refentry")))
 | |
| 			      "refnamediv")))
 | |
| 			   "refname"))))
 | |
| 		  function-name))
 | |
|       ($bold-seq$
 | |
|        (make sequence
 | |
| 	 (process-children)
 | |
| 	 (literal "()"))))
 | |
|      
 | |
|      ;; else make a link to the function and add ()
 | |
|      (else
 | |
|       (make element gi: "A"
 | |
| 	    attributes: (list
 | |
| 			 (list "HREF" (href-to target)))
 | |
| 	    ($bold-seq$
 | |
| 	     (make sequence
 | |
| 	       (process-children)
 | |
| 	       (literal
 | |
| 		)
 | |
| 	       (literal "()"))))))))
 | |
| 
 | |
| (element command
 | |
|   (let* ((command-name (data (current-node)))
 | |
| 	 (linkend 
 | |
| 	  (string-append
 | |
| 	   "language.function." 
 | |
| 	   (string-replace
 | |
| 	    (string-replace command-name "_" ".")
 | |
| 	    "::" ".")))
 | |
| 	 (target (element-with-id linkend))
 | |
| 	 (parent-gi (gi (parent))))
 | |
|     (cond
 | |
|      ;; function names should be plain in FUNCDEF
 | |
|      ((equal? parent-gi "funcdef")
 | |
|       (process-children))
 | |
|      
 | |
|      ;; if a valid ID for the target function is not found, or if the
 | |
|      ;; FUNCTION tag is within the definition of the same function,
 | |
|      ;; make it bold, add (), but don't make a link
 | |
|      ((or (node-list-empty? target)
 | |
| 	  (equal? (case-fold-down
 | |
| 		   (data (node-list-first
 | |
| 			  (select-elements
 | |
| 			   (node-list-first
 | |
| 			    (children
 | |
| 			     (select-elements
 | |
| 			      (children
 | |
| 			       (ancestor-member (parent) (list "refentry")))
 | |
| 			      "refnamediv")))
 | |
| 			   "refname"))))
 | |
| 		  command-name))
 | |
|       ($bold-seq$
 | |
|        (make sequence
 | |
| 	 (literal "{")
 | |
| 	 (process-children)
 | |
| 	 (literal "}"))))
 | |
|      
 | |
|      ;; else make a link to the function and add ()
 | |
|      (else
 | |
|       (make element gi: "A"
 | |
| 	    attributes: (list
 | |
| 			 (list "HREF" (href-to target)))
 | |
| 	    ($bold-seq$
 | |
| 	     (make sequence
 | |
|            (literal "{")
 | |
| 	       (process-children)
 | |
| 	       (literal "}"))))))))
 | |
| 
 | |
| (element classname
 | |
|   (let* ((class-name (data (current-node)))
 | |
| 	 (linkend 
 | |
| 	  (string-append
 | |
| 	   "class." 
 | |
| 	    (string-replace
 | |
| 	     (case-fold-down class-name) "_" "-")))
 | |
| 	 (target (element-with-id linkend))
 | |
| 	 (parent-gi (gi (parent))))
 | |
|     (cond
 | |
|      ;; function names should be plain in SYNOPSIS
 | |
|      ((equal? parent-gi "synopsis")
 | |
|       (process-children))
 | |
|      
 | |
|      ;; if a valid ID for the target class is not found, or if the
 | |
|      ;; CLASSNAME tag is within the definition of the same class,
 | |
|      ;; make it bold, but don't make a link
 | |
|      ((or (node-list-empty? target)
 | |
| 	  (equal? (case-fold-down
 | |
| 		   (data (node-list-first
 | |
| 			  (select-elements
 | |
| 			   (node-list-first
 | |
| 			    (children
 | |
| 			     (select-elements
 | |
| 			      (children
 | |
| 			       (ancestor-member (parent) (list "refentry")))
 | |
| 			      "refnamediv")))
 | |
| 			   "refname"))))
 | |
| 		  class-name))
 | |
|       ($bold-seq$
 | |
|        (process-children)))
 | |
|      
 | |
|      ;; else make a link to the function and add ()
 | |
|      (else
 | |
|       (make element gi: "A"
 | |
| 	    attributes: (list
 | |
| 			 (list "HREF" (href-to target)))
 | |
| 	    ($bold-seq$
 | |
| 	     (process-children)))))))
 | |
| 
 | |
| 
 | |
| (element constant
 | |
|   (let* ((constant-name (data (current-node)))
 | |
| 	 (linkend 
 | |
| 	  (string-append "constant." 
 | |
| 			 (case-fold-down
 | |
| 			  (string-replace constant-name "_" "-"))))
 | |
| 	 (target (element-with-id linkend))
 | |
| 	 (parent-gi (gi (parent))))
 | |
|     (cond
 | |
| ;     ;; constant names should be plain in FUNCDEF
 | |
| ;     ((equal? parent-gi "funcdef")
 | |
| ;      (process-children))
 | |
|      
 | |
|      ;; if a valid ID for the target constant is not found, or if the
 | |
|      ;; CONSTANT tag is within the definition of the same constant,
 | |
|      ;; make it bold, add (), but don't make a link
 | |
|      ((or (node-list-empty? target)
 | |
| 	  (equal? (case-fold-down
 | |
| 		   (data (node-list-first
 | |
| 			  (select-elements
 | |
| 			   (node-list-first
 | |
| 			    (children
 | |
| 			     (select-elements
 | |
| 			      (children
 | |
| 			       (ancestor-member (parent) (list "refentry")))
 | |
| 			      "refnamediv")))
 | |
| 			   "refname"))))
 | |
| 		  constant-name))
 | |
|       ($bold-mono-seq$
 | |
|        (process-children)))
 | |
|      
 | |
|      ;; else make a link to the function and add ()
 | |
|      (else
 | |
|       (make element gi: "A"
 | |
| 	    attributes: (list
 | |
| 			 (list "HREF" (href-to target)))
 | |
| 	    ($bold-mono-seq$
 | |
| 	     (process-children)))))))
 | |
| 
 | |
| 
 | |
| (element example
 | |
|   (make sequence
 | |
|     (make element gi: "TABLE"
 | |
| 	  attributes: (list
 | |
| 		       (list "WIDTH" "100%")
 | |
| 		       (list "BORDER" "0")
 | |
| 		       (list "CELLPADDING" "0")
 | |
| 		       (list "CELLSPACING" "0")
 | |
| 		       (list "CLASS" "EXAMPLE"))
 | |
| 	  (make element gi: "TR"
 | |
| 		(make element gi: "TD"
 | |
| 		      ($formal-object$))))))
 | |
| 
 | |
| 
 | |
| (element (paramdef parameter)
 | |
|   (make sequence
 | |
|     font-posture: 'italic                                                       
 | |
|     (process-children-trim)
 | |
|     )
 | |
|   )                                                       
 | |
| 
 | |
| (mode book-titlepage-recto-mode
 | |
|   (element authorgroup
 | |
|     (process-children))
 | |
| 	
 | |
|   (element author
 | |
|     (let ((author-name  (author-string))
 | |
|           (author-affil (select-elements (children (current-node)) 
 | |
|                                          (normalize "affiliation"))))
 | |
|       (make sequence      
 | |
|         (make element gi: "DIV"
 | |
|               attributes: (list (list "CLASS" (gi)))
 | |
|               (literal author-name))
 | |
|         (process-node-list author-affil))))
 | |
| 	)
 | |
| 
 | |
| (define (chunk-element-list)
 | |
|   (list (normalize "preface")
 | |
|         (normalize "chapter")
 | |
|         (normalize "appendix")
 | |
|         (normalize "article")
 | |
|         (normalize "glossary")
 | |
|         (normalize "bibliography")
 | |
|         (normalize "index")
 | |
|         (normalize "colophon")
 | |
|         (normalize "setindex")
 | |
|         (normalize "reference")
 | |
|         (normalize "refentry")
 | |
|         (normalize "part")
 | |
|         (normalize "sect1")
 | |
|         (normalize "sect2")
 | |
|         (normalize "section")
 | |
|         (normalize "book") ;; just in case nothing else matches...
 | |
|         (normalize "set")  ;; sets are definitely chunks...
 | |
|         ))
 | |
| 
 | |
| (define ($section-body$)
 | |
|   (make element gi: "DIV"
 | |
|         attributes: (list (list "CLASS" (gi)))
 | |
|         ($section-separator$)
 | |
|         ($section-title$)
 | |
| 
 | |
|         (if (or (not (node-list-empty? (select-elements (children (current-node))
 | |
|                                                     (normalize "sect2"))))
 | |
| 				(not (node-list-empty? (select-elements (children (current-node))
 | |
|                                                     (normalize "sect3")))))
 | |
|             (build-toc (current-node) 1)
 | |
|             (empty-sosofo))
 | |
| 
 | |
|         (process-children)))
 | |
| 
 |