; This file is made during the LAML configuration process - DO NOT EDIT!
;;;; 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. ;;;; It also contains a number of top level commands that activate the LAML tools. ;;;; Some of the variables - the configuration variables - are defined via the LAML configuration process. ;;;; <kbd>laml.scm</kbd> loads the scheme/OS/platform specific compatibility file and ;;;; the <kbd>general.scm</kbd> file from the LAML library. ;;;; It also loads the LAML startup file, <kbd>.laml</kbd>, if this has been arranged in the configuration file at LAML installation time. ;;;; 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. ;;;; .title Reference Manual of the LAML library
; The LAML library and programs are written by Kurt Normark, Aalborg University, Denmark. ; Copyright (C) 1999 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
;; The Scheme system on which LAML depends (a symbol). ;; Possible values are: mzscheme, scm, guile, drscheme. ;; The value is frozen by the LAML configuration program.

(define scheme-system 'mzscheme-200)
;; The platform on which LAML is in use (a symbol). ;; Possible values are: windows, unix, mac. mac is not yet in use. ;; The value is frozen by the LAML configuration program.

(define laml-platform 'unix)
;; The operating system on which LAML is in use (a symbol). ;; Possible values on the windows platform: win98, win95, nt40, win2000. ;; Possible values on the unix platform: solaris-6, solaris-7, or linux. ;; The value is frozen by the LAML configuration program.

(define operating-system 'linux)
;; The scheme library relative to laml-dir. A string. ;; A single directory name (without ending slash). ;; The value is frozen by the LAML configuration program. ;; You can change this if you use an alternative or experimental LAML library.

(define laml-library "lib")
;; A variable that refers to the version of LAML, bound at LAML installation time. ;; .returns A string that contains the version number and a short description.

(define laml-version "Version 30.2 (December 10, 2005, 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 "") ; END CONFIGURATIONS.
; --------------------------------------------------------------------------------------------------- ; 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.
; 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) ; 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 an 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
;; Return a list of two integers: the LAML major version number and the LAML minor version number. ;; .returns A list of two integers: (major-version-number minor-version-number)

(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))))
;; Return the time stamp of this LAML distribution. ;; A number that represents the number of second elapsed since Jan 1, 1970. ;; Use the functions in the LAML time library to make good use of this number. ;; .reference "Useful time function" "time-decode" "../lib/man/time.html#time-decode" ;; .returns An integer.

(define (laml-version-time) (let ((laml-version-info (file-read (string-append laml-dir "distribution-version.lsp")))) (car (cddr laml-version-info))))
;; Return the kind of your current LAML distribution. ;; Currently we use the following kinds: full, slim, development. ;; .returns Either "full", "slim", "development" (a string).

(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))))))) ; ---------------------------------------------------------------------------------------------------
;;; Optional parameters in LAML software. ;;; In LAML version 14 and earlier we have been rather sloppy with respect to the handling of optional ;;; parameters of Scheme functions. From version 15 we have introduced the following simple support ;;; of optional parameters. Given the function <kbd>(lambda (r1 r2 . optional-parameters) ...)</kbd> the function ;;; <kbd>optional-parameter</kbd> (see below) is able to extract optional parameter number n. Non-used optional parameter can ;;; either be passed as the #f value (false in Scheme) or not passed at all. ;;; .section-id optional-parameter-section
;; Return element n of optional-parameter-list. The first element is number 1. ;; In Scheme the optional parameters are captured as a list after the required parameters: <kbd>(define f (x y . optional-parameter-list) ...)</kbd>. ;; Please notice that if you pass optional parameter number i, the optional parameters 1, 2, ..., i-1 must be passed explicitly. ;; If you explicitly pass the symbol non-passed-value, this function will always return the default value, default-value. ;; (This means, of course, that you cannot use the symbol non-passed-value as an 'ordinary value' in your program). ;; If no optional third parameter - default-value - is given to the function optional-parameter the value #f serves as the default default-value. ;; .form (optional-parameter n optional-parameter-list [default-value]) ;; .pre-condition optional-parameter-list is a proper list.

(define (optional-parameter n optional-parameter-list . optional-default-value) (let ((optional-default-value-1 (if (null? optional-default-value) #f (car optional-default-value)))) ; the old fashioned way of handling it...
(if (> n (length optional-parameter-list)) optional-default-value-1 (let ((candidate-value (list-ref optional-parameter-list (- n 1)))) (if (eq? candidate-value 'non-passed-value) optional-default-value-1 candidate-value))))) ; ---------------------------------------------------------------------------------------------------
;;; Library, style, tool, and local dir loading. ;;; The functions in this section loads LAML libraries and LAML styles. ;;; .section-id loading-section
;; Load file from the LAML library directory. ;; .parameter suffix-path The part of the library file name relative to the LAML library directory, including file extension.

(define (lib-load suffix-path) (load (string-append the-library suffix-path)))
;; Load a file from the LAML tool directory. ;; .parameter suffix-path The part of the tool file name relative to the LAML tool directory, including file extension.

(define (laml-tool-load suffix-path) (load (string-append laml-dir "tools/" suffix-path)))
;; Load file from the startup directory. ;; .parameter suffix-path The part of the file name relative to the LAML startup directory, including file extension. ;; .internal-references "related function " "startup-directory"

(define (local-load suffix-path) (load (string-append (startup-directory) suffix-path))) ; Load an 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))))
;; Load an LAML style. ;; .form (laml-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 full path 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 (laml-style "simple" #f 'xyz-variation) ;; .example (laml-style "manual" "manual/")

(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
;; If possible return the name of the LAML source file (without extension). ;; This is only possible if the information somehow is passed to the Scheme execuctable. ;; In cases where it is not possible to know the source file name, return #f. ;; Notice: The parameter is not used, and should be avoided. ;; In order to be backward compatible, however, we allow a dummy parameter. ;; .internal-references "similar function" "full-source-path-with-extension"

(define (source-filename-without-extension . unused-parameter) (let ((cmd-line (laml-canonical-command-line))) (if cmd-line (cadr cmd-line) #f)))
;; Return the directory in which LAML is started up. ;; If this information is not available return #f. ;; Notice: The parameter is not used, and should be avoided. ;; In order to be backward compatible, however, we allow a dummy parameter.

(define (startup-directory . unused-parameter) (let ((cmd-line (laml-canonical-command-line))) (if cmd-line (caddr cmd-line) #f)))
;; Return the list of program parameters passed to an activation of LAML. ;; If no program parameters are passed, the empty list is returned.

(define (laml-program-parameters) (let ((cmd-line (laml-canonical-command-line))) (if (and cmd-line (>= (length cmd-line) 3)) (cadddr cmd-line) '())))
;; Return the contextual command line information passed to LAML upon activation. ;; Returns a list of lenght three, or #f if no command line activation exists. ;; The first element must be the symbol laml. ;; Element number two must be the laml source file name (without extension and initial path). ;; Element number three must be a slash terminated directory in which the source file resides. ;; This function must be redefined in the scheme-system dependent compatibility file.

(define (laml-canonical-command-line) (error "laml-canonical-command-line is not defined in scheme-system dependent compatibility file"))
;; Fake the contextual startup parameters to a specific source file name and a specific startup directory. ;; As an optional parameter, a list of program parameters can be passed. ;; Both of the parameters must be strings, or the boolean value #f (in case the informations are unknown). ;; This function is useful for programmatic startup of LAML. ;; This function must be redefined in the scheme-system dependent compatibility file. ;; .form (fake-startup-parameters source-file startup-dir [program-parameter-list])

(define (fake-startup-parameters source-file startup-dir . optional-parameter-list) (error "fake-startup-parameters is not defined in scheme-system dependent compatibility file"))
;; Set the LAML startup directory to dir. ;; Dir can be a full path, "..", or a directory relative to the current laml startup directory. ;; This is specialized call to fake-startup-parameters with only directory information.

(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 (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)))))
;; Return a (full) path relative to the current startup-directory. ;; .internal-references "relevant function" "startup-directory"

(define (in-startup-directory suffix) (string-append (startup-directory) suffix))
;; Set the LAML startup directory to dir. ;; Dir can be a full path, "..", or a directory relative to the current laml startup directory. ;; A convenient and easy to remember alias to set-laml-startup-directory.

(define (laml-cd dir) (set-laml-startup-directory dir))
;; Returns the working LAML directory. ;; Similar to the UNIX command pwd. ;; An alias of the function startup-directory.

(define (laml-pwd) (startup-directory))
;; Returns a list of files and directories of the LAML startup directory (the current directory). ;; Similar to the UNIX command ls

(define (laml-ls) (directory-list (startup-directory)))
;; Set the LAML source file name (without extension) to file. ;; This is specialized call to fake-startup-parameters with only source file information.

(define (set-laml-source-file file) (fake-startup-parameters file (startup-directory) (laml-program-parameters)))
;; Set the LAML program parameters. ;; This is specialized call to fake-startup-parameters with only program parameters

(define (set-laml-program-parameters program-parameters) (fake-startup-parameters (source-filename-without-extension) (startup-directory) program-parameters))
;; Return the full path to the current source file name in the startup directory, using the extension ext. ;; This function can be used conveniently to name the typical file for LAML to HTML transformations. ;; .internal-references "similar function" "source-filename-without-extension"

(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
;; Load and execute the LAML file on the file file-name (a string). ;; This procedure is a flexible and versatile alternative to laml-load. ;; .parameter file-name A file-name, with or without extension. The extension 'laml' will be added if not supplied. Takes file-name from the startup-directory. Can also be a full path. ;; .parameter program-parameters A list of program parameters ;; .misc Please notice that this procedure will not work in case you use directory or file names with dots ('.'). ;; .internal-references "useful function" "laml-program-parameters"

(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)))
;; Load the laml file in full-file-path after faking the start up parameters. ;; full-file-path must be the full path of a laml file, including the laml extension. ;; This function is used by the function laml, which is recommended for most users. ;; .internal-references "similar function" "laml"

(define (laml-load full-file-path . optional-parameter-list) (let ((original-filename-wihtout-extension (source-filename-without-extension)) (original-startup-dir (startup-directory)) (original-program-parameters (laml-program-parameters)) ) (let ((filename-wihtout-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 filename-wihtout-extension startup-dir program-parameter-list) (load full-file-path) ; restore originals
(if (and original-filename-wihtout-extension original-startup-dir) (fake-startup-parameters original-filename-wihtout-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."))))) (lib-load "general.scm") ; ---------------------------------------------------------------------------------------------------
;;; 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 function 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 of the Scheme source file. ;; .form (schemedoc scheme-source-file [commenting-style]) ;; .parameter scheme-source-file The file name of the Scheme source file, including file extension. ;; .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-source-file . optional-parameter-list) (let ((commenting-style (as-symbol (optional-parameter 1 optional-parameter-list "multi-semicolon"))) (this-dir (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 (extract-documentation-from-scheme-file (string-append this-dir scheme-source-file))) (destination-dir (string-append (startup-directory) 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) ) (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! 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.")) )))
;; Generate a LAML manual (in SchemeDoc style) of an XML DTD. ;; This procedure reads the parsed dtd file (from a file with extension lsp) and generates an HTML file that represents the manual. ;; .form (xml-dtd-manual dtd-path [target-path mirror-name-prefix]) ;; .pre-condition It is assumed that the DTD file already is parsed, and that the parsed DTD file is located side by side the DTD source file. It is also assumed that lib/xml-in-laml/xml-in-laml.scm is already loaded. ;; .parameter dtd-path the path to the dtd file, without any file extension. ;; .parameter target-path the path in which to write the manual target file. Defaults to the startup directory. ;; .parameter mirror-name-prefix The prefix name of the mirror of the XML language in LAML. (A string). Defaults to the empty string. ;; .example (dtd-manual "xhtml10-transitional") ;; .misc It is recommended that the XHTML1.0 transitional mirror is loaded before use of this procedure. The precondition and the recommendation is fulfilled when used via M-x run-laml-interactively in Emacs. ;; .internal-references "preparatory function" "xml-dtd-parse"

(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))))
;; Parse the XML DTD on dtd-file-name. If the input file is f, the parsed file will be ;; located in f.lsp. The parsed DTD is represented as a Scheme list structure. ;; .parameter dtd-file-name The name of the XML DTD file name in the startup directory. Without any extension. ;; .misc As a side-effect, this procedure defines the variables element-list, attribute-list, and entity-list.

(define (xml-dtd-parse dtd-file-name) (load (string-append laml-dir "tools/dtd-parser/dtd-parser-4.scm")) (parse-dtd dtd-file-name) )
;; Generate a mirror of an XML language in LAML and Scheme. This includes the generation of finite state automata for ;; XML validation purposes. If the parsed XML DTD file is named f.lsp, the generated mirror will be located in f.scm. ;; This procedure does not provide access to all 'parameters' of the mirror generation tool. If you need to control ;; the mirror generation in additional details, please write a small LAML script for this purpose. ;; .form (generate-xml-mirror parsed-dtd-file-name language-name [action-element-list]) ;; .parameter parsed-dtd-file-name The name of the parsed XML DTD file in the startup directory. Without extension. ;; .parameter language-name The name allocated to the new XML language in LAML. A symbol of your choice. ;; .parameter action-element-list A list of names for which to generate action procedures (list of symbols). ;; .internal-references "preparatory procedure" "xml-dtd-parse" ;; .reference "Full tool support" "XML-in-LAML Mirror generation" "../tools/xml-in-laml/man/xml-in-laml.html" ;; .misc After the generation of the mirror you can move the Scheme mirror file (with extension scm) to a directory of your choice.

(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) )))
;; Parse the XML file file-name (a file name with or without xml extension) using the XML parser for LAML. ;; Writes the parse tree on the optional out-file-name. ;; .form (xml-parse in-file-name [out-file-name]) ;; .parameter in-file-name The name of an XML file, with or without the xml file extension. ;; .parameter out-file-name The name of the file on which the parse tree is written. Defaults to the proper name of the xml file with and added lsp extension.

(define (xml-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/xml-support.scm")) (parse-xml-file in-path out-path)))
;; Parse the HTML file file-name (a file name with or without extension) using the XML-based HTML parser for LAML. ;; Writes the parse tree on the optional out-file-name. ;; .form (html-parse in-file-name [out-file-name]) ;; .parameter in-file-name The name of an HTML file, with or without the html file extension. ;; .parameter out-file-name The name of the file on which the parse tree is written. Defaults to the proper name of the html file with and added lsp extension.

(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)))
;; Pretty prints the XML file or XML parse tree in in-file-name and place the ;; pretty printed result in out-file-name. ;; The input is assumed to be a parse tree if and only if the extension is lsp. ;; A XML file is parsed before pretty printing via use of the simple and ;; non-complete, non-validating XML parser from the LAML software package. ;; The optional file out-file-name defaults to in-file-name. ;; In this case the original input file is overwritten. ;; If you care for your input file, it is strongly recommended that your output file does not overwrite your input file! ;; .form (xml-pp in-file-name [out-file-name single-lining indentation max-width]) ;; .parameter in-file-name The file to pretty print ;; .parameter out-file-name The file on which to write the pretty printed result. Default value in-file-name. ;; .parameter single-lining A boolean variable that controls the line breaking; False means break consistently all forms. Default #t. ;; .parameter indentation The increment of indentation. Default value 3. ;; .parameter max-width The preferred maximum line width in the pretty printed file. Default value 80. ;; .misc The pretty printing done by this function is superseded by the LAML AST pretty printing, as implemented by pretty-render-to-output-port and pretty-xml-render. ;; .reference "Similar function" "pretty-render-to-output-port" "../lib/xml-in-laml/man/xml-in-laml.html#pretty-render-to-output-port" ;; .reference "Similar function" "pretty-xml-render" "../lib/xml-in-laml/man/xml-in-laml.html#pretty-xml-render"

(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)))
;; Pretty prints the HTML file or HTML parse tree in in-file-name and place the ;; pretty printed result in out-file-name. ;; The input is assumed to be a parse tree if and only if the extension is lsp. ;; A HTML file is parsed before pretty printing via use of the non-validating HTML parser from the LAML software package. ;; The optional file out-file-name defaults to in-file-name. ;; In this case the original input file is overwritten. ;; If you care for your input file, it is strongly recommended that your output file does not overwrite your input file! ;; .form (html-pp in-file-name [out-file-name single-lining indentation max-width]) ;; .parameter in-file-name The file to pretty print ;; .parameter out-file-name The file on which to write the pretty printed result. Default value in-file-name. ;; .parameter single-lining A boolean variable that controls the line breaking; False means break consistently all forms. Default #t. ;; .parameter indentation The increment of indentation. Default value 3. ;; .parameter max-width The preferred maximum line width in the pretty printed file. Default value 80. ;; .misc The pretty printing done by this function is superseded by the LAML AST pretty printing, as implemented by pretty-render-to-output-port and pretty-xml-render. ;; .reference "Similar function" "pretty-render-to-output-port" "../lib/xml-in-laml/man/xml-in-laml.html#pretty-render-to-output-port" ;; .reference "Similar function" "pretty-xml-render" "../lib/xml-in-laml/man/xml-in-laml.html#pretty-xml-render"

(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)))
;; Parse the bibtex file, file-name, which is a bibtex file name without the bibtex extension. ;; Put the parsed result in file-name.lsp. In addition, deliver the result in the variable parse-result. ;; Finally, present the parsed file as HTML in file-name.html.

(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")))))
;; Pretty prints the Scheme or Lisp file - including comments - in in-file-name and write the result to out-file-name. ;; Conventional comments (prefixed with semicolon) are converted with the Schemedoc procedure ;; lexical-to-syntactical-comments! before the pretty printing. In case you ;; don't care about comments, you should probably use lisp-pp instead. ;; The optional file out-file-name defaults to in-file-name. ;; In this case the original input file is overwritten. ;; It is strongly recommended that your output file does not overwrite your input file! ;; This function assumes that the general LAML library is loaded in advance. ;; .form (scheme-pp in-file-name [out-file-name single-lining indentation max-width]) ;; .parameter in-file-name The file to pretty print ;; .parameter out-file-name The file on which to write the pretty printed result. Default value in-file-name. ;; .parameter single-lining A boolean variable that controls the line breaking; False means break consistently all forms. Default #t. ;; .parameter indentation The increment of indentation. Default value 3. ;; .parameter max-width The preferred maximum line width in the pretty printed file. Default value 80. ;; .internal-references "similar function" "scheme-pp-simple"

(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 this-dir 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) ) )
;; Pretty prints the Scheme or Lisp file - without comment preservation - ;; in in-file-name and write the result to out-file-name. ;; The pretty printing is simple because the conventional semicolon comments are lost. ;; The similar function scheme-pp preserves the comments during pretty printing. ;; The optional file out-file-name defaults to in-file-name. ;; In this case the original input file is overwritten. ;; It is strongly recommended that your output file does not overwrite your input file! ;; This function assumes that the general LAML library is loaded in advance. ;; .form (scheme-pp-simple in-file-name [out-file-name single-lining indentation max-width]) ;; .parameter in-file-name The file to pretty print ;; .parameter out-file-name The file on which to write the pretty printed result. Default value in-file-name. ;; .parameter single-lining A boolean variable that controls the line breaking; False means break consistently all forms. Default #t. ;; .parameter indentation The increment of indentation. Default value 3. ;; .parameter max-width The preferred maximum line width in the pretty printed file. Default value 80. ;; .internal-references "similar function" "scheme-pp"

(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) ) )
;; Convert the HTML file on in-file-name to an LAML file on out-file-name. ;; The conversion is done by parsing in-file-name, transforming the parse tree to LAML, ;; and by pretty printing the resulting LAML program. ;; .misc Exprimental

(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))))
;; Process a LENO xml file. ;; .misc Experimental

(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
;; A variable which determines which language to use in selected parts of the LAML software. ;; The value of the variable must be a symbol. ;; Currently we only support danish and english. english is the default value.

(define language-preference 'english)
;; Return either danish or english, depending on the value of the global variable language-preference.

(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
;; The URL prefix of the LAML software home page at Aalborg University's WWW server. ;; An absolute URL to the latest distributed version of LAML.

(define laml-absolute-url-prefix "http://www.cs.aau.dk/~normark/scheme/distribution/laml/")
;; Return a relative or absolute url prefix to the LAML home directory. ;; If start-dir is given, and if start-dir is a subdirectory of laml-dir, a relative directory path is returned. ;; In other cases, an absolute URL is returned, namely the value of the variable laml-absolute-url-prefix. ;; The parameter extra-level is an extra level (an integer) wich extends a relative path. ;; As an example, extra-level should be 1 in case HTML files are organized in a sub-directory. ;; Normally, extra-level is 0 (zero). ;; If a boolean extra-level is passed we explicitly ask for an absolute URL result. ;; If a string extra-level is passed, we use this string as a relative path to the home. ;; The parameter start-dir is optional. It defaults to the value of (startup-directory). ;; .form (laml-home-url-prefix [extra-level start-dir]) ;; .parameter extra-level The extra level as explained above (either an integer, a boolean, or a string). Defaults to the integer 0. ;; .parameter start-dir The directory from which we attempt to establish a relative path to the LAML home directory. Defaults to the value of the expression (startup-directory). ;; .internal-references "applied function" "startup-directory"

(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)))))
;; Return the relative or absolute prefix file path from dir to the root directory of the LAML software. ;; If dir is a subdirectory of laml-dir, return the relative path from dir to laml-dir. ;; If not, return the absolute path laml-dir ;; .form (laml-dir-prefix [dir]) ;; .parameter dir An absolute directory path, inside or outside laml-dir. Defaults to the value of (startup-directory). ;; .returns If possible, the relative directory path from dir to laml-dir. Else laml-dir ;; .internal-references "similar function" "laml-local-url-prefix"

(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))))
;; Return the relative or absolute url to the local laml dir. ;; The URL function corresponding to laml-dir-prefix. ;; If dir is a subdirectory of laml-dir, return the relative path from dir to laml-dir. ;; If not, return the absolute file:// prefixed URL to the laml directory. ;; .form (laml-local-url-prefix [dir]) ;; .parameter dir An absolute directory path, inside or outside laml-dir. Defaults to the value of (startup-directory). ;; .returns If possible, the relative url from dir to laml-dir. Else laml-dir prefixed with "file://" ;; .internal-references "similar function" "laml-dir-prefix"

(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)))))
;; Is the directory dir a (potential) subdirectory of laml-dir. ;; It is not necessary for dir to actually exist within laml-dir. ;; laml-dir is the path to the directory, in which your LAML system is installed.

(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
;; Return a standard document prolog - front matters - inserted before any document elements. ;; If requested, the rendering function can insert the standard prolog. ;; In some contexts, the standard prolog may depend on the optional language parameter. ;; .returns The document type declaration and the copyright-clause. ;; .form (standard-prolog [language])

(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) ""))))
;; Returns a standard document epilog - end matters - inserted after the document elements. ;; If requested, the rendering function can insert the standard epilog. ;; In some contexts, the standard epilog may depend on the optional language parameter. ;; .returns the laml standard comment and the tracing comment. ;; .form (standard-epilog [language])

(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))))
;; Return a document type declaration. This function is redefined in the individual mirrors. ;; Called by standard-prolog. ;; In some contexts, the document type declaration may depend on the optional language parameter. ;; .form (document-type-declaration [language]) ;; .returns the empty string (if not redefined)

(define (document-type-declaration . optional-parameter-list) (let ((language (optional-parameter 1 optional-parameter-list #f))) ""))
;; Return an HTML comment with a copyright notice, or an empty string. ;; You can redefine this function if you need a copyright message as part of your document. ;; If you redefine this function, it must return an HTML/XML comment. ;; Called by standard-prolog. ;; .returns the empty string (if not redefined)

(define (copyright-clause) "")
;; Return a standard comment about LAML. Depends on the function html-comment. ;; Called by standard-epilog. ;; .returns an HTML comment about LAML.

(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 "-->"))
;; Return a HTML comment which somehow traces this document. ;; Typical information includes source file, time of generation, operating system, Scheme systemt, etc. ;; Redefine this function if you need tracing information in your document. ;; .returns the empty string (if not redefined)

(define (tracing-comment) "") ; ---------------------------------------------------------------------------------------------------
;;; Cosmetic welcome, ending and copyright functions. ;;; .section-id welcome-section
;; Initiating welcome and info text for interactive LAM tools. ;; As of now this is entirely cosmetic.

(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) ))
;; This function is intended to end an LAML file. ;; It is strongly recommended that any LAML file - in particular XML-in-LAML file - calls end-laml as the last action. ;; Reports on elapsed processing time (currently only in MzScheme and Guile). ;; Checks ID attributes and links (only from XML-in-LAML contexts, via redefine version of this function). ;; A redefined version of end-laml in xml-in-laml.scm - used for xml-in-laml processing - calls this function (in addition to xml-in-laml relevant stuff). ;; .reference "redefinition in XML-in-LAML" "end-laml" "../lib/xml-in-laml/man/xml-in-laml.html#end-laml"

(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)
;; Return a credit message to Kurt Nørmark about system-dk (the Danish name) and system-eng (the English name). ;; As an optional parameter, an URL can be supplied with a link to the credited system. ;; .form (credits system-dk system-eng [system-url]) ;; .parameter system-dk The system name in Danish ;; .parameter system-eng The system name in English ;; .parameter system-url A URL referring to a WWW description of the system

(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.") ))))
;; Return the LAML POWER icon with link to the LAML home page. ;; Intended for the footer of LAML generated pages, from which the author wish to acknowledge the use of LAML. ;; The LAML icon is located in the directory (string-append (laml-home-url-prefix extra-level) "images/"), ;; where extra-level is the optional parameter of the current function. ;; The optional parameter extra-level can be given if the generated HTML files are placed in a different directory than the startup directory. ;; The default value is 0. ;; The optional parameter icon-size can either be small or large. large is the default value. ;; The role of extra-level is the same as in the procedure laml-home-url-prefix. ;; .form (laml-power-icon [extra-level icon-size]) ;; .internal-references "related procedure" "laml-home-url-prefix"

(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 '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"))))
;; Generate a LAML shortcut icon from the current directory (the startup-directory). ;; Shortcut icons are in some browsers shown as a tiny picture in the navigation tool bar, and together with bookmarks. ;; .parameter laml-home-url-dir A path from the current directory to the LAML home directory. Typically the value of (laml-home-url-prefix). ;; .pre-condition The HTML link mirror function must be defined for this function to work.

(define (laml-shortcut-icon laml-home-url-dir) (link 'rel "SHORTCUT ICON" 'href (string-append laml-home-url-dir "images/16-16-icon.ico")))
;;; HTML file writing procedures. ;;; In this section we have a convenient and versatile function which can be used as the outer context of an HTML Scheme expression, ;;; in order to write it to a text file. ;;; .section-id html-file-writing-section
;; Write html-clause (a string or an ast) to a text file. ;; When used on XML-in-LAML asts, this procedure also collects links (for later checking), ;; and it expands procedural content items. ;; The full path to the text file can be given by the third, optional parameter, ;; the default value of which is (full-source-path-with-extension "html"). ;; Mode may be a symbol (raw or pp), or a list of symbols including one of raw/pp and the symbols prolog and epilog. ;; The latter determines the rendering of the standard prolog and the standard epilog, ;; as defined by the functions standard-prolog and standard-epilog (in this file). ;; If mode is the symbol pp, do pretty print the HTML fragment before writing. ;; If mode is raw, just write the html clause without any kind of pretty printing. ;; This procedure loads the LAML xml-html-support pretty printing stuff if needed. ;; This procedure works on both the ast based (including XML-in-LAML) and the text based mirrors. ;; In case html-clause is an AST, the tree is processed by an AST rendering function before the file writing takes place. ;; In case hmtl-clause is an XML-in-LAML AST, it is expanded with respect to procedural content items before the writing takes place. ;; There are still a few minor problems with the HTML pretty printer. ;; .form (write-html mode html-clause [file-path-with-extension]) ;; .parameter mode a list with one or more of the symbols raw, pp, prolog, and epilog. Alternatively just one of the symbols pp or raw. ;; .parameter html-clause the string or ast to be written ;; .parameter file-path-with-extension the path of the file on which to write. Must include the file extension, typically html. Defaults to the name of the current source file with extension '.html'. ;; .internal-references "default target file" "full-source-path-with-extension" ;; .internal-references "prolog and epilog" "standard-prolog" "standard-epilog"

(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
;; A vector of length 256 which transforms character number i to a string. ;; Position number i determines how the extended ASCII character i is transformed. ;; Boolean entry #t means 'do not transform'. ;; Boolean entry #f means 'ignore char'. ;; A string entry describes a proper transformation. ;; A char entry describes a proper transformation. ;; An integer entry describes a transformation to the corresponding character number. ;; All other entries are illegal.

(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
;; Mutate a html character transformation table at position index. ;; More specifically, put new-entry at position index in the table. ;; The first entry in the table has index 0. ;; .parameter transformation-table Typically the vector html-char-transformation-table ;; .parameter index a number between 0 and 255 ;; .parameter new-entry The new entry, which can be boolean, a string, a character, or an integer. ;; .internal-references "info about table" "html-char-transformation-table"

(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.
;; Transform each character in the string str, using the HTML char transformation table, html-char-transformation-table. ;; Very inefficient in memory usage - therefore eliminated.
; (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)))))
;; Return the transformation of char or string, as transformed by a character transformation table. ;; Input: a character. Output: a string ;; chararcters outside the range [0..255] are just passed through, in case an extended character set is used. ;; .form (html-char-transform char [transformation-table]) ;; .parameter transformation-table A character transformation table, which defaults to html-char-transformation-table defined in laml.scm

(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
;; Read and the return the list structure for Scheme knowledge of RnRS, where n ;; corresponds to scheme-version (a number). ;; .parameter scheme-version either 4 or 5 (integer numbers). Alternatively r4rs or r5rs (symbols). ;; .returns The list structure of 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.")))))
;; Selects the name of a scheme knowledge entry.

(define symbol-of-scheme-knowledge (make-selector-function 1 'symbol-of-scheme-knowledge))
;; Selects the category of a scheme knowledge entry.

(define category-of-scheme-knowledge (make-selector-function 2 'category-of-scheme-knowledge))
;; Selects the essentiality of a scheme knowledge entry.

(define essentiality-of-scheme-knowledge (make-selector-function 3 'essentiality-of-scheme-knowledge))
;; Selects the HTML file number of a scheme knowledge entry.

(define file-number-of-scheme-knowledge (make-selector-function 4 'file-number-of-scheme-knowledge))
;; Selects the anchor name of a scheme knowledge entry.

(define anchor-name-of-scheme-knowledge (make-selector-function 5 'anchor-name-of-scheme-knowledge))
;; Return the suffix part of an URL to an RnRS Scheme HTML file. ;; .parameter an entry in a Scheme knowledge file. ;; .parameter scheme-version either 4 or 5 (integer numbers). Alternatively r4rs or r5rs (symbols). ;; .pre-condition The Scheme knowledge of RnRS corresponding to n = scheme-version must be read on beforehand, and the entry must be Scheme knowledge of an RnRS entry.

(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.
;; The LAML Manual/SchemeDoc standard settings. ;; The list returned is to be a constituent of laml-front-matters element of a LAML manual. ;; .reference "manual mirror function" "laml-front-matters" "../styles/xml-in-laml/manual/man/manual.html#laml-front-matters" ;; .internal-references "category" "ref1" "ref2" ... ;; .misc I usually keep this and similar functions in my .laml file. A version in the .laml file will overwrite this function. ;; .returns A list of attributes and constituents of laml-front-matters.

(define (kn-manual-settings) (list (manual-author (copyright-owner "Kurt Nørmark") "normark@cs.aau.dk" ) (manual-affiliation "Department of Computer Science," "Aalborg University," "Denmark.") (laml-library-source-linking) 'css-prestylesheet "compact" 'css-stylesheet "argentina" 'css-stylesheet-copying "true" ))
;; A collection of scheme-source-linking-manual clauses which provides for ;; linking from Scheme Sources to LAML manuals. ;; The boolean SchemeDoc attribute named scheme-source-linking controls the generation of Scheme source linking ;; from SchemeDoc manuals. ;; .reference "SchemeDoc" "scheme-source-linking-manual" "../styles/xml-in-laml/manual/man/manual.html#scheme-source-linking-manual" ;; .internal-references "Used by" "kn-manual-settings"

(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") ) )) ; --------------------------------------------------------------------------------------------------- ; Load the user's laml init file, if specified in the configuration file.
(if (and (not (equal? "/user/normark/.laml" "false")) (file-exists? "/user/normark/.laml")) (load "/user/normark/.laml"))