From fc42fe56a57eace2dbdb31574c2e161f0eacf839 Mon Sep 17 00:00:00 2001 From: Ludovic Court`es Date: Wed, 15 Jun 2005 13:00:39 +0000 Subject: 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 --- doc/skr/extension.skr | 95 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 95 insertions(+) create mode 100644 doc/skr/extension.skr (limited to 'doc/skr/extension.skr') diff --git a/doc/skr/extension.skr b/doc/skr/extension.skr new file mode 100644 index 0000000..ce10ce7 --- /dev/null +++ b/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)) -- cgit v1.2.3