;; -*- Scheme -*-
;;
;; $Id: common.dsl.in,v 1.3 2002/02/04 16:46:23 hholzgra Exp $
;;
;; This file contains stylesheet customization common to the HTML
;; and print versions.
;;

;; Stylesheets Localization
(define %default-language% "@LANG@")

(define %root-filename% "index")
(define %use-id-as-filename% #t)
(define %gentext-nav-tblwidth% "100%")
(define %refentry-function% #t)
(define %refentry-generate-name% #f)
(define %funcsynopsis-style% 'ansi)
(define ($legalnotice-link-file$ legalnotice)
  (string-append "copyright" %html-ext%))
(define %generate-legalnotice-link% #t)
(define %footnotes-at-end% #t)
(define %force-chapter-toc% #t)
(define newline "\U-000D")
(define %number-programlisting-lines% #f)
(define %linenumber-mod% 1)
(define %shade-verbatim% #t)
(define %prefers-ordinal-label-name-format% @NUMBER_FIRST@)
(define ($generate-book-lot-list$) (list))

(define %gentext-ja-edited-by% "Edited by")

(define (php-code code)
  (make processing-instruction
    data: (string-append "php " code "?")))

(define quicksort
  (quicksort::generic null? car cdr append cons '()))

(define nl-quicksort
  (quicksort::generic node-list-empty?
		      node-list-first
		      node-list-rest
		      node-list
		      node-list
		      (empty-node-list)))

(define quicksort::generic
  (lambda(is-null? first others concat add empty)
    (letrec ((collect
	;; Collect is an helper function doing the real work

	      (lambda (pivot ls lgroup rgroup less?)
		(if (is-null? ls)
		    (concat (impl lgroup less?)
			    (add pivot (impl rgroup less?)))
		    (if (less? pivot (first ls))
			(collect pivot (others ls) lgroup 
				 (add (first ls) rgroup) 
				 less?)
			(collect pivot (others ls) 
				 (add (first ls) lgroup) 
				 rgroup 
				 less?)))))
	     (impl	
	      ;; impl first test some trivial sorting case and then call
	      ;; the procedure collect
	      (lambda (ls less?)	
		(if (or (is-null? ls) (is-null? (others ls)))
		    ls
		    (collect (first ls) (others ls) empty empty less?)))))
	;; we return the new defined procedure
      impl)))

;; definition for japanese

(define ja-chapter-name	"\U-7B2C;")
(define ja-sect1-name	"\U-7B2C;")
(define ja-sect2-name	"\U-7B2C;")
(define ja-section-name	"\U-7B2C;")
(define ja-figure-name	"Figure ")
(define ja-refsynopsisdiv-name "Synopsis")

(define (ja-label-title-sep)
  (list
   (list (normalize "chapter")		" \U-7AE0; ")
   (list (normalize "sect1")		". ")
   (list (normalize "sect2")		". ")
   (list (normalize "section")		". ")
   ))

(define (gentext-ja-label-title-sep gind)
  (let* ((giname (if (string? gind) gind (gi gind)))
	 (name   (normalize giname))
	 (sep    (assoc name (ja-label-title-sep))))
    (if sep
	(car (cdr sep))
	"")))

;; Polish definitions

(define (gentext-pl-nav-next next)
  (make sequence (literal "Nast\U-0119;pny")))

(define (book-titlepage-recto-elements)
  (list (normalize "title")
	(normalize "subtitle")
	(normalize "graphic")
	(normalize "mediaobject")
	(normalize "corpauthor")
	(normalize "authorgroup")
	(normalize "author")
	(normalize "editor")
        (normalize "pubdate")
	(normalize "copyright")
	(normalize "abstract")
	(normalize "legalnotice")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; render function prototypes, esp. with optional arguments
;;;; for new docbook4 methodsynopsis tag and friends
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; helper function generating closing optional brackets
(define (methodsynopsis-generate-closing-optionals nl)
  (if (node-list-empty? nl)
      (empty-sosofo) ;; empty list -> do nothing
      (make sequence ;; process list node
        (if (attribute-string (normalize "choice") (node-list-first nl))
            (if (string=? "opt" (attribute-string (normalize "choice") (node-list-first nl)))
                (literal %arg-choice-opt-close-str%) ;; is optional parameter -> close a bracket
                (empty-sosofo)
                )         
            (empty-sosofo)
            )         
        (methodsynopsis-generate-closing-optionals (node-list-rest nl)) ;; process rest of list
        )
      )
  )
  
;; render methodsynopsis
(element methodsynopsis 
	(make sequence 
    (process-children) ;; render content
    (methodsynopsis-generate-closing-optionals (children (current-node))) ;; close optional brackets
    (literal ")") ;; close parameter list
    )
)

;; render return type
(element (methodsynopsis type)
	(make sequence 
		(process-children-trim)
		(literal " ")
		)
)

;; render function name
(element (methodsynopsis methodname)
	(make sequence
		($bold-seq$
		 (process-children-trim)
		 )
		(literal " ( ") ;; start parameter list
		)
	)

;; render parameters
(element (methodsynopsis methodparam)
	(make sequence 
    ;; special case -> first parameter is optional
    (if (equal? (gi (ipreced (current-node))) (normalize "methodparam"))
        (empty-sosofo) ;; have prev. parameters -> is not first
        (if  (equal? (attribute-string (normalize "choice")) "opt")
             (literal %arg-choice-opt-open-str%) ;; generate opening bracket
             (empty-sosofo) 
             )
        )

		(process-children-trim)

    ;; have more parameters following me?
    (if (equal? (gi (ifollow (current-node))) (normalize "methodparam"))
        (make sequence
          ;; is next parameter optional?
          (if  (equal? (attribute-string (normalize "choice") (ifollow (current-node))) "opt")
               (make sequence 
                 (literal " ")
                 (literal %arg-choice-opt-open-str%)
                 )
               (empty-sosofo)
               )
          ;; parameter list separator
          (literal ", ")
          )
        (empty-sosofo)
        )
    )
  )

(element (methodsynopsis void)
	(literal "void")
)

  
;; render parameter type
(element (methodparam type)
	(make sequence 
		(process-children-trim)
		(literal " ")
		)
	)

;; render parameter name
(element (methodparam parameter)
	(make sequence
		(process-children-trim)
		)
	)