Initial import of Skribe 1.2d.

Initial import of Skribe 1.2d.


git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--base-0

1 files changed, 95 insertions, 0 deletions

diff --git a/skribe/doc/skr/extension.skr b/skribe/doc/skr/extension.skr
new file mode 100644
index 0000000..ce10ce7
--- /dev/null
+++ b/skribe/doc/skr/extension.skr
@@ -0,0 +1,95 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/doc/skr/extension.skr                */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Tue Dec 23 07:18:36 2003                          */
+;*    Last change :  Fri Jan  2 21:25:49 2004 (serrano)                */
+;*    Copyright   :  2003-04 Manuel Serrano                            */
+;*    -------------------------------------------------------------    */
+;*    The Skribe package for documenting extensions                    */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    extension                                                        */
+;*---------------------------------------------------------------------*/
+(define-markup (extension #!rest opt 
+			  #!key (ident (symbol->string (gensym 'extension)))
+			  (class "extension")
+			  title html-title ending author description 
+			  (env '()))
+   (new document
+      (markup 'extension)
+      (ident ident)
+      (class class)
+      (options (the-options opt))
+      (body (the-body opt))
+      (env (append env
+		   (list (list 'example-counter 0) (list 'example-env '())
+			 (list 'chapter-counter 0) (list 'chapter-env '())
+			 (list 'section-counter 0) (list 'section-env '())
+			 (list 'footnote-counter 0) (list 'footnote-env '())
+			 (list 'figure-counter 0) (list 'figure-env '()))))))
+		  
+;*---------------------------------------------------------------------*/
+;*    html engine                                                      */
+;*---------------------------------------------------------------------*/
+(let ((he (find-engine 'html)))
+   (engine-custom-set! he 'web-book-main-browsing-extra 
+      (lambda (n e)
+	 (let ((i (let ((m (find-markup-ident "Index")))
+		     (and (pair? m) (car m)))))
+	    (if (not i)
+		(table :width 100. :border 0 :cellspacing 0 :cellpadding 0
+		   (tr (td :align 'left :valign 'top (bold "Skribe: "))
+		      (td :align 'right :valign 'top
+			 (ref :url *skribe-dir-doc-url* 
+			    :text "Directory")))
+		   (tr (td)
+		      (td :align 'right :valign 'top
+			 (ref :url *skribe-user-doc-url* 
+			    :text "User Manual"))))
+		(table :width 100. :border 0 :cellspacing 0 :cellpadding 0
+		   (tr (td :align 'left :valign 'top (bold "index:"))
+		      (td :align 'right (ref :handle (handle i))))
+		   (tr (td :align 'left :valign 'top (bold "Skribe: "))
+		      (td :align 'right :valign 'top
+			 (ref :url *skribe-dir-doc-url* 
+			    :text "Directory")))
+		   (tr (td)
+		      (td :align 'right :valign 'top
+			 (ref :url *skribe-user-doc-url* 
+			    :text "User Manual"))))))))
+   (default-engine-set! he))
+
+;*---------------------------------------------------------------------*/
+;*    extension-sui ...                                                */
+;*---------------------------------------------------------------------*/
+(define (extension-sui n e)
+   (define (sui)
+      (display "(sui \"")
+      (skribe-eval (markup-option n :title) html-title-engine)
+      (display "\"\n")
+      (printf "  :file ~s\n" (sui-referenced-file n e))
+      (printf "  :description ~s\n" (markup-option n :description))
+      (sui-marks n e)
+      (display "  )\n"))
+   (if (string? *skribe-dest*)
+       (let ((f (format "~a.sui" (prefix *skribe-dest*))))
+	  (with-output-to-file f sui))
+       (sui)))
+
+;*---------------------------------------------------------------------*/
+;*    project ...                                                      */
+;*---------------------------------------------------------------------*/
+(markup-writer 'extension
+   :options '(:title :html-title :ending :author :description)
+   :action (lambda (n e)
+	      (output n e (markup-writer-get 'document he)))
+   :after (lambda (n e)
+	     (if (engine-custom e 'emit-sui)
+		 (extension-sui n e))))
+
+;*---------------------------------------------------------------------*/
+;*    Restore the base engine                                          */
+;*---------------------------------------------------------------------*/
+(default-engine-set! (find-engine 'base))