;;; -*- Package: ALTER-USER; Mode: LISP; Base: 10; Syntax: Common-Lisp; -*-
(in-package "ALTER-USER")
;;; -------------------------------------------------------------------
;;; --- File:		gnrc.sty
;;; --- Created:	[krueger:19951109.0932CDT]
;;; --- Last Update:	[krueger:19951109.0932CDT]
;;; --- System:         DoME 4.01
;;; --- Version:        1.0
;;; ---
;;; --- This Alter module defines a "style-sheet" to be used by
;;; --- a formatter to apply formatting to an SGML document.
;;; ---
;;; --- A style sheet defines an operation that is used when processing an
;;; --- ELEMENT.
;;; ---
;;; --- This style sheet defines the "generic" style for documents.
;;; ---
;;; -------------------------------------------------------------------
;;; -------------------------------------------------------------------

;;; -------------------------------------------------------------------
;;; -------------------------------------------------------------------
;;; --- METHODS: modify
;;; --- NOTE:    Methods to modify the state of the context
;;; -------------------------------------------------------------------
(find-operation new-para)
(add-method (new-para (text-style) ts)
   (let ((new-style (copy ts))
	 (nfi (+ findent (* (/ 1 4) 72)))	; assume 72 dpi
	 (nsi (+ sindent (* (/ 1 4) 72))))
   (set-findent! new-style nfi)
   (set-sindent! new-style nsi)
   (set-sp-before! new-style 12)
   new-style))

(find-operation heading-font)
(add-method (heading-font (font-description) self sz)
   (let ((new-fd (copy self)))
     (set-size! new-fd sz)
     (set-bold! new-fd #t) ))
;;; -------------------------------------------------------------------
;;; -------------------------------------------------------------------
;;; --- METHODS: flow-counterpart
;;; --- NOTE:    These methods produce the formatted counterpart of html-nodes.
;;; -------------------------------------------------------------------
(find-operation map-from-generic)

(add-method (map-from-generic (generic-structure-node) self c)
  (process-children c map-from-generic self))

(add-method (map-from-generic (generic-head) self c)
   (process-children c map-from-generic self))

(add-method (map-from-generic (generic-body) self c)
   (show-progress-for-each "Formatting..."
			   (lambda (e)
			     (map-from-generic e c))
			   (children self)))

(add-method (map-from-generic (generic-title) self c)
   (let ((cs (current-style c))
	 (ns (copy (current-style c))))
     (set-current-style! c ns)
     (set-sp-before! ns 24)
     (set-sp-after! ns 24)
     (set-default-font! ns (heading-font (default-font ns) 24))
     (define-style c ns "Title")
     (start-para c)
     (process-children c map-from-generic self)
     (set-current-style! c cs)))

(add-method (map-from-generic (generic-date) self c)
   (let ((c-font (current-font c)))
     (set-sp-before! (current-style c) 72)
     (set-bold! c-font #f)
     (set-italic! c-font #t)
     (set-size! c-font 14)
     (start-para c)
     (process-children c map-from-generic self)))

(add-method (map-from-generic (generic-doc) self c)
   (set-current-font! c (copy (default-font c))) ; restore default font
   (reset-multilevel-counter c "H")              ; reset auto-numbering
   (process-children c map-from-generic self) )

(add-method (map-from-generic (generic-normal) self c)
   (let ((cs (current-style c)))
     (set-current-style! c (new-para cs c))
     (start-para c)
     (process-children c map-from-generic self)
     (set-current-style! c cs)))

(add-method (map-from-generic (sdata) self c)
   (put-string c (contents self)))

(add-method (map-from-generic (generic-heading1) self c)
   (let ((cs (current-style c))
	 (ns (copy (current-style c))))
     (set-current-style! c ns)
     (set-sp-before! ns 24)
     (set-withnext! ns #t)
     (set-default-font! ns (heading-font (default-font ns) 24))
     (define-style c ns "Heading1")
     (start-para c)
     (if (not (supports-native-paragraph-numbering? c))
	 (begin
	  (put-string c (next-multilevel-tag c 1 "." "H"))
	  (put-string c " ")))
     (process-children c map-from-generic self)
     (set-current-style! c cs)))

(add-method (map-from-generic (generic-heading2) self c)
   (let ((cs (current-style c))
	 (ns (copy (current-style c))))
     (set-current-style! c ns)
     (set-sp-before! ns 24)
     (set-withnext! ns #t)
     (set-default-font! ns (heading-font (default-font ns) 18))
     (define-style c ns "Heading2")
     (start-para c)
     (if (not (supports-native-paragraph-numbering? c))
	 (begin
	  (put-string c (next-multilevel-tag c 2 "." "H"))
	  (put-string c " ")))
     (process-children c map-from-generic self)
     (set-current-style! c cs)))

(add-method (map-from-generic (generic-heading3) self c)
   (let ((cs (current-style c))
	 (ns (copy (current-style c))))
     (set-current-style! c ns)
     (set-sp-before! ns 24)
     (set-withnext! ns #t)
     (set-default-font! ns (heading-font (default-font ns) 14))
     (define-style c ns "Heading3")
     (start-para c)
     (if (not (supports-native-paragraph-numbering? c))
	 (begin
	  (put-string c (next-multilevel-tag c 3 "." "H"))
	  (put-string c " ")))
     (process-children c map-from-generic self)
     (set-current-style! c cs)))

(add-method (map-from-generic (generic-heading4) self c)
   (let ((cs (current-style c))
	 (ns (copy (current-style c))))
     (set-current-style! c ns)
     (set-sp-before! ns 24)
     (set-withnext! ns #t)
     (set-default-font! ns (heading-font (default-font ns) 12))
     (define-style c ns "Heading4")
     (start-para c)
     (if (not (supports-native-paragraph-numbering? c))
	 (begin
	  (put-string c (next-multilevel-tag c 4 "." "H"))
	  (put-string c " ")))
     (process-children c map-from-generic self)
     (set-current-style! c cs)))

(add-method (map-from-generic (generic-heading5) self c)
   (let ((cs (current-style c))
	 (ns (copy (current-style c))))
     (set-current-style! c ns)
     (set-sp-before! ns 24)
     (set-withnext! ns #t)
     (set-default-font! ns (heading-font (default-font ns) 12))
     (set-italic! (default-font ns) #t)
     (define-style c ns "Heading5")
     (start-para c)
     (if (not (supports-native-paragraph-numbering? c))
	 (begin
	  (put-string c (next-multilevel-tag c 5 "." "H"))
	  (put-string c " ")))
     (process-children c map-from-generic self)
     (set-current-style! c cs)))

(add-method (map-from-generic (generic-heading6) self c)
   (let ((cs (current-style c))
	 (ns (copy (current-style c))))
     (set-current-style! c ns)
     (set-sp-before! ns 24)
     (set-withnext! ns #t)
     (set-default-font! ns (heading-font (default-font ns) 10))
     (set-bold! (default-font ns) #t)
     (define-style c ns "Heading6")
     (start-para c)
     (if (not (supports-native-paragraph-numbering? c))
	 (begin
	  (put-string c (next-multilevel-tag c 6 "." "H"))
	  (put-string c " ")))
     (process-children c map-from-generic self)
     (set-current-style! c cs)))

(add-method (map-from-generic (generic-heading7) self c)
   (let ((cs (current-style c))
	 (ns (copy (current-style c))))
     (set-current-style! c ns)
     (set-sp-before! ns 24)
     (set-withnext! ns #t)
     (set-default-font! ns (heading-font (default-font ns) 10))
     (set-italic! (default-font ns) #t)
     (define-style c ns "Heading7")
     (start-para c)
     (if (not (supports-native-paragraph-numbering? c))
	 (begin
	  (put-string c (next-multilevel-tag c 7 "." "H"))
	  (put-string c " ")))
     (process-children c map-from-generic self)
     (set-current-style! c cs)))

(add-method (map-from-generic (generic-appheading) self c)
   (heading-font (current-font c) 18)
   (set-sp-before! (current-style c) 24)
   (start-para c)
   (put-string c "Appendix: ")
   (process-children c map-from-generic self))

map-from-generic
