; This file is made during the LAML configuration process - DO NOT EDIT!
;;;; .title Reference Manual of the LAML library ;;;; The file <kbd>laml.scm</kbd> is the very first laml file to load. ;;;; It contains a number of variable and functions which must be defined whenever LAML is used. ;;;; Some of the variables - the configuration variables - are defined via the LAML configuration process. ;;;; It also contains some very fundamental LAML stuff, including a number of top level commands that activate LAML tools. ;;;; Physically, laml.scm is composed of a tiny, configuration dependent file followed by the file laml-fundamental.scm. ;;;; These two files are documented together.<p> ;;;; ;;;; ;;;; <kbd>laml.scm</kbd> loads ;;;; the scheme/OS/platform specific compatibility file ;;;; and the <a href="../lib/man/general.html">general library</a> from the <kbd>lib</kbd> directory. ;;;; ;;;; ;;;; It is assumed that the value of the variable <kbd>laml-dir</kbd> is the full path of the LAML directory; ;;;; <kbd>laml-dir</kbd> must be defined when <kbd>laml.scm</kbd> is loaded, and the path must end in a "/". ;;;; The laml command prompt command and the LAML Emacs activation commands will take care of the definition of <kbd>laml-dir</kbd> for you.
; Physically, this file constitute the configuration dependent part. ; The configuration independent part are located in laml-fundamental.scm
; The LAML library and programs are written by Kurt Normark, Aalborg University, Denmark. ; Copyright (C) 1999-2006 Kurt Normark, normark@s.aau.dk. ; ; This program is free software; you can redistribute it and/or modify ; it under the terms of the GNU General Public License as published by ; the Free Software Foundation; either version 2 of the License, or ; (at your option) any later version. ; ; This program is distributed in the hope that it will be useful, ; but WITHOUT ANY WARRANTY; without even the implied warranty of ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ; GNU General Public License for more details. ; ; You should have received a copy of the GNU General Public License ; along with this program; if not, write to the Free Software ; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
;;; The configuration section. ;;; The configuration section is meant to be addapted in each new LAML installation. ;;; This section contains a few fundamental variables. The variables are defined via ;;; the configuration file in the laml-config directory. ;;; .section-id config-section
; --------------------------------------------------------------------------------------------------- ; CONFIGURATION SECTION

(define scheme-system 'mzscheme-200)
(define laml-platform 'unix)
(define operating-system 'linux)
(define laml-library "lib")
(define laml-version "Version 38.0 (November 14, 2011, full)") ; Determines how the laml processing is initiated. A symbol. ; rich: Information is transferred from the context such that the Scheme system knows the ; file name and the start-up directory. ; poor: No information is transferred from the context. ; We now always use the value rich - in reality this variable does not play a role any longer.
(define laml-activation 'rich) ; The default name of an LAML output file. ; In case laml-activation is 'rich we use the name of the laml file to determine the name of the html output file. ; In poor laml activation situations we use the value of the variable laml-default-output-file. ; A file name without initial path and without extension. ; This variable does not play a role any longer.
(define laml-default-output-file "default") ; The default directory of LAML output. ; In case laml-activation is 'rich we use the name of the startup directory ; (as returned by (startup-directory scheme-system) to determine this directory. ; The variable laml-default-output-directory is only used in case of poor laml-activation. ; This variable does not play a role any longer.
(define laml-default-output-directory "") ; The machine on which I use LAML-based software. ; This variable is not used any place in the LAML software, so *you* can forget about. ; I use it in the setup files of the LENO and course-plan systems. The variable allows ; me to find out on which machine I am running. Files, on which I rely, may be placed different ; places on different machines. ; Possible values: cs-unix, home-pc, thinkpad
(define computer-system 'cs-unix)
(define (begin-laml) ; Load the user's laml init file, if specified in the configuration file, and if the file exists.
(if (and (not (equal? "/user/normark/.laml" "false")) (file-exists? "/user/normark/.laml")) (load "/user/normark/.laml")))
(define end-laml-loading begin-laml)
(define laml-execution-mode 'fast) ; END CONFIGURATIONS.
; ---------------------------------------------------------------------------------------------------------------------------------------------------------
; ADDITIONAL LOADING
; Load the relevant LAML compatibility file.
(let ((laml-lib-comp-file (lambda (nm) (string-append laml-dir "lib/compatibility/" nm))) (comp-file (lambda (nm) (string-append laml-dir "lib/compatibility/" nm))) (schemesys-platform-os (string-append (symbol->string laml-platform) "_" (symbol->string operating-system) "_" (symbol->string scheme-system) ".scm")) (schemesys-platform-star (string-append (symbol->string laml-platform) "_" "star" "_" (symbol->string scheme-system) ".scm")) (schemesys-star-star (string-append "star" "_" "star" "_" (symbol->string scheme-system) ".scm")) ) (cond ((file-exists? (laml-lib-comp-file schemesys-platform-os)) (load (comp-file schemesys-platform-os))) ((file-exists? (laml-lib-comp-file schemesys-platform-star)) (load (comp-file schemesys-platform-star))) ((file-exists? (laml-lib-comp-file schemesys-star-star)) (load (comp-file schemesys-star-star))) (else (error (string-append "Compatibility loading: Cannot find compatibility file in lib/compatibility."))))) ; Load the general LAML library
(load (string-append laml-dir "lib/general.scm")) ; Load the configuration independent part of the fundamental LAML library.
(load (string-append laml-dir "laml-fundamental.scm")) (if (and (not (equal? "/user/normark/.laml" "false")) (file-exists? "/user/normark/.laml")) (load "/user/normark/.laml")); =>man/laml.sdoc
; The configuration independent part of the laml.scm. ; Loaded by laml.scm, and assumed to form the rear part of laml.scm.
; Yet another configuration feature

(define (laml-temp-file-path) (string-append laml-dir "temp/")) ; TIMING. ; In MzScheme we meassure the time used by LAML to process a document. ; The end-laml procedure reports on the elapsed time. ; We Start the timing here.
; start-laml-time is curretly only valid in mzscheme and guile. Units: System dependent.
(define start-laml-time (cond ((or (eq? scheme-system 'mzscheme) (eq? scheme-system 'mzscheme-200)) (current-process-milliseconds)) ((eq? scheme-system 'guile) (get-internal-run-time)) (else 0))) ; ---------------------------------------------------------------------------------------------------
; Other variables. ; This part of the laml.scm file contains some other variables. Most LAML users can ignore these. ; Taken out of the manual interface May 14, 2003.
; An alias of laml-dir. ; For backward compatibility. ; Some LAML applications change this variable to a more local directory.
(define software-directory laml-dir) ; An alias of laml-library. ; For backward compatibility
(define scheme-library laml-library) ; Full path to the scheme library. ; Normally the value of this variable is derived from laml-dir and laml-library. ; Ends in a slash.
(define the-library (string-append laml-dir laml-library "/")) ; A global variable which signals some kind of variations in the loading of a LAML style or library. ; If no load variation is present, the value of the variable will be #f. The interpretation of a non-false value ; is entirely up to a style or a library. ; The value of this variable is assigned by the style and laml-style form based on the last optional parameter of style or laml-style
(define laml-load-variation #f) ; An association list of languages and language maps. ; The variable is related to the xml-in-laml library.
(define xml-in-laml-languages-in-use '()) ; An association list of languages and XML navigator structures. ; Used for fast navigation in ASTs, guided by static information from the ; underlying DTD.
(define xml-in-laml-navigator-structures '()) ; An association list of languages and XML validation structures. ; Used for access to XML validation procedures given an element name.
(define xml-in-laml-validator-structures '()) ; An association list of languages and XML content model structures. ; Used for access to the XML content models at document generation or transformation time.
(define xml-in-laml-content-model-structures '()) ; As association list of languages and action procedure structures. ; A single action procedure structure of an XML language maps XML elements to action procedures of the language.
(define xml-in-laml-action-procedure-structures '()) ; --------------------------------------------------------------------------------------------------- ; Variables related to link checking. ; Belongs naturally in lib/xml-in-laml/xml-in-laml.scm, but located here ; in case xml-in-laml.scm becomes reloaded before end-laml is called.
; A list of relative url entries for later checing. Each entry is of the form (rel-url surrounding-absolute-file).
(define relative-url-list-for-later-checking '()) ; A list of absolute url entries for later checing. Each entry is a string (the absolute url).
(define absolute-url-list-for-later-checking '()) ; Internal global variable used for counting relative url linking problems
(define relative-url-problem-count 0) ; Internal global variable used for counting absolute url linking problems
(define absolute-url-problem-count 0) ; ---------------------------------------------------------------------------------------------------
;;; LAML version information. ;;; The functions in this section return information about the version of LAML that you have installed. ;;; The functions basically return the same information as the string laml-version. ;;; We provide these function to make the LAML version information available on a more convenient form than in ;;; in the string laml-version. The version information is taken from the file distribution-version.lsp in the ;;; root of the LAML distribution. Always use the functions in this section to access the version information. ;;; (Do not read and interpret the information in distribution-version.lsp directly). ;;; .section-id laml-version-functions

(define (laml-version-numbers) (let ((laml-version-info (file-read (string-append laml-dir "distribution-version.lsp")))) (list (car laml-version-info) (cadr laml-version-info))))
(define (laml-version-time) (let ((laml-version-info (file-read (string-append laml-dir "distribution-version.lsp")))) (car (cddr laml-version-info))))
(define (laml-version-kind) (let ((laml-version-info (file-read (string-append laml-dir "distribution-version.lsp")))) (as-string (car (cdr (cdr (cdr laml-version-info))))))) ; ---------------------------------------------------------------------------------------------------
;;; Library, style, tool, and local dir loading. ;;; The functions in this section loads LAML libraries and LAML styles. ;;; .section-id loading-section

(define (lib-load suffix-path) (load (string-append the-library suffix-path)))
(define (laml-tool-load suffix-path) (load (string-append laml-dir "tools/" suffix-path)))
(define (local-load suffix-path) (load (string-append (startup-directory) suffix-path))) ; Load a LAML style. ; .form (style style-spec [style-base load-variation]) ; .parameter style-spec The name of the style to load. A style-spec is without extension. However, the style file must have the scm extension. ; .parameter style-base: The directory which contains the style. If style-base is given it must be a directory (a slash terminated string) from which to load your style. If style-base is omitted, the style is loaded from styles subdirectory of the LAML directory. ; .parameter load-variation: A load-variation assigned to the global LAML variable laml-load-variation. ; .example (style "simple" #f 'xyz-variation) ; .example (style "manual" "manual/") ; .internal-references "also relevant" "laml-style"
(define (style style-spec . optional-parameters) (let ((original-load-variation laml-load-variation)) (let ((style-base (optional-parameter 1 optional-parameters)) (load-variation (optional-parameter 2 optional-parameters)) ) (set! laml-load-variation load-variation) (if style-base (load (string-append style-base style-spec ".scm")) (load (string-append software-directory "styles/" style-spec ".scm"))) (set! laml-load-variation original-load-variation))))
(define laml-style style) ; ---------------------------------------------------------------------------------------------------
;;; LAML contextual information. ;;; The functions in this section deal with the necessary context information, ;;; which must be passed to Scheme when we use LAML. ;;; .section-id context-section

(define (source-filename-without-extension . unused-parameter) (let ((cmd-line (laml-canonical-command-line))) (if cmd-line (cadr cmd-line) #f)))
(define (startup-directory . unused-parameter) (let ((cmd-line (laml-canonical-command-line))) (if cmd-line (caddr cmd-line) #f)))
(define (laml-program-parameters) (let ((cmd-line (laml-canonical-command-line))) (if (and cmd-line (>= (length cmd-line) 3)) (cadddr cmd-line) '())))
(define (laml-canonical-command-line) (error "laml-canonical-command-line is not defined in scheme-system dependent compatibility file"))
(define (fake-startup-parameters source-file startup-dir . program-parameters) (error "fake-startup-parameters is not defined in scheme-system dependent compatibility file"))
(define (fake-startup-parameters-prog-par-list source-file startup-dir program-parameter-list) (apply fake-startup-parameters (append (list source-file startup-dir) program-parameter-list)))
(define (set-laml-startup-directory dir) (let ((start-dir (startup-directory))) (let ((abs-dir (cond ((and (equal? ".." dir) start-dir (parent-directory start-dir)) (parent-directory start-dir)) ((and (not (absolute-file-path? dir)) start-dir) (string-append start-dir (ensure-final-character dir #\/))) ((absolute-file-path? dir) (ensure-final-character dir #\/)) (else (display-error (string-append "Use an absolute file path!!!")))))) (if (directory-exists? abs-dir) (begin (fake-startup-parameters-prog-par-list (source-filename-without-extension) abs-dir (laml-program-parameters)) (display-message (string-append "Using LAML in directory: " abs-dir))) (laml-error "Non-existing directory: " abs-dir)))))
(define (in-startup-directory . suffixes) (let ((suffix (accumulate-right string-append "" suffixes))) (string-append (startup-directory) suffix)))
(define (laml-source-file-path . optional-parameter-list) (let ((ext (optional-parameter 1 optional-parameter-list #f))) (in-startup-directory (source-filename-without-extension) (if ext (string-append "." ext) ""))))
(define (laml-cd dir) (set-laml-startup-directory dir))
(define (laml-pwd) (startup-directory))
(define (laml-ls) (directory-list (startup-directory)))
(define (set-laml-source-file file) (fake-startup-parameters-prog-par-list file (startup-directory) (laml-program-parameters)))
(define (set-laml-program-parameters program-parameters) (fake-startup-parameters-prog-par-list (source-filename-without-extension) (startup-directory) program-parameters))
(define (full-source-path-with-extension ext) (string-append (startup-directory) (source-filename-without-extension) "." ext)) ; ---------------------------------------------------------------------------------------------------
;;; Programmatic loading of laml files. ;;; Loading a LAML file invovles the setting of two pieces of context: The name of ;;; of the source file and the startup directory. The function laml-load sets these ;;; information and loads a file. ;;; .section-id prog-loading-section

(define (laml file-name . program-parameters) (let* ((init-path (file-name-initial-path file-name)) (extension (file-name-extension file-name)) (proper-name (file-name-proper file-name)) (init-path-1 (if (empty-string? init-path) (startup-directory) init-path)) (extension-1 (if (empty-string? extension) "laml" extension)) (proper-name-1 proper-name)) (if (and (empty-string? init-path) (not (startup-directory))) (error "Please use full file path or set the laml startup directory via set-laml-startup-directory")) (laml-load (string-append init-path-1 proper-name-1 "." extension-1) program-parameters)))
(define (laml-load full-file-path . optional-parameter-list) (let ((original-filename-without-extension (source-filename-without-extension)) (original-startup-dir (startup-directory)) (original-program-parameters (laml-program-parameters)) ) (let ((filename-without-extension (file-name-proper full-file-path)) (startup-dir (file-name-initial-path full-file-path)) (program-parameter-list (optional-parameter 1 optional-parameter-list '())) ) (fake-startup-parameters-prog-par-list filename-without-extension startup-dir program-parameter-list) (load full-file-path) ; restore originals
(if (and original-filename-without-extension original-startup-dir) (fake-startup-parameters-prog-par-list original-filename-without-extension original-startup-dir original-program-parameters))))) ; --------------------------------------------------------------------------------------------------- ; It turns out that the loading stuff in the next section relies on case sensitive reading. ; Therefore the compatibility loading is placed here.
; Loads the scheme-system specific compatibility file and the LAML general library. ; Try most specifics first: ; scheme-system and platform and operating-system ; scheme-system and platform and * ; scheme-system and * and *
(let ((laml-lib-comp-file (lambda (nm) (string-append laml-dir "lib/compatibility/" nm))) (comp-file (lambda (nm) (string-append "compatibility/" nm))) (schemesys-platform-os (string-append (symbol->string laml-platform) "_" (symbol->string operating-system) "_" (symbol->string scheme-system) ".scm")) (schemesys-platform-star (string-append (symbol->string laml-platform) "_" "star" "_" (symbol->string scheme-system) ".scm")) (schemesys-star-star (string-append "star" "_" "star" "_" (symbol->string scheme-system) ".scm")) ) (cond ((file-exists? (laml-lib-comp-file schemesys-platform-os)) (lib-load (comp-file schemesys-platform-os))) ((file-exists? (laml-lib-comp-file schemesys-platform-star)) (lib-load (comp-file schemesys-platform-star))) ((file-exists? (laml-lib-comp-file schemesys-star-star)) (lib-load (comp-file schemesys-star-star))) (else (error (string-append "Compatibility loading: Cannot find compatibility file in lib/compatibility."))))) ; ---------------------------------------------------------------------------------------------------
;;; Interactive tool activation. ;;; The procedures in this section activate LAML tools. ;;; It is recommended that you activate the commands from an interactive LAML (Scheme) prompt. ;;; From Emacs carry out the editor command <kbd> run-laml-interactively </kbd>.<p> ;;; All the commands below work relative to the LAML working directory, which is changed by the procedure ;;; <kbd> laml-cd </kbd>. Use the command <kbd> laml-pwd </kbd> to find out about the LAML working directory. ;;; .section-id interactive-tool-section
; Make documentation from a scheme source file. ; This procedure is meant to be called from a Scheme interpreter, in which LAML is loaded and available. ; The procedure utilizes the attributes, which are extracted from the introductory comment (the abstract comment) of the Scheme source file. ; .form (schemedoc scheme-source-file [commenting-style]) ; .parameter scheme-input-file The file name of the Scheme source file, including file extension.\ ; It can be an absolute file path.\ ; It can also be a simple file name (or relative file path) which is assumed to be relative to the so-called startup-directory of LAML. ; .parameter commenting-style One of the symbols multi-semicolon or documentation-mark. The default value is multi-semicolon. ; .reference "Further info" "LAML Tutorial section" "../tutorial/schemedoc/schemedoc.html" ; (define (schemedoc scheme-input-file . optional-parameter-list) ; (let* ((scheme-source-file (file-name-proper-and-extension scheme-input-file)) ; (commenting-style (as-symbol (optional-parameter 1 optional-parameter-list "multi-semicolon"))) ; (this-dir (if (absolute-file-path? scheme-input-file) (file-name-initial-path scheme-input-file) (startup-directory))) ; ) ; (display-message "The LAML Schemedoc tool...") ; (load (string-append software-directory "tools/schemedoc-extractor/schemedoc-extractor.scm")) ; (set! scheme-documentation-commenting-style commenting-style) ; ; (let* ( ; (doc-list (reverse (extract-documentation-from-scheme-file (string-append this-dir scheme-source-file)))) ; (destination-dir (string-append this-dir extracted-source-destination-delta)) ; (manual-title extracted-manual-title) ; (manual-author-info (list extracted-manual-author extracted-manual-affiliation )) ; (manual-abstract (if (empty-string? extracted-manual-abstract) "-" extracted-manual-abstract)) ; (manual-name-from-file (file-name-proper scheme-source-file)) ; (extracted-laml-resource-info extracted-laml-resource) ; (extracted-css-prestylesheet-info extracted-css-prestylesheet) ; (extracted-css-stylesheet-info extracted-css-stylesheet) ; (extracted-css-stylesheet-copying-info extracted-css-stylesheet-copying) ; (extracted-source-linking-info extracted-scheme-source-linking) ; ) ; ; (laml-style "xml-in-laml/schemedoc-2/schemedoc" (string-append laml-dir "styles/") 'conservative-xhtml-loading) ; ; (set! laml-manual-stuff (as-boolean extracted-laml-resource-info)) ; (set! the-manual-prestylesheet extracted-css-prestylesheet-info) ; (set! the-manual-stylesheet extracted-css-stylesheet-info) ; (set! copy-css-stylesheet? (as-boolean extracted-css-stylesheet-copying-info)) ; ; (set! css-stylesheet-schema 'local) ; (set! the-manual-title manual-title) ; (set! the-manual-author manual-author-info) ; (set! the-manual-abstract (if (not (empty-string? manual-abstract)) manual-abstract extracted-manual-abstract)) ; (set! manual-name manual-name-from-file) ; ; (set! manual-index-width-list (list 180 320 350)) ; (set! link-to-ep-source-program? (as-boolean extracted-source-linking-info)) ; ; (set! end-remark "This documentation has been extracted automatically from the Scheme source file.") ; ; (make-manual doc-list 'manual-from-scheme-file destination-dir (string-append this-dir scheme-source-file)) ; ; (display-message ; (string-append "DONE. The manual of " scheme-source-file " is located in " ; destination-dir manual-name ".html. ")) ; ; (display-message (string-append "The file " manual-name ".manlsp" " contains a useful internal format.")) ; ; )))

(define (schemedoc scheme-input-file . optional-parameter-list) (let* ((scheme-source-file (file-name-proper scheme-input-file)) (scheme-source-file-plus (file-name-proper-and-extension scheme-input-file)) (commenting-style (as-string (optional-parameter 1 optional-parameter-list "multi-semicolon"))) (this-dir (if (absolute-file-path? scheme-input-file) (file-name-initial-path scheme-input-file) (startup-directory))) (temp-script-source-name "temp-script.sdoc") (loading-prefix (string-append "(load (string-append laml-dir \"laml.scm\")) (laml-style \"xml-in-laml/schemedoc-2/schemedoc\")")) ) (display-message "The LAML Schemedoc tool...") ; Load SchemeDoc
(laml-style "xml-in-laml/schemedoc-2/schemedoc" (string-append laml-dir "styles/") 'conservative-xhtml-loading) ; Generate SchemeDoc LAML script
(let ((manual-ast (manual 'internal:run-action-procedure "false" (manual-front-matters 'documentation-commenting-style commenting-style 'manual-destination-name scheme-source-file ) (manual-from-scheme-file 'src scheme-input-file) ))) (write-text-file (string-append loading-prefix (xml-render-as-laml manual-ast)) (string-append this-dir temp-script-source-name))) ; Execute SchemeDoc LAML script
(laml (string-append this-dir temp-script-source-name)) ; Delete SchemeDoc LAML script
(delete-file (string-append this-dir temp-script-source-name)) (display-message (string-append "DONE. The SchemeDoc manual of " scheme-source-file-plus " has been generated.")) ))
(define (xml-dtd-manual dtd-path . optional-parameter-list) (let ((target-path (optional-parameter 1 optional-parameter-list (startup-directory))) (mirror-name-prefix (optional-parameter 2 optional-parameter-list "")) ) (laml-style "manual/manual" (string-append laml-dir "styles/") 'conservative-xhtml-loading) (let* ((language-name (file-name-proper dtd-path)) (doc-list (map (manual-extend 'description (string-append "An XML element as defined in the " language-name " XML DTD.")) (manual-from-parsed-dtd (file-read (string-append dtd-path "." "lsp")) mirror-name-prefix))) ) (set-manual-abstract (string-append "An automatically generated LAML manual of the " language-name " XML DTD.")) (set-manual-name language-name) (set-manual-title (string-append "The " language-name " XML DTD")) (make-manual (reverse doc-list) 'manual-from-xml-dtd target-path))))
(define (xml-dtd-parse dtd-file-name) (load (string-append laml-dir "tools/dtd-parser/dtd-parser-4.scm")) (parse-dtd dtd-file-name) )
(define (generate-xml-mirror parsed-dtd-file-name language-name . optional-parameter-list) (let ((action-element-list (optional-parameter 1 optional-parameter-list '()))) (load (string-append laml-dir "tools/xml-in-laml/xml-in-laml.scm")) (set! mirror-name (as-string language-name)) (set! action-elements action-element-list) (let ((dtd-file (file-name-proper parsed-dtd-file-name))) (generate-mirror (string-append parsed-dtd-file-name ".lsp") (string-append (startup-directory) dtd-file "." "scm") language-name) )))
(define (xml-parse-file in-file-name xml-language . optional-parameters) (let* ((this-dir (startup-directory)) (proper-file-name (file-name-proper in-file-name)) (ext (file-name-extension in-file-name)) (out-file-name (optional-parameter 1 optional-parameters #f)) (in-path (if (absolute-file-path? in-file-name) in-file-name (string-append this-dir proper-file-name (if (empty-string? ext) "" (string-append "." ext))))) (out-path (if out-file-name (string-append this-dir out-file-name) #f)) ) (load (string-append laml-dir "tools/xml-html-support/xml-support.scm")) (set! white-space-preserving-tags (if (memq (as-symbol xml-language) (languages-in-use)) (xml-preformatted-text-elements-in (as-symbol xml-language)) '())) (let ((ast (parse-xml-to-ast in-path xml-language))) (if (language-in-use? (as-symbol xml-language)) (begin (display-message "Validating AST") (validate-ast! ast (as-symbol xml-language))) (display-message "Validation not posssible. (Mirror of" xml-language "is not loaded).")) (if out-path (begin (if (file-exists? out-path) (delete-file out-path)) (let ((op (open-output-file out-path))) (write ast op) (close-output-port op) (display-message "AST written to" out-path))) ast))))
(define (xml-parse-string xml-string xml-language) (load (string-append laml-dir "tools/xml-html-support/xml-support.scm")) (set! white-space-preserving-tags (xml-preformatted-text-elements-in (as-symbol xml-language))) (let ((res (parse-xml-string-to-ast xml-string (as-symbol xml-language)))) (if (language-in-use? (as-symbol xml-language)) (begin (display-message "Validating AST") (validate-ast! res (as-symbol xml-language)) ) (display-message "Validation not possible (mirror of" xml-language "is not loaded)")) res))
(define (html-parse in-file-name . optional-parameters) (let* ((this-dir (startup-directory)) (proper-file-name (file-name-proper in-file-name)) (ext (file-name-extension in-file-name)) (out-file-name (optional-parameter 1 optional-parameters (string-append proper-file-name "." "lsp"))) (in-path (string-append this-dir proper-file-name (if (empty-string? ext) "" (string-append "." ext)))) (out-path (string-append this-dir out-file-name)) ) (load (string-append laml-dir "tools/xml-html-support/html-support.scm")) (parse-html-file in-path out-path)))
(define (xml-pp in-file-name . optional-parameters) (let* ((out-file-name (optional-parameter 1 optional-parameters in-file-name)) (single-lining (optional-parameter 2 optional-parameters #t)) (indentation (optional-parameter 3 optional-parameters 3)) (max-width (optional-parameter 4 optional-parameters 80)) (this-dir (startup-directory)) (proper-in-file-name (file-name-proper in-file-name)) (ext (file-name-extension in-file-name)) (in-file-path (string-append this-dir in-file-name)) (out-file-path (string-append this-dir out-file-name)) ) (load (string-append laml-dir "tools/xml-html-support/xml-support.scm")) (set! use-single-lining single-lining) (set! indentation-delta indentation) (set! prefered-maximum-width max-width) (write-text-file (pretty-print-xml-parse-tree (if (equal? ext "lsp") (file-read in-file-path) (parse-xml in-file-path))) out-file-path)))
(define (html-pp in-file-name . optional-parameters) (let* ((out-file-name (optional-parameter 1 optional-parameters in-file-name)) (single-lining (optional-parameter 2 optional-parameters #t)) (indentation (optional-parameter 3 optional-parameters 3)) (max-width (optional-parameter 4 optional-parameters 80)) (this-dir (startup-directory)) (proper-in-file-name (file-name-proper in-file-name)) (ext (file-name-extension in-file-name)) (in-file-path (string-append this-dir in-file-name)) (out-file-path (string-append this-dir out-file-name)) ) (load (string-append laml-dir "tools/xml-html-support/html-support.scm")) (set! use-single-lining single-lining) (set! indentation-delta indentation) (set! prefered-maximum-width max-width) (write-text-file (pretty-print-html-parse-tree (if (equal? ext "lsp") (file-read in-file-path) (parse-html in-file-path))) out-file-path)))
(define (bibtex file-name) (let ((this-dir (startup-directory)) (proper-file-name (file-name-proper file-name)) (ext (file-name-extension file-name)) ) (lib-load "collect-skip.scm") (lib-load "file-read.scm") (load (string-append laml-dir "tools/bibtex/bibtex.scm")) (lib-load "time.scm") (lib-load "color.scm") (lib-load "html4.0-loose/basis.scm") (lib-load "html4.0-loose/surface.scm") (lib-load "html4.0-loose/convenience.scm") (parse-bibtex-file (string-append this-dir proper-file-name)) (set! parse-result (reverse parse-result)) (write-text-file (page "Bibtex" (present-bibtex-entries parse-result (p))) (string-append this-dir proper-file-name ".html")) (display-message (string-append "The HTML output is in the file " (string-append this-dir proper-file-name ".html")))))
(define (scheme-pp in-file-name . optional-parameters) (let* ((out-file-name (optional-parameter 1 optional-parameters in-file-name)) (single-lining (optional-parameter 2 optional-parameters #t)) (indentation (optional-parameter 3 optional-parameters 3)) (max-width (optional-parameter 4 optional-parameters 80)) (this-dir (startup-directory)) (proper-in-file-name (file-name-proper in-file-name)) (ext (file-name-extension in-file-name)) (in-file-path (string-append this-dir in-file-name)) (out-file-path (string-append this-dir out-file-name)) (in-file-path-temp (string-append (laml-temp-file-path) proper-in-file-name "-" "temp!!!" "." ext)) ) (lib-load "file-read.scm") (load (string-append laml-dir "tools/schemedoc-extractor/schemedoc-extractor.scm")) (set! COMMENT-FORM-START (string-append "(comment!!! ")) (lib-load "scheme-pretty-printing.scm") (set! use-single-lining single-lining) (set! indentation-delta indentation) (set! prefered-maximum-width max-width) (lexical-to-syntactical-comments! in-file-path in-file-path-temp) (pretty-print-lisp-file in-file-path-temp out-file-path) (delete-file in-file-path-temp) ) )
(define (scheme-pp-simple in-file-name . optional-parameters) (let* ((out-file-name (optional-parameter 1 optional-parameters in-file-name)) (single-lining (optional-parameter 2 optional-parameters #t)) (indentation (optional-parameter 3 optional-parameters 3)) (max-width (optional-parameter 4 optional-parameters 80)) (this-dir (startup-directory)) (proper-in-file-name (file-name-proper in-file-name)) (ext (file-name-extension in-file-name)) (in-file-path (string-append this-dir in-file-name)) (out-file-path (string-append this-dir out-file-name)) ) (lib-load "file-read.scm") (lib-load "scheme-pretty-printing.scm") (set! use-single-lining single-lining) (set! indentation-delta indentation) (set! prefered-maximum-width max-width) (pretty-print-lisp-file in-file-path out-file-path) ) )
(define (html-to-laml in-file-name out-file-name) (let* ((this-dir (startup-directory)) (in-file-path (string-append this-dir in-file-name)) (out-file-path (string-append this-dir out-file-name)) ) (load (string-append laml-dir "tools/xml-html-support/html-support.scm")) (lib-load "scheme-pretty-printing.scm") (let* ((html-parse-tree (parse-html in-file-path))) (parse-tree-to-laml html-parse-tree out-file-path) (pretty-print-lisp-file out-file-path))))
(define (leno-xml leno-xml-file) (set-laml-source-file (file-name-proper leno-xml-file)) (laml-tool-load "xml-html-support/xml-support.scm") (display "Parsing XML file") (newline) (let* ((parse-tr (parse-xml (string-append (startup-directory) leno-xml-file))) (element-str (parse-tree-to-element-structure parse-tr))) (display "Parsing OK. LENO Processing starts.") (newline) (laml-style "lecture-notes/leno") (leno-xml-process element-str))) ; ---------------------------------------------------------------------------------------------------
;;; Language settings. ;;; .section-id language-section

(define language-preference 'english)
(define (text-choice danish english) (cond ((equal? language-preference 'english) english) ((equal? language-preference 'danish) danish) (else (error "Text: Problems in chosing language. Only 'english and 'danish are supported")))) ; ---------------------------------------------------------------------------------------------------
;;; LAML home URL and directories. ;;; The home directory of LAML is always the value of the variable laml-dir, which is defined a LAML installation time. ;;; In this directories there are useful URL and directory functions related to the LAML home directory. ;;; .section-id home-url-section

(define laml-absolute-url-prefix "http://www.cs.aau.dk/~normark/scheme/distribution/laml/")
(define (laml-home-url-prefix . optional-parameter-list) (let ((extra-level (optional-parameter 1 optional-parameter-list 0)) (start-dir (optional-parameter 2 optional-parameter-list (startup-directory)))) (cond ((boolean? extra-level) laml-absolute-url-prefix) ((string? extra-level) extra-level) ((number? extra-level) (if start-dir (let ((dir-diff (directory-level-difference start-dir laml-dir))) (cond ((and dir-diff (number? dir-diff) (>= dir-diff 0)) (string-append (repeat-string "../" (+ dir-diff extra-level)))) (else laml-absolute-url-prefix))) laml-absolute-url-prefix)) (else (laml-error "laml-home-url: Problems with the type of extra-level parameter" extra-level)))))
(define (laml-dir-prefix . optional-parameter-list) (let ((dir (optional-parameter 1 optional-parameter-list (startup-directory)))) (let* ((normalized-dir (normalize-file-path dir)) (diff (directory-level-difference normalized-dir laml-dir)) ) (if diff (repeat-string "../" diff) laml-dir))))
(define (laml-local-url-prefix . optional-parameter-list) (let ((dir (optional-parameter 1 optional-parameter-list (startup-directory)))) (let* ((normalized-dir (normalize-file-path dir)) (diff (directory-level-difference normalized-dir laml-dir)) ) (if diff (repeat-string "../" diff) (string-append "file://" laml-dir)))))
(define (is-a-laml-directory? dir) (let ((dir-diff (directory-level-difference dir laml-dir))) (cond ((and (boolean? dir-diff) (not dir-diff)) #f) ((and (number? dir-diff) (< dir-diff 0)) #f) ((and (number? dir-diff) (>= dir-diff 0)) #t) (else (laml-error "is-a-laml-directory?: Should not happen:" dir-diff))))) ; ---------------------------------------------------------------------------------------------------
;;; Document prolog and epilog functions. ;;; This section contains definitions of document prolog and epilog functions. ;;; In addition, there are a number of more basic functions which return information about ;;; the document. Several of these return empty strings, and they intended to be redefined in other contexts. ;;; .section-id prolog-epilog-section

(define (standard-prolog . optional-parameter-list) (let ((language (optional-parameter 1 optional-parameter-list #f))) (string-append (document-type-declaration) (if (not (empty-string? (document-type-declaration))) (as-string #\newline) "") (copyright-clause) (if (not (empty-string? (copyright-clause))) (as-string #\newline) ""))))
(define (standard-epilog . optional-parameter-list) (let ((language (optional-parameter 1 optional-parameter-list #f))) (string-append (as-string #\newline) (laml-standard-comment) (as-string #\newline) (tracing-comment))))
(define (document-type-declaration . optional-parameter-list) (let ((language (optional-parameter 1 optional-parameter-list #f))) ""))
(define (copyright-clause) "")
(define (laml-standard-comment) (html-comment (string-append "Generated from a LAML source file. " laml-version ". " "LAML is designed and implemented by Kurt Nørmark, normark@cs.aau.dk. " ))) (define (html-comment comment) (string-append "<!-- " comment "-->"))
(define (tracing-comment) "") ; ---------------------------------------------------------------------------------------------------
;;; Cosmetic welcome, ending and copyright functions. ;;; .section-id welcome-section

(define (laml-welcome) (let ((vers (read-text-file (string-append laml-dir "distribution-version")))) (display (string-append "Welcome to LAML " vers ".")) (newline) (display "(C) Kurt Normark, Aalborg University, Denmark.") (newline) ))
(define (end-laml) (let ((time-diff (cond ((or (eq? scheme-system 'mzscheme) (eq? scheme-system 'mzscheme-200)) (- (current-process-milliseconds) start-laml-time)) ((eq? scheme-system 'guile) (inexact->exact (round (* (/ (- (get-internal-run-time) start-laml-time) internal-time-units-per-second) 1000)))) (else #f)))) (if time-diff (begin (display (string-append "LAML processing time: " (as-string time-diff) " milliseconds.")) (newline))) (display "End of LAML processing") (newline))) ; The original end-laml function. ; Used by other parts of LAML to get access to the original end-laml in laml.scm, for instance as part of redefining end-laml.
(define original-end-laml end-laml)
(define (credits system-dk system-eng . optional-parameter-list) (let* ((url (optional-parameter 1 optional-parameter-list #f)) (anchor-text (text-choice system-dk system-eng)) (anchor-clause (if url (a-tag url anchor-text) anchor-text)) ) (string-append (text-choice (con anchor-clause " er designet og programmeret af Kurt Nørmark (c), Aalborg Universitet, med brug af " (a-tag "http://www.cs.aau.dk/~normark/laml/" (font-color black "LAML")) " teknologi.") (con anchor-clause " is designed and programmed by Kurt Nørmark (c), Aalborg University, Denmark using " (a-tag "http://www.cs.aau.dk/~normark/laml/" (font-color black "LAML")) " technology.") ))))
(define (laml-power-icon . optional-parameter-list) (let ((extra-level (optional-parameter 1 optional-parameter-list 0)) (icon-size (as-symbol (optional-parameter 2 optional-parameter-list 'large))) ) (a 'href "http://www.cs.aau.dk/~normark/laml/" (img 'border "0" 'src (string-append (laml-home-url-prefix extra-level) (cond ((eq? icon-size 'large) "images/laml-power-icon-4.gif") ((eq? icon-size 'small) "images/laml-mini-icon-1.gif") (else (laml-error "laml-power-icon: third parameter must either be large or small")))) 'alt "Program Oriented Web Engineering - using LAML"))))
(define (laml-shortcut-icon laml-home-url-dir) (link 'rel "SHORTCUT ICON" 'href (string-append laml-home-url-dir "images/16-16-icon.ico")))
;;; XML file writing procedures. ;;; In this section we have a convenient and versatile function which can be used to write an XML expression in LAML to a text file. ;;; .section-id html-file-writing-section

(define (write-xml mode-0 xml-clause . optional-parameter-list) (let ((file-path-with-extension (optional-parameter 1 optional-parameter-list (full-source-path-with-extension "html"))) (mode (cond ((symbol? mode-0) mode-0) ((list? mode-0) (cond ((memq 'raw mode-0) 'raw) ((memq 'pp mode-0) 'pp) (else raw))))) (prolog? (cond ((list? mode-0) (cond ((memq 'prolog mode-0) #t) (else #f))) (else #f))) (epilog? (cond ((list? mode-0) (cond ((memq 'epilog mode-0) #t) (else #f))) (else #f))) ) (cond ((and (ast? xml-clause) (is-xml-ast? xml-clause) (eq? mode 'pp)) (if (file-exists? file-path-with-extension) (delete-file file-path-with-extension)) (if (not (eq? xml-link-checking 'none)) (collect-links-for-later-checking-in-ast! xml-clause file-path-with-extension)) (let* ((op (open-output-file file-path-with-extension))) (pretty-render-to-output-port (expand-procedural-content-items-in-ast xml-clause) op (if prolog? 'prolog #f) (if epilog? 'epilog #f)) (close-output-port op)) (write-xml-post-process! file-path-with-extension) 'done ) ((and (ast? xml-clause) (is-xml-ast? xml-clause) (eq? mode 'raw)) (if (file-exists? file-path-with-extension) (delete-file file-path-with-extension)) (if (not (eq? xml-link-checking 'none)) (collect-links-for-later-checking-in-ast! xml-clause file-path-with-extension)) (let* ((op (open-output-file file-path-with-extension))) (render-to-output-port (expand-procedural-content-items-in-ast xml-clause) op (if prolog? 'prolog #f) (if epilog? 'epilog #f)) (close-output-port op)) (write-xml-post-process! file-path-with-extension) 'done ) (else (laml-error "write-xml: Unsupported combination of xml-clause and writing mode" mode "Consider the procedure write-html."))))) ; Activate the XML post processor, as determined by the file extension of full-target-file-path-with-extension. ; Pass full-target-file-path-with-extension to the processor. ; Given an extension e, activate the function (string-append e "-" "process") if this name is bound in the current environment.
(define (write-xml-post-process! full-target-file-path-with-extension) (let* ((ext (file-name-extension full-target-file-path-with-extension)) (processor-symbol (as-symbol (string-append ext "-" "process"))) ) (cond ((bound? processor-symbol) ((eval-cur-env processor-symbol) full-target-file-path-with-extension)) (else 'do-nothing))))
(define (process-xml processing-specs file-path ast) (let ((init-path (file-name-initial-path file-path)) (proper-name (file-name-proper file-path))) (for-each (lambda (spec) (let ((ext (first spec)) (transformer (second spec)) (mode-symbols (cddr spec))) (write-xml mode-symbols (transformer ast) (string-append init-path proper-name "." ext)))) processing-specs )))
(define (write-html mode-0 html-clause . optional-parameter-list) (let ((file-path-with-extension (optional-parameter 1 optional-parameter-list (full-source-path-with-extension "html"))) (mode (cond ((symbol? mode-0) mode-0) ((list? mode-0) (cond ((memq 'raw mode-0) 'raw) ((memq 'pp mode-0) 'pp) (else raw))))) (prolog? (cond ((list? mode-0) (cond ((memq 'prolog mode-0) #t) (else #f))) (else #f))) (epilog? (cond ((list? mode-0) (cond ((memq 'epilog mode-0) #t) (else #f))) (else #f))) ) (cond ((and (ast? html-clause) (is-xml-ast? html-clause) (eq? mode 'pp)) (if (file-exists? file-path-with-extension) (delete-file file-path-with-extension)) (if (not (eq? xml-link-checking 'none)) (collect-links-for-later-checking-in-ast! html-clause file-path-with-extension)) (let* ((op (open-output-file file-path-with-extension))) (pretty-render-to-output-port (expand-procedural-content-items-in-ast html-clause) op (if prolog? 'prolog #f) (if epilog? 'epilog #f)) (close-output-port op)) ) ((and (ast? html-clause) (is-xml-ast? html-clause) (eq? mode 'raw)) (if (file-exists? file-path-with-extension) (delete-file file-path-with-extension)) (if (not (eq? xml-link-checking 'none)) (collect-links-for-later-checking-in-ast! html-clause file-path-with-extension)) (let* ((op (open-output-file file-path-with-extension))) (render-to-output-port (expand-procedural-content-items-in-ast html-clause) op (if prolog? 'prolog #f) (if epilog? 'epilog #f)) (close-output-port op)) ) ((and (ast? html-clause) (eq? mode 'pp)) ; non-xml ast - html4.01 presumably
(load (string-append laml-dir "tools/xml-html-support/html-support.scm")) (let ((transformer (compose pretty-print-html-parse-tree ast-to-parse-tree))) (write-text-file (prolog-epilog-envelope (transformer html-clause) prolog? epilog?) file-path-with-extension))) ((and (ast? html-clause) (eq? mode 'raw)) (if (file-exists? file-path-with-extension) (delete-file file-path-with-extension)) (let* ((op (open-output-file file-path-with-extension))) (render-to-output-port html-clause op (if prolog? 'prolog #f) (if epilog? 'epilog #f)) (close-output-port op)) ) ((and (string? html-clause) (eq? mode 'pp)) (load (string-append laml-dir "tools/xml-html-support/html-support.scm")) (let ((transformer (compose pretty-print-html-parse-tree parse-html-string))) (write-text-file (prolog-epilog-envelope (transformer html-clause) prolog? epilog?) file-path-with-extension))) ((and (string? html-clause) (eq? mode 'raw)) (write-text-file (prolog-epilog-envelope html-clause prolog? epilog?) file-path-with-extension)) (else (laml-error "write-html: Unsupported combination of html-clause and writing mode" mode))))) ; Is x an XML AST, such as an XHTML AST. ; Non-XML ASTs do not have a language indication as last elements. Therefore ; we can distinguish XML asts from older HTML asts by the number of elements in the ; list AST representation.
(define (is-xml-ast? x) (and (ast? x) ; hereby a proper list
(>= (length x) 6))) ; Surround html-text with the standard prolog and epilog, if signalled by the two boolean parameters. ; This function depends on the two parameterless functions standard-prolog and standard-epilog. ; .form (prolog-epilog-envelope html-text prolog? epilog? [language])
(define (prolog-epilog-envelope html-text prolog? epilog? . optional-parameter-list) (let ((language (optional-parameter 1 optional-parameter-list #f))) (let ((prolog-text (cond (prolog? (standard-prolog language)) (else ""))) (epilog-text (cond (epilog? (standard-epilog language)) (else ""))) ) (string-append prolog-text html-text epilog-text))))
;;; The HTML character transformation table. ;;; This table is used by the HTML rendering function to transliterate char data to ;;; textual contents, as to be shown in a browser. You can use this table to perform ;;; transformation of national characters to HTML character entities, and to perform ;;; other character transliterations. ;;; .section-id char-trans-section
; Depends on make-list from general.scm

(define html-char-transformation-table (list->vector (make-list 256 #t))) ; The html-char-transformation-table is initialized in lib/xml-in-laml/xml-in-laml.scm

(define (set-html-char-transformation-entry! transformation-table index new-entry) (vector-set! transformation-table index new-entry)) ; The actual mutations of the html character transformation table is done in the actual ; mirrors. The reason is that the HTML4 mirrors are less mature than the XHTML mirror with ; respect to character references. (The '&' character is not allowed to be character transformed ; in HTML4, but it need to be transformed in XHTML. See lib/xml-in-laml/xml-in-laml.scm and ; tools/validating-html-mirror-from-dtd/runtime/basic.scm).
; --------------------------------------------------------------------------------------------------- ; HTML char and text transformation using the html-char-transformation-table. ; html-char-transformation-table is defined in laml.scm, and possibly redefined in the .laml setup file.
; (define (html-text-transform str) ; (html-text-transform-1 str (string-length str) 0 '()) ; ) ; ; ; (define (html-text-transform-1 str str-lgt i res) ; (cond ((= i str-lgt) (list-to-string (reverse res) "")) ; (else (html-text-transform-1 str str-lgt (+ i 1) (cons (html-char-transform (string-ref str i)) res)))))

(define (html-char-transform char . optional-parameter-list) (let ((transformation-table (optional-parameter 1 optional-parameter-list html-char-transformation-table))) (let* ((n (char->integer char)) (res (if (and (>= n 0) (<= n 255)) (vector-ref transformation-table n) (char->string char))) ) (cond ((and (boolean? res) res) (char->string char)) ((string? res) res) ((and (boolean? res) (not res)) "") ((char? res) (char->string res)) ((and (integer? res) (>= res 0) (<= res 255)) (char->string (integer->char res))) (else (laml-error "html-char-transform: Unable to transform character: " char)))))) ; ---------------------------------------------------------------------------------------------------------------
;;; R4RS and R5RS Scheme knowledge. ;;; The section contains accessor and loading functions to R4RS and R5RS Scheme knowledge files. ;;; The Scheme knowledge files are located in the r4rs and the r5rs directories of the full LAML distribution. ;;; The r4rs and r5rs directories each hold a HTML version of the Scheme Report. ;;; Overall, a Scheme knowledge file is a mapping from syntax/procedure name to an URL in the Scheme Report. ;;; More precisely, a Scheme knowledge file is a list of entries, each of which ;;; contains the name of a Scheme form, the categorization of the form, and the URL of place, where form ;;; is described (in a compact format). Scheme knowledge files have extensions lsp. ;;; .section-id scheme-knowledge

(define (read-scheme-knowledge scheme-version) (let* ((scheme-version-number (cond ((number? scheme-version) scheme-version) ((and (symbol? scheme-version) (eq? scheme-version 'r4rs)) 4) ((and (symbol? scheme-version) (eq? scheme-version 'r5rs)) 5) (else (laml-error "read-scheme-knowledge: scheme-version must be an integer (4 or 5) or one of the symbols r4rs or r5rs:" scheme-version)))) ) (cond ((= scheme-version-number 4) (file-read (string-append laml-dir "r4rs/" "scheme-knowledge.lsp"))) ((= scheme-version-number 5) (file-read (string-append laml-dir "r5rs/" "scheme-knowledge.lsp"))) (else (laml-error (string-append "R" (as-string scheme-version-number) "RS") "is not supported.")))))
(define symbol-of-scheme-knowledge (make-selector-function 1 'symbol-of-scheme-knowledge))
(define category-of-scheme-knowledge (make-selector-function 2 'category-of-scheme-knowledge))
(define essentiality-of-scheme-knowledge (make-selector-function 3 'essentiality-of-scheme-knowledge))
(define file-number-of-scheme-knowledge (make-selector-function 4 'file-number-of-scheme-knowledge))
(define anchor-name-of-scheme-knowledge (make-selector-function 5 'anchor-name-of-scheme-knowledge))
(define (url-suffix-of-scheme-knowledge entry scheme-version) (let* ((scheme-version-number (cond ((number? scheme-version) scheme-version) ((and (symbol? scheme-version) (eq? scheme-version 'r4rs)) 4) ((and (symbol? scheme-version) (eq? scheme-version 'r5rs)) 5) (else (laml-error "url-suffix-of-scheme-knowledge: scheme-version must be an integer (4 or 5) or one of the symbols r4rs or r5rs:" scheme-version)))) (rnrs (cond ((= scheme-version-number 4) "r4rs") ((= scheme-version-number 5) "r5rs") (else (laml-error (string-append "r" (as-string scheme-version-number) "rs") "is not supported."))))) (if (>= (length entry) 5) (string-append rnrs "_" (as-string (file-number-of-scheme-knowledge entry)) (cond ((= scheme-version-number 4) ".htm") ((= scheme-version-number 5) ".html") (else (laml-error (string-append "r" (as-string scheme-version-number) "rs") "is not supported."))) "#" (anchor-name-of-scheme-knowledge entry)) #f)))
;;; Miscellaneous.

(define (kn-manual-settings . optional-parameter-list) (let ((abstract-clause (optional-parameter 1 optional-parameter-list #f))) (list (manual-author (copyright-owner "Kurt Nørmark") "normark@cs.aau.dk" ) (manual-affiliation "Department of Computer Science," "Aalborg University," "Denmark.") (if abstract-clause abstract-clause '()) (laml-library-source-linking) 'css-prestylesheet "compact" 'css-stylesheet "argentina" 'css-stylesheet-copying "true" ))) (define (kn-name) "Kurt Nørmark") (define (kn-affiliation) (text-choice "Institut for Datalogi, Aalborg Universitet" "Department of Computer Science, Aalborg University, Denmark")) (define (kn-home-url) "http://www.cs.aau.dk/~normark/") (define (kn-email-address) "normark@cs.aau.dk") (define (anchor-mail-prefix email-addr) (string-append "mailto:" email-addr))
(define (kn-xml-in-laml . optional-parameter-list) (let ((with-icon (optional-parameter 1 optional-parameter-list #f)) ) (if with-icon (table 'border "0" (tr (td 'width "20%" (div (char-ref "nbsp") (br) (kn-name) (br) (a 'href (anchor-mail-prefix (kn-email-address)) (kn-email-address)) (br) (a 'href (kn-home-url) (kn-home-url)) (br) )) (td 'width "70%" (div "")) (td 'width "10%" (laml-power-icon 0 'small)))) (div (char-ref "nbsp") (br) (kn-name) (br) (a 'href (anchor-mail-prefix (kn-email-address)) (kn-email-address)) (br) (a 'href (kn-home-url) (kn-home-url)) (br) ))))
(define (laml-library-source-linking) (append (map ; the LAML lib/ manuals
(lambda (key) (scheme-source-linking-manual (list 'key key) (list 'file-path (string-append (laml-dir-prefix) "lib/man/" key)) ) ) (list "cgi" "collect-skip" "color" "crypt" "encode-decode" "file-read" "final-state-automaton" "general" "time" "xhtml10-convenience") ) (map ; the LAML core library
(lambda (key) (scheme-source-linking-manual (list 'key key) (list 'file-path (string-append (laml-dir-prefix) "man/" key)) ) ) (list "laml") ) (map ; the XML-in-LAML library
(lambda (key) (scheme-source-linking-manual (list 'key key) (list 'file-path (string-append (laml-dir-prefix) "lib/xml-in-laml/man/" key)) ) ) (list "xml-in-laml") ) (map ; the XML-in-LAML library
(lambda (key) (scheme-source-linking-manual (list 'key key) (list 'file-path (string-append (laml-dir-prefix) "lib/xml-in-laml/mirrors/man/" key)) ) ) (list "xhtml10-transitional-mirror" "xhtml10-strict-mirror" "xhtml10-frameset-mirror") ) ))