; The LAML library and programs are written by Kurt Normark, Aalborg University, Denmark.
; Copyright (C) 1999  Kurt Normark, normark@s.auc.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 elucidator style with Scheme source file support
;
; ---------------------------------------------------------------------------------------------------
; The Scheme system, variable scheme-system, defined at this point in the loading process,
; via previous loading of styles.scm
;
; ---------------------------------------------------------------------------------------------------
; Message function, version, and verbosity variable

Show source file in small font Link from elucidator-version to it's cross reference table entry 
(define elucidator-version "1") ;; If #t a number of messages are written on the output when processing is done. ;; If #f, nothing is written. Show source file in small font Link from elucidator-verbose-mode to it's cross reference table entry 
(define elucidator-verbose-mode #t) Show source file in small font Link from display-message to it's cross reference table entry 
(define (display-message message) (if elucidator-verbose-mode (begin (display (string-append message)) (newline)))) Show source file in small font Link from start-run-time to it's cross reference table entry 
(define start-run-time (current-time)) ; -------------------------------------------------------------------------------------------------- ;;; Directory setup. ;;; A number of variables and functions which gives information about relevant directories. ;; The directory in which all Scheme programs and libraries are located Show source file in small font Link from software-base-directory to it's cross reference table entry 
(define software-base-directory laml-dir) ;; The scheme library relative to software-base-library Show source file in small font Link from scheme-library to it's cross reference table entry 
(define scheme-library "lib4") ;; The directory in which the libraries are located Show source file in small font Link from the-library to it's cross reference table entry 
(define the-library (string-append software-base-directory scheme-library "/")) ;; The directory in which the elucidator is located Show source file in small font Link from software-directory to it's cross reference table entry 
(define software-directory (string-append software-base-directory "styles/elucidator/")) ;; The directory in which the documentation source is locacted. ;; Must be redefined. Ends with a slash. Show source file in small font Link from source-directory to it's cross reference table entry 
(define source-directory #f) ;; The directory in which the generated html files are located. Depends on source-directory Show source file in small font Link from html-directory to it's cross reference table entry 
(define (html-directory) (string-append source-directory "html/")) ; Return the full path to the file name in the internal directory. ; The parameter name includes a possible extension Show source file in small font Link from internal-file to it's cross reference table entry 
(define (internal-file name) (string-append source-directory "internal/" name)) ; Return the full path to the file name in the documentation source directory. ; The parameter name includes a possible extension Show source file in small font Link from documentation-source-file to it's cross reference table entry 
(define (documentation-source-file name) (string-append source-directory name)) ; --------------------------------------------------------------------------------------------------- ; Requirements and loading (display-message (string-append "Welcome to the Scheme Elucidator (version " elucidator-version ") and the LAML software." )) (display-message "Copyright (c) Kurt Normark (normark@cs.auc.dk), Aalborg University, Denmark") (display-message "Loading libraries and the schemeDoc tool") ; Loading requirements: ; general.scm is loaded by laml.scm (lib-load "file-read.scm") (lib-load "html.scm") (lib-load "html-v1.scm") (lib-load "time.scm") (lib-load "hex.scm") (load (string-append laml-dir "tools/schemedoc/schemedoc.scm")) (display-message "Loading elucidation software") ; Read the scheme knowledge list Show source file in small font Link from scheme-syntax-procedure-list to it's cross reference table entry 
(define scheme-syntax-procedure-list (file-read (string-append software-directory "scheme-knowledge.lsp"))) ; -------------------------------------------------------------------------------------------------- ;;; Controlling the amount of processing. ;;; There are a number of variables which control the amount of processing. ;;; The user of the eludicator does not set these directly via set!. Rather ;;; he or she uses a function interface, which in turn manipulates the variables. Show source file in small font Link from make-duplicated-name-index? to it's cross reference table entry 
(define make-duplicated-name-index? #t) Show source file in small font Link from make-cross-reference-index? to it's cross reference table entry 
(define make-cross-reference-index? #t) Show source file in small font Link from make-defining-name-index? to it's cross reference table entry 
(define make-defining-name-index? #t) Show source file in small font Link from make-large-source-files? to it's cross reference table entry 
(define make-large-source-files? #t) ; Link definitions to entries in the cross reference index? Show source file in small font Link from link-definitions-to-cross-reference-index? to it's cross reference table entry 
(define link-definitions-to-cross-reference-index? #t) ;; A variable which controls whether to copy image icons from the software directory to the source (documentation) directory. Show source file in small font Link from copy-image-files? to it's cross reference table entry 
(define copy-image-files? #t) ;; make both duplicate, cross-reference and defining-name indexes Show source file in small font Link from make-all-indexes to it's cross reference table entry 
(define (make-all-indexes) (set! make-duplicated-name-index? #t) (set! make-cross-reference-index? #t) (set! make-defining-name-index? #t)) ;; make neither duplicate, cross-reference or defining-name indexes Show source file in small font Link from make-no-indexes to it's cross reference table entry 
(define (make-no-indexes) (set! make-duplicated-name-index? #f) (set! make-cross-reference-index? #f) (set! make-defining-name-index? #f)) Show source file in small font Link from process-only-sources to it's cross reference table entry 
(define process-only-sources #f) ;; Only process the sources whose keys are given in the parameter. ;; If no parameteres are given, process no sources ;; If this form does not appear, process all sources. Show source file in small font Link from process-only to it's cross reference table entry 
(define (process-only . source-keys) (set! process-only-sources source-keys)) ;; Set variables such that minimum processing is called for Show source file in small font Link from minimum-processing to it's cross reference table entry 
(define (minimum-processing) (make-no-indexes) (process-only) (set! make-large-source-files? #f)) ;; Set variables such that maximum processing is called for Show source file in small font Link from maximum-processing to it's cross reference table entry 
(define (maximum-processing) (make-all-indexes) (set! make-large-source-files? #t)) ; --------------------------------------------------------------------------------------------------- ; General set up, internal variables and set-functions ; ; A boolean variable that tells whether to underline links in program files Show source file in small font Link from underline-program-links to it's cross reference table entry 
(define underline-program-links #f) ; A boolean variable that tells whether to underline links in documentation files Show source file in small font Link from underline-documentation-links to it's cross reference table entry 
(define underline-documentation-links #f) ; Defines how to handle comments. ; Possible values are syntactical and lexcical. ; With syntactical comment handling the comments are turned into syntactic constituents before ; the eludicator program procesing. Show source file in small font Link from comment-handling to it's cross reference table entry 10.3. Solution
(define comment-handling 'syntactical) Show source file in small font Link from syntactical-comment-designator to it's cross reference table entry 10.2. Ideas to improved handling of comments
(define syntactical-comment-designator "!!!comment") ; A boolean variable which controls whether to show a sectional comment name (within ::...::) in ; the rendering of a comment Show source file in small font Link from show-sectional-comment-name to it's cross reference table entry 
(define show-sectional-comment-name #t) ; Redefinition from schemedoc.scm, which causes a less common name to be used as syntactical comment designator Show source file in small font Link from comment-form-start to it's cross reference table entry 
(define comment-form-start (string-append "(" syntactical-comment-designator " ")) ; which kind of source markers to use in documentation: one of the symbols as-text, as-colored-text, as-image. Show source file in small font Link from source-marker-kind to it's cross reference table entry 
(define source-marker-kind 'as-image) ; The character used to mark detailed places in a program, and the corresponding one character string. Show source file in small font Link from elucidator-marker-char to it's cross reference table entry 
(define elucidator-marker-char #\@) Show source file in small font Link from elucidator-marker-char-string to it's cross reference table entry 
(define elucidator-marker-char-string (as-string elucidator-marker-char)) ; The character used to escape characters with special interpretation Show source file in small font Link from elucidator-escape-char to it's cross reference table entry 
(define elucidator-escape-char #\\) Show source file in small font Link from elucidator-escape-char-string to it's cross reference table entry 
(define elucidator-escape-char-string (as-string elucidator-escape-char)) ; Variables which are setable by set- procedures Show source file in small font Link from documentation-filename-without-extension to it's cross reference table entry 
(define documentation-filename-without-extension #f) Show source file in small font Link from documentation-title to it's cross reference table entry 4.2. The overall ideas
(define documentation-title #f) Show source file in small font Link from documentation-author to it's cross reference table entry 4.2. The overall ideas
(define documentation-author #f) Show source file in small font Link from documentation-email to it's cross reference table entry 
(define documentation-email #f) Show source file in small font Link from documentation-affiliation to it's cross reference table entry 
(define documentation-affiliation #f) Show source file in small font Link from documentation-abstract to it's cross reference table entry 
(define documentation-abstract #f) ; A list of program sources of this elucidation batch. ; An element of this variable is triple of key, file-location, and language pairs. ; Contributions to this list are made by the program-source procedure Show source file in small font Link from program-source-list to it's cross reference table entry 1.2. Organization of the setup file
(define program-source-list '()) ; A list of list parsed source forms from all source files in this documentation batch. Show source file in small font Link from source-list-list-process to it's cross reference table entry 1.3. Overall documentation processing forms.  6.1. Overview 6.2. The function applied-names-multiple-sources.
(define source-list-list-process '()) ; A list of all source keys of this documentation batch Show source file in small font Link from source-key-list to it's cross reference table entry 
(define source-key-list '()) ; A list of all defining name occurrences of all source files in this documentation batch. ; Each element is a pair of the form (name . source-key). Show source file in small font Link from defining-name-occurences to it's cross reference table entry 1.3. Overall documentation processing forms.  2.1. Getting started: the top level functions 7.4. The defined name index 10.4. Extracting sectional names from comments.
(define defining-name-occurences '()) ; A list of documentation source marker relations. ; A list of tripples: (program-id doc-id source-mark) Show source file in small font Link from documentation-source-marker-occurences to it's cross reference table entry 2.8. Linking from source markers in the program. 5.8. Preparing the linking to the documentation source markers.
(define documentation-source-marker-occurences '()) ; A list of name pairs of the form (applied-name . defined-name) ; The meaning is that the applied-name is used in a form: (define (defined-name...) ...). Show source file in small font Link from defined-applied-names to it's cross reference table entry 6.1. Overview 7.1. The cross reference index
(define defined-applied-names '()) ; A list of (program-name doc-id weak/strong) triples. All constituents are symbols. ; Represents the relation between the documentation sections/entries in which certain program definitions are ; explained/mentioned either strongly or weakly. ; program-name is a link source (anchor) in the documentation text. ; doc-id is the identification of the sub-section in the documentation, where the anchor occurs. ; weak/strong is one of symbols weak or strong (meaning either a weak or a strong reference from doc to prog). Show source file in small font Link from documented-name-occurences to it's cross reference table entry 2.1. Getting started: the top level functions 2.5. Making links from the program to the documentation 2.8. Linking from source markers in the program. 5.4. The functions which returns a link to a program unit or a documentation unit 5.5. Refined linking possibilities
(define documented-name-occurences '()) ; An alist which relates documentation-id to titles of sections and entries Show source file in small font Link from documentation-key-title-alist to it's cross reference table entry 1.3. Overall documentation processing forms.
(define documentation-key-title-alist '()) ; An alist which relates documentation-id to the hierarcical numbers of sections and entries Show source file in small font Link from documentation-key-numbering-alist to it's cross reference table entry 5.4. The functions which returns a link to a program unit or a documentation unit
(define documentation-key-numbering-alist '()) ; A list of documentation elements, either sections or entries, kind-taged with 'section or 'entry resp. Show source file in small font Link from documentation-elements to it's cross reference table entry 4.2. The overall ideas 4.8. Summary of parsing process 5. Making the documentation page 5.6. Linking between documentation sections and entries. 7.5. Making the table of contents 7.6. Local table of contents
(define documentation-elements '()) ;; Defines the source directory to be dir. The source directory is the directory which ;; contains the documentation laml file, and the path typically ends in doc. Ends in a slash. Show source file in small font Link from set-source-directory to it's cross reference table entry 
(define (set-source-directory dir) (set! source-directory dir)) ;; Define the name of the documentation. Per convention, this is the same ;; as the file name of the laml file, without extension. Show source file in small font Link from set-documentation-name to it's cross reference table entry 
(define (set-documentation-name name) (set! documentation-filename-without-extension name)) ;; Define the title, affiliation, author, affiliation, and the abstract Show source file in small font Link from documentation-intro to it's cross reference table entry 1.3. Overall documentation processing forms.  4.3. The top level functions.
(define (documentation-intro title author email affiliation abstract) (set! documentation-title title) (set! documentation-author author) (set! documentation-email email) (set! documentation-affiliation affiliation) (set! documentation-abstract abstract)) ;; The number of empty lines in the bottom of an html file, ;; in order to allow navigation to bottom stuf Show source file in small font Link from end-file-empty-lines to it's cross reference table entry 
(define end-file-empty-lines 25) ;; The width (in pixels) of the browser Show source file in small font Link from browser-pixel-width to it's cross reference table entry 
(define browser-pixel-width 1100) ;; The height of the top control frame in pixels Show source file in small font Link from control-frame-pixel-height to it's cross reference table entry 
(define control-frame-pixel-height 130) ; The number of columns in the detailed table of contents Show source file in small font Link from toc-columns-detail to it's cross reference table entry 
(define toc-columns-detail 3) ; The number of columns in the overall table of contents Show source file in small font Link from toc-columns-overall to it's cross reference table entry 
(define toc-columns-overall 3) ;; The prefix character of links from documentation to program: p for program. ;; Must be an absolute unique character in the documentation Show source file in small font Link from p-link-prefix-char to it's cross reference table entry 
(define p-link-prefix-char "{") ;; The suffix character of links from documentation to program: p for program. ;; Must be an absolute unique character in the documentation Show source file in small font Link from p-link-suffix-char to it's cross reference table entry 
(define p-link-suffix-char "}") ;; The prefix character of links from documentation to documentation: d for documentation. ;; Must be an absolute unique character in the documentation Show source file in small font Link from d-link-prefix-char to it's cross reference table entry 
(define d-link-prefix-char "[") ;; The suffix character of links from documentation to documentation: d for documentation. ;; Must be an absolute unique character in the documentation Show source file in small font Link from d-link-suffix-char to it's cross reference table entry 
(define d-link-suffix-char "]") ;; Controls whether to present the identification of sections and entries, hidden using the background color. Show source file in small font Link from present-hidden-ids? to it's cross reference table entry 
(define present-hidden-ids? #f) ;; The character which defines strong linking from documentation to program. Is supposed to follow the p-link-prefix-char. Show source file in small font Link from strong-link-char to it's cross reference table entry 5.5. Refined linking possibilities
(define strong-link-char #\*) ;; The character which defines weak linking from documentation to program. Is supposed to follow the p-link-prefix-char. ;; As a convention, a link is also a weak link if there is no particular link-type modifier after the p-link-prefix-char. Show source file in small font Link from weak-link-char to it's cross reference table entry 
(define weak-link-char #\+) ;; The character which defines a program word documentation to program. Is supposed to follow the p-link-prefix-char. ;; A program word is not linked, by type set in kbd font. Show source file in small font Link from none-link-char to it's cross reference table entry 
(define none-link-char #\-) ; An enumeration of all elucidator icons. These icons are copied from the images directory of the software-directory ; to the images directory of the source-directory. Show source file in small font Link from elucidator-image-files to it's cross reference table entry 8.2. The icons
(define elucidator-image-files (list "cross-index.gif" "doc-left.gif" "doc-left-weak.gif" "index.gif" "question-left-arrow.gif" "question-right-arrow.gif" "small-square.gif" "three-frames-horizontal.gif" "three-frames.gif" "contents.gif" "overall-contents.gif" "xx.gif" "small-green-up-triangle.gif" "source-mark-black.gif" "source-mark-grey.gif" "source-mark-silver.gif" "source-mark-maroon.gif" "source-mark-red.gif" "source-mark-purple.gif" "source-mark-green.gif" "source-mark-lime.gif" "source-mark-olive.gif" "source-mark-yellow.gif" "source-mark-navy.gif" "source-mark-blue.gif" "source-mark-tetal.gif" "source-mark-aqua.gif" "source-mark-fuchsia.gif" "small-up.gif" "small-up-blind.gif" "small-next.gif" "small-next-blind.gif" "small-prev.gif" "small-prev-blind.gif" )) ;; A boolean variable controlling whether to split the cross reference index in alphabetic files. ;; If false, make one large cross reference index. Show source file in small font Link from alphabetic-cross-reference-index? to it's cross reference table entry 7.2. Alphabetically organized cross reference indexes
(define alphabetic-cross-reference-index? #t) ;; A boolean variale controlling whether to split the defined name index in alphabetic files. ;; If false, make one large cross reference index. Show source file in small font Link from alphabetic-defined-name-index? to it's cross reference table entry 
(define alphabetic-defined-name-index? #t) ; --------------------------------------------------------------------------------------------------- Show source file in small font Link from display-warning to it's cross reference table entry 
(define (display-warning message) (if elucidator-verbose-mode (begin (display (string-append "WARNING: " message)) (newline)))) ; Return the interal anchor name of id. ; id can be a string or symbol. Show source file in small font Link from internal-reference to it's cross reference table entry 
(define (internal-reference id) (string-append (as-string id))) ; -------------------------------------------------------------------------------------------------- ;;; Top level functions ;; Define a documentation source in terms of a number of elements. Show source file in small font Link from program-source to it's cross reference table entry 1.2. Organization of the setup file
(define (program-source . elements) (set! program-source-list (cons elements program-source-list))) ;; Define a documentation-section. ;; Internally, this function collect information about a documentation section Show source file in small font Link from documentation-section to it's cross reference table entry 1.2. Organization of the setup file 1.3. Overall documentation processing forms.  1.4. The documentation-entry and documentation-section clauses 4. Parsing the textual documentation
(define (documentation-section . elements) (set! section-number (+ section-number 1)) (set! subsection-number 0) (let ((id (get-value 'id elements)) (title (get-value 'title elements)) (numbering (section-numbering)) (raw-numbering (list section-number subsection-number)) ; always 0 as subsection-nuber ) (set! documentation-elements (cons (append (make-associations (list 'kind 'numbering 'raw-numbering) (list 'section numbering raw-numbering)) elements) documentation-elements)) (set! documentation-key-title-alist (cons (cons id title) documentation-key-title-alist)) (set! documentation-key-numbering-alist (cons (cons id numbering) documentation-key-numbering-alist)) )) ;; Define a documentation entry. ;; Internally, this function collects information about a documentation entry. Show source file in small font Link from documentation-entry to it's cross reference table entry 1.2. Organization of the setup file 1.3. Overall documentation processing forms.  1.4. The documentation-entry and documentation-section clauses 4. Parsing the textual documentation
(define (documentation-entry . elements) (set! subsection-number (+ subsection-number 1)) (let ((id (get-value 'id elements)) (title (get-value 'title elements)) (numbering (subsection-numbering)) (raw-numbering (list section-number subsection-number)) ) (set! documentation-elements (cons (append (make-associations (list 'kind 'numbering 'raw-numbering) (list 'entry numbering raw-numbering)) elements) documentation-elements)) (set! documentation-key-title-alist (cons (cons id title) documentation-key-title-alist)) (set! documentation-key-numbering-alist (cons (cons id numbering) documentation-key-numbering-alist)) )) ; Make an a list, associating with list (not cons). Show source file in small font Link from make-associations to it's cross reference table entry 
(define (make-associations keys values) (pair-up keys (map list values))) ;; Begin the documentation part. This ends the preamble section. Show source file in small font Link from begin-documentation to it's cross reference table entry 1.2. Organization of the setup file 1.3. Overall documentation processing forms.
(define (begin-documentation) "") ;; End of documentation part. ;; Makes all the html stuff. Until now we have collected stuff. Here we generate html files ;; based on the collected stuff. Show source file in small font Link from end-documentation to it's cross reference table entry 1.2. Organization of the setup file 1.3. Overall documentation processing forms.  1.4. The documentation-entry and documentation-section clauses 2. Making the program pages 3.1. The function defined-names 4.2. The overall ideas 5.1. The function documentation-contents 6.1. Overview 7.1. The cross reference index 7.2. Alphabetically organized cross reference indexes 7.3. The duplicated name index 7.4. The defined name index 7.5. Making the table of contents 8.1. Some HTML details. 8.2. The icons 8.3. The Help page 10.1. Problems and existing descriptions 10.3. Solution
(define (end-documentation) ; make the help page in the actual html directory (display-message "Making the help page") (make-elucidator-help-page) ; copy image files from the software directory to the html directory (if copy-image-files? (begin (display-message "Copying image files") (copy-files elucidator-image-files (string-append software-directory "images/") (string-append source-directory "html/images/") ))) ; reversing source and documentation lists (set! program-source-list (reverse program-source-list)) (store-lisp-expression program-source-list (internal-file "program-source-list")) ; A linked program source marker to section 1.3:
'Overall documentation processing forms. '
Mark char: a (set! documentation-elements (reverse documentation-elements)) ; A linked program source marker to section 1.3:
'Overall documentation processing forms. '
Mark char: b save the list of documentation keys. This is for communication with the editor part of the elucidator (store-lisp-expression (reverse (map car documentation-key-title-alist)) (internal-file "documentation-ids")) (let ((program-source-list-process (filter process-source? program-source-list)) (program-source-list-non-process (filter (negate process-source?) program-source-list))) ; Pre-processing comments in source files, thereby defining new source files in the internal directory (if (eq? comment-handling 'syntactical) (begin (display-message "Pre-processing lexical comments in source files") (pre-process-comments-in-files! program-source-list-process) ) (display-message "NO Pre-processing lexical comments in source files") ) ; parse source files (only those to be processed), and store the list of the results (display-message "Parsing source files") (set! source-list-list-process (map read-source ; A linked program source marker to section 1.3:
'Overall documentation processing forms. '
Mark char: c (map source-file-determinator program-source-list-process))) (set! source-key-list (map (lambda (ps) (get-value 'key ps)) program-source-list)) (let ((source-key-list-process (map (lambda (ps) (get-value 'key ps)) program-source-list-process)) (source-key-list-non-process (map (lambda (ps) (get-value 'key ps)) program-source-list-non-process))) ; collect all defining names from all source files A linked program source marker to section 1.3:
'Overall documentation processing forms. '
The relation is ambiguous.
The other relevant section is 7.4
Mark char: d ; each element is a pair of the form (name source-key). ; store newly calculcated defined names in -.name files (display-message "Collecting and reading defining name occurences") (set! defining-name-occurences (append (accumulate-right ; FIRST PART A linked program source marker to section 1.3:
'Overall documentation processing forms. '
Mark char: e append '() (map2 (lambda (sl key) (let ((def-names (defined-names sl))) (store-defined-names key def-names) ; store them! (map (lambda (dn) (cons dn key)) def-names))) source-list-list-process source-key-list-process)) (accumulate-right ; SECOND PART A linked program source marker to section 1.3:
'Overall documentation processing forms. '
Mark char: f append '() (map restore-defined-names source-key-list-non-process))) ) ; A linked program source marker to section 1.3:
'Overall documentation processing forms. '
Mark char: g make documentation file. Hereby the global variable documented-name-occurences is assigned. (display-message "Presenting and resolving links in the documentation") (write-text-file (page "documentation" (documentation-contents)) (html-destination "documentation")) ; save documented-name-occurences. This is for communication with the editor part of the elucidator (store-lisp-expression (reverse documented-name-occurences) (internal-file "documented-names")) ; reverse documentation-source-marker-occurences such that documentation source markers are encountered in the right sequence ; when we process the program source files. (set! documentation-source-marker-occurences (reverse documentation-source-marker-occurences)) ; make program files @ (display-message "Making program source files") (for-each (lambda(ps source-list) (display-message (string-append " " (get-value 'key ps))) (make-source-program-file (get-value 'key ps) (source-file-determinator ps) (get-value 'language ps) source-list defining-name-occurences documented-name-occurences 'small)) program-source-list-process source-list-list-process ) ; A linked program source marker to section 1.3:
'Overall documentation processing forms. '
Mark char: i (if make-large-source-files? (begin ; make large source files (display-message "Making LARGE program source files") (for-each (lambda(ps source-list) (display-message (string-append " " (get-value 'key ps))) (make-source-program-file (get-value 'key ps) (source-file-determinator ps) (get-value 'language ps) source-list defining-name-occurences documented-name-occurences 'large)) program-source-list-process source-list-list-process ))) ; A linked program source marker to section 1.3:
'Overall documentation processing forms. '
Mark char: j make control file (display-message "Making the control file") (write-text-file (page "control" (con-space (icon-bar) (when-generated))) (html-destination "control")) ; A linked program source marker to section 1.3:
'Overall documentation processing forms. '
Mark char: k (if make-duplicated-name-index? (begin ; make duplicate report (display-message "Making the duplicate report") (write-text-file (page "Duplicate report" (con (icon-bar) (present-duplicated-definitions) ) white black black black ) (html-destination "duplicate-report"))) (display-message "NO duplicated name index is being generated") ) ; make index: defined names (if make-defining-name-index? ; A linked program source marker to section 1.3:
'Overall documentation processing forms. '
Mark char: l (let ((sorted-defining-name-occurences (sort-list defining-name-occurences name-entry-leq?))) (display-message "Making index of defined names") (display-message (if alphabetic-defined-name-index? " alphabetically broken" " as one large index")) (if alphabetic-defined-name-index? (let* ((splitted-defining-name-occurences (split-defining-name-occurences sorted-defining-name-occurences)) (alphabet (map downcase-string (map first-letter-of (map caar splitted-defining-name-occurences))))) (map2 (lambda (dan letter) (make-defining-name-index dan letter alphabet)) splitted-defining-name-occurences alphabet) (make-overall-defining-name-index alphabet)) (begin (write-text-file (page "Alphabetic index of defined names" (con (icon-bar) (present-defined-name-index sorted-defining-name-occurences) ) white black black black ) (html-destination "defining-name-index"))))) (display-message "NO index of defined names is being generated") ) (if make-cross-reference-index? ; extracting applied-defined name pairs (begin (display-message "Extracting applied-defined name pairs from parsed source files") (set! defined-applied-names (applied-names-multiple-sources (append source-list-list-process ; the list of sources processed in this run (map read-source (map (lambda (ps) (get-value 'file-location ps)) program-source-list-non-process)) ; the list of sources that need to be read ))) ; make index: cross references involving applied names ; o (display-message "Presenting the extracted cross reference index") (display-message (if alphabetic-cross-reference-index? " alphabetically broken" " as one large index")) (let ((extended-defined-applied-names (merge-defined-and-defined-applied-lists defined-applied-names (sort-list (map (lambda (x) (cons (car x) #f)) defining-name-occurences) (lambda (x y) (string<=? (as-string x) (as-string y))))))) (if alphabetic-cross-reference-index? (let* ((sdan (split-defined-applied-names extended-defined-applied-names)) (alphabet (map downcase-string (map first-letter-of (map caar sdan))))) (map2 (lambda (dan letter) (make-cross-reference-index dan letter alphabet)) sdan alphabet) (make-overall-cross-reference-index alphabet) ; with the alphabet navigator ) (write-text-file (page "Alphabetic cross reference index" (con (icon-bar) (present-cross-reference-index extended-defined-applied-names) ) white black black black ) (html-destination "cross-reference-index"))))) (display-message "NO cross reference index is being generated") ) ; A linked program source marker to section 1.3:
'Overall documentation processing forms. '
Mark char: l documentation section contents (display-message "Presenting overall documentation table of contents") (write-text-file (page "Documentation table of contents" (con (icon-bar) (present-documentation-contents documentation-elements 'overall) (when-generated) ) white black black black ) (html-destination "documentation-toc-overall")) (display-message "Presenting detailed documentation table of contents") (write-text-file (page "Documentation table of contents" (con (icon-bar) (present-documentation-contents documentation-elements 'detail) (when-generated) ) white black black black ) (html-destination "documentation-toc-detail")) ; A linked program source marker to section 1.3:
'Overall documentation processing forms. '
Mark char: m make frame files, in which the program is the first mentioned program source (display-message "Making frame files") (make-frame-file-in-html-dir "Scheme Elucidator" (elucidator-frame "documentation-toc-overall" "documentation" (get-value 'key (car program-source-list)) ; program starting point "" ; in html directory ) "index") (display-message (string-append "The Elucidator result is available in " (source-filename-without-extension scheme-system) ".html,")) (display-message (string-append "which is located in the same directory as the setup and documentation files")) ; Also make a frame file in the source directory, for easy and convenient start of the browsing (make-frame-file-in-source-dir "Scheme Elucidator" (elucidator-frame "documentation-toc-overall" "documentation" (get-value 'key (car program-source-list)) ; program starting point "html/" ) (source-filename-without-extension scheme-system)) (make-frame-file-in-html-dir "Scheme Elucidator" (elucidator-frame-horizontal ; always in html-dir "documentation-toc-overall" "documentation" (get-value 'key (car program-source-list)) ; program starting point ) "index-horizontal") (display-message (string-append "Total processing time: " (present-time-interval (- (current-time) start-run-time)))) ))) ; Return the name of the source file to parse, given source descriptor and the global variable comment-handling Show source file in small font Link from source-file-determinator to it's cross reference table entry 10.3. Solution
(define (source-file-determinator source-descriptor) (cond ((eq? comment-handling 'syntactical) (internal-syntactic-commented-file (get-value 'key source-descriptor))) ((eq? comment-handling 'lexical) (get-value 'file-location source-descriptor)) (else (error "source-file-determinator: Unknown kind of comment-handling")))) ; Return the name of the file holding the comment transformed source file (with syntactic comments). Show source file in small font Link from internal-syntactic-commented-file to it's cross reference table entry 
(define (internal-syntactic-commented-file source-key) (string-append source-directory "internal/" (as-string source-key) "-syntactical-comments")) ; Pre-process all source files in source-file-list, which is a source file descriptor Show source file in small font Link from pre-process-comments-in-files! to it's cross reference table entry 10.3. Solution
(define (pre-process-comments-in-files! source-file-list) (map pre-process-comments! source-file-list)) ; Pro-process a single source-file-descriptor. ; This defines a file in the internal directory Show source file in small font Link from pre-process-comments! to it's cross reference table entry 10.3. Solution
(define (pre-process-comments! source-file-descriptor) (let* ((input-file (get-value 'file-location source-file-descriptor)) (source-key (get-value 'key source-file-descriptor)) (output-file (internal-syntactic-commented-file source-key))) (lexical-to-syntactical-comments! input-file output-file))) Show source file in small font Link from when-generated to it's cross reference table entry 
(define (when-generated) (let* ((dt (date-time (current-time))) (date (car dt)) (time (cadr dt))) (font 2 red (con "Generated: " date ", " time)))) ; Store the lisp expression exr on the file with full path file-path. Show source file in small font Link from store-lisp-expression to it's cross reference table entry 1.3. Overall documentation processing forms.
(define (store-lisp-expression expr file-path) (if (file-exists? file-path) (delete-file file-path)) (with-output-to-file file-path (lambda () (write expr)))) Show source file in small font Link from icon-bar to it's cross reference table entry 8.2. The icons
(define (icon-bar) (table-3 0 (list 30 30 30 30 30 30 30 30 30 30 30 30 60 1000) (list (list (a-tag-target "index.html" (image "three-frames.gif" "Reset Elucidator to vertical layout") "_top") (a-tag-target "index-horizontal.html" (image "three-frames-horizontal.gif" "Reset Elucidator to horizontal layout") "_top") " " (a-tag-target "defining-name-index.html" (image "index.gif" "Alphabetic index of defined names in the program") "control-frame") (a-tag-target "cross-reference-index.html" (image "cross-index.gif" "Cross reference index") "control-frame") (a-tag-target "duplicate-report.html" (image "xx.gif" "Duplicated definitions") "control-frame") " " (a-tag-target "documentation-toc-detail.html" (image "contents.gif" "Detailed documentation table of contents") "control-frame") (a-tag-target "documentation-toc-overall.html" (image "overall-contents.gif" "Overall documentation table of contents") "control-frame") " " (a-tag-target "elucidator-help.html" (image "question-left-arrow.gif" "Elucidator Help Page to be shown in the documentation frame") "documentation-frame") (a-tag-target "elucidator-help.html" (image "question-right-arrow.gif" "Elucidator Help Page to be shown in the program frame") "program-frame") " " (source-file-links source-key-list) )) 'middle )) ; do we have to process program-source (a triple of key, file-location and language)? Show source file in small font Link from process-source? to it's cross reference table entry 
(define (process-source? program-source) (let ((source-key (get-value 'key program-source))) (if process-only-sources (member source-key process-only-sources) #t))) ; read the list of defined names (list of (name . source-key)) from file ; if no file found, return the empty list Show source file in small font Link from restore-defined-names to it's cross reference table entry 1.3. Overall documentation processing forms.
(define (restore-defined-names source-key) (let ((restore-filename (defining-names-file source-key))) (if (file-exists? restore-filename) (let* ((ip (open-input-file restore-filename)) (res (read ip))) (display-message (string-append " Restoring defined names from " source-key ".names")) (close-input-port ip) res) (begin (display-warning (string-append "No defining names stored for " source-key)) '())))) ; Write the list of defined names (list of (name . source-key)) to file Show source file in small font Link from store-defined-names to it's cross reference table entry 1.3. Overall documentation processing forms.
(define (store-defined-names source-key defined-names) (let ((store-filename (defining-names-file source-key)) (keyed-names (map (lambda (dn) (cons dn source-key)) defined-names))) (if (file-exists? store-filename) (delete-file store-filename)) (with-output-to-file store-filename (lambda () (write keyed-names))))) ; return the file name (full path) of the name file for source-key Show source file in small font Link from defining-names-file to it's cross reference table entry 
(define (defining-names-file source-key) (string-append source-directory "internal/" source-key ".names")) Show source file in small font Link from source-file-links to it's cross reference table entry 
(define (source-file-links source-key-list) (let ((lgt (length source-key-list))) (table-1 1 (map (lambda (sk) (* (string-length sk) 7)) source-key-list) (make-list lgt yellow) (list (map (lambda (sk) (a-tag-target (add-file-extension sk "html") (font-size 2 sk) "program-frame")) source-key-list))))) ; --------------------------------------------------------------------------------------------------- ; ; ; Syntax functions ; ; Return a syntax function Show source file in small font Link from make-syntax-function to it's cross reference table entry 1.4. The documentation-entry and documentation-section clauses
(define (make-syntax-function syntax-symbol) (lambda values (cons syntax-symbol values))) ; Tag elements with a kind, defined to be kind-symbol Show source file in small font Link from tag-kind to it's cross reference table entry 
(define (tag-kind kind-symbol elements) (cons (list 'kind kind-symbol) elements)) ; Get the value of an element, provided that there is exactly one value Show source file in small font Link from get-value to it's cross reference table entry 
(define (get-value key elements) (let ((res (assoc key elements))) (if (and (list? res) (> (length res) 1)) (cadr res) (error (string-append "get-value in elucidator: Problems accessing a value of a syntax element: " (as-string res)))))) ; Get the list of values of an element Show source file in small font Link from get-values to it's cross reference table entry 
(define (get-values key elements) (cdr (assoc key elements))) Show source file in small font Link from key to it's cross reference table entry 
(define key (make-syntax-function 'key)) Show source file in small font Link from file-location to it's cross reference table entry 
(define file-location (make-syntax-function 'file-location)) Show source file in small font Link from language to it's cross reference table entry 
(define language (make-syntax-function 'language)) Show source file in small font Link from id to it's cross reference table entry 
(define id (make-syntax-function 'id)) Show source file in small font Link from title to it's cross reference table entry 1.4. The documentation-entry and documentation-section clauses
(define title (make-syntax-function 'title)) Show source file in small font Link from index-words to it's cross reference table entry 
(define index-words (make-syntax-function 'index-words)) Show source file in small font Link from intro to it's cross reference table entry 
(define intro (make-syntax-function 'intro)) Show source file in small font Link from sources to it's cross reference table entry 
(define sources (make-syntax-function 'sources)) Show source file in small font Link from body to it's cross reference table entry 1.4. The documentation-entry and documentation-section clauses
(define body (make-syntax-function 'body)) ; General functions Show source file in small font Link from html-destination to it's cross reference table entry 8.1. Some HTML details.
(define (html-destination filename) (string-append (html-directory) filename ".html")) Show source file in small font Link from source-destination to it's cross reference table entry 
(define (source-destination filename) (string-append source-directory filename ".html")) ; --------------------------------------------------------------------------------------------------- ; Color settings Show source file in small font Link from defined-color to it's cross reference table entry 
(define defined-color (make-color 255 0 0)) ; (define comment-color (make-color 0 100 0)) Show source file in small font Link from comment-color to it's cross reference table entry 
(define comment-color (make-color 112 168 0)) Show source file in small font Link from applied-color to it's cross reference table entry 
(define applied-color (make-color 0 0 128)) Show source file in small font Link from documentation-section-color to it's cross reference table entry 
(define documentation-section-color (make-color 0 204 255)) Show source file in small font Link from documentation-entry-color to it's cross reference table entry 
(define documentation-entry-color (make-color 0 204 255)) Show source file in small font Link from documentation-program-link-color to it's cross reference table entry 
(define documentation-program-link-color red) Show source file in small font Link from documentation-program-link-color-weak to it's cross reference table entry 
(define documentation-program-link-color-weak applied-color) Show source file in small font Link from documentation-documentation-link-color to it's cross reference table entry 
(define documentation-documentation-link-color blue) Show source file in small font Link from none-reference-color to it's cross reference table entry 
(define none-reference-color (make-color 70 70 70)) ; --------------------------------------------------------------------------------------------------- Show source file in small font Link from image-file-access to it's cross reference table entry 
(define image-file-access 'sub-directory) Show source file in small font Link from image to it's cross reference table entry 
(define (image file-name help-text) (html:img 'src (image-file file-name) 'alt help-text 'border 0)) ; -------------------------------------------------------------------------------------------------- ;;; Scheme source file reading. ;; Read the file (a lisp source file) and return a list of the lisp expressions found in the source file Show source file in small font Link from read-source to it's cross reference table entry 1.3. Overall documentation processing forms.  10.1. Problems and existing descriptions 10.3. Solution
(define (read-source file) (let* ((ip (open-input-file file)) (res (read-source-1 ip '()))) (close-input-port ip) (reverse res))) Show source file in small font Link from read-source-1 to it's cross reference table entry 
(define (read-source-1 input-port source-list) (if (eof-object? (peek-char input-port)) source-list (read-source-1 input-port (cons (read input-port) source-list)))) ; -------------------------------------------------------------------------------------------------- ;;; Extraction of top level defined names from parsed Scheme expressions. ;; Return the list of top-level defined names in the source list ;; Source list may be as returned by read-source. Show source file in small font Link from defined-names to it's cross reference table entry 1.3. Overall documentation processing forms.  3.1. The function defined-names
(define (defined-names source-list) (defined-names-1 source-list '())) Show source file in small font Link from defined-names-1 to it's cross reference table entry 3.1. The function defined-names 10.4. Extracting sectional names from comments.
(define (defined-names-1 source-list res) (if (null? source-list) (reverse res) (let ((form (car source-list))) (if (define-form? form) (defined-names-1 (cdr source-list) (cons (defined-name form) res)) (if (syntactical-comment? form) (let ((section-name (section-name-comment? (comment-string-of-syntactical-comment form)))) (if section-name (defined-names-1 (cdr source-list) (cons (as-symbol section-name) res)) (defined-names-1 (cdr source-list) res))) (defined-names-1 (cdr source-list) res)))))) Show source file in small font Link from define-form? to it's cross reference table entry 3.1. The function defined-names 6.2. The function applied-names-multiple-sources.
(define (define-form? x) (and (list? x) (> (length x) 1) (eq? (car x) 'define))) Show source file in small font Link from syntactical-comment? to it's cross reference table entry 10.4. Extracting sectional names from comments.
(define (syntactical-comment? x) (and (list? x) (not (null? x)) (eq? (car x) (as-symbol syntactical-comment-designator)))) ; syntactical comment selectors Show source file in small font Link from comment-string-of-syntactical-comment to it's cross reference table entry 10.8. Pretty printing syntactical comments
(define comment-string-of-syntactical-comment (make-selector-function 3 'comment-string-of-syntactical-comment)) Show source file in small font Link from comment-level-of-syntactical-comment to it's cross reference table entry 
(define comment-level-of-syntactical-comment (make-selector-function 2 'comment-level-of-syntactical-comment)) ; This function takes the string of a syntactical comment and returns whether ; it is a section name comment. A positive answer returns the sectional comment name (a string without double colons). Show source file in small font Link from section-name-comment? to it's cross reference table entry 10.4. Extracting sectional names from comments.
(define (section-name-comment? comment-string) (let ((p1 (skip-chars-in-string comment-string white-space-char-list 0))) (if (looking-at-substring? comment-string p1 "::") (let ((p2 (find-in-string comment-string #\: (+ p1 2)))) ; finding first colon at the end of name (if p2 (substring comment-string (+ p1 2) p2) ; returning portin of string between double colons #f)) #f))) Show source file in small font Link from defined-name to it's cross reference table entry 3.1. The function defined-names
(define (defined-name x) ; assume that x is a define form (if (pair? (cadr x)) (car (cadr x)) (cadr x))) ; Return the bounded names of the form f. ; This function works on an arbitrary form. ; As a peculiarity, this function does not recognize the name in (define n ...) as a bound name. ; But the names (x y z) are bound in (define (n x y z) ...) Show source file in small font Link from bounded-names to it's cross reference table entry 2.3. Traversing and scanning lists 3.2. The function bounded-names 9.2. A solution
(define (bounded-names x) (cond ((define-form? x) (parameter-names x)) ; extend with the defined name itself? ((let-form? x) (let-names x)) ((lambda-form? x) (lambda-names x)) (else '()))) Show source file in small font Link from parameter-names to it's cross reference table entry 3.2. The function bounded-names 9.2. A solution
(define (parameter-names x) ; Return the bounded names in x, which is a define form ; Assume as a pre-condition that x is a define form. (cond ((pair? (cadr x)) (let ((call-form (cadr x))) (cond ((list? call-form) (cdr call-form)) ((pair? call-form) (cond ((pair? (cdr call-form)) (append (proper-part (cdr call-form)) (list (first-improper-part (cdr call-form))))) ((symbol? (cdr call-form)) (list (cdr call-form)))) )))) ((symbol? (cadr x)) (if (> (length x) 2) (let ((y (caddr x))) ; possible lambda form (if (and (pair? y) (eq? (car y) 'lambda)) (let ((par (cadr y))) (cond ((symbol? par) (list par)) ((list? par) par) ((pair? par) (append (proper-part par) (list (first-improper-part par)))))) '())) '())) (else '()))) ; --------------------------------------------------------------------------------------------------- ;;; Scheme dependent elucidator. ;; Decorate the Scheme source-file with anchors and links. ;; Source-path is the name of the file with the Scheme source text (full path and extension). ;; Destination-path is the name of the html file with where the decorated Scheme source is to be written (full path and extension). ;; Source-list is the list of, read Scheme expressions on source-file. ;; Defined-names is a list of name-definitions to which we link applied names. ;; A name-definition is a list of the form (name . source-key), where source-key identifies the ;; source file, in which name is a defining name occurence ;; Documented names is a list of name descriptors, which are documented in the elucidated program. ;; In this context, a name descriptor is a pair of the form (documented-name documentation-id). ;; documented-name is a program name which occurs (in curly brackets) in the documentation. ;; documentation-id is the id of the subsection, in which the name occurs. Show source file in small font Link from elucidate-program-source to it's cross reference table entry 2.1. Getting started: the top level functions
(define (elucidate-program-source source-path destination-path source-list defined-names documented-names size source-key) (let ((of destination-path)) (if (file-exists? of) (delete-file of)) (let ((ip (open-input-file source-path)) (op (open-output-file of))) (write-string-to-port (pre-page (string-append "Source file") white black black black) op) (write-string-to-port (con (start-tag "font" 'size (if (eq? size 'small) 2 3)) (start-tag "pre")) op) (elucidate-program-source-1 ip op source-list defined-names documented-names size source-key (length source-list)) (write-string-to-port (con (end-tag "pre") (end-tag "font")) op) (write-string-to-port (vertical-space end-file-empty-lines) op) (write-string-to-port (post-page) op) (close-input-port ip) (close-output-port op) ))) Show source file in small font Link from add-file-extension to it's cross reference table entry 
(define (add-file-extension f ext) (string-append f "." ext)) ; source-length is the length of source-list Show source file in small font Link from elucidate-program-source-1 to it's cross reference table entry 2.1. Getting started: the top level functions 10.5. Look-ahead through comments for a define form 10.6. Presenting syntactical comments. 10.7. Printing the anchor name
(define (elucidate-program-source-1 ip op source-list defined-names documented-names size source-key source-length) (set! last-define-a-name #f) (skip-white-space ip op) (if (not (eof-object? (peek-char ip))) (let ((form (car source-list)) (next-form (if (> source-length 1) (cadr source-list) #f))) (elucidate-program-form ip op form next-form defined-names documented-names size source-key) (elucidate-program-source-1 ip op (cdr source-list) defined-names documented-names size source-key (- source-length 1))) )) ; The name of the definition, in which we currently are located. Show source file in small font Link from enclosing-definition-name to it's cross reference table entry 2.7. Preparing the linking to program source markers. 2.8. Linking from source markers in the program.
(define enclosing-definition-name #f) ; The name of the last definition from which an anchor name has been written to the output port ; Set imperatively by elucidate-program-form Show source file in small font Link from last-define-a-name to it's cross reference table entry 10.7. Printing the anchor name
(define last-define-a-name #f) ; The central elucidation function. ip and op are input and output port. ; f is the form to be elucidated. nf is the next form, or #f if no such form exist, ; or of the next form is unknown (not important for the processing). ; defined-names and documented-names are lists. ; size is 'small or 'large. ; Source-key is the source-key of the file, we are elucidating. Show source file in small font Link from elucidate-program-form to it's cross reference table entry 2.1. Getting started: the top level functions 2.2. The overall program traversal and scanning. 2.3. Traversing and scanning lists 2.4. More lexical troubles 2.5. Making links from the program to the documentation 2.7. Preparing the linking to program source markers. 2.8. Linking from source markers in the program. 9.2. A solution 10.1. Problems and existing descriptions 10.2. Ideas to improved handling of comments 10.5. Look-ahead through comments for a define form 10.6. Presenting syntactical comments. 10.7. Printing the anchor name
(define (elucidate-program-form ip op f nf defined-names documented-names size source-key) (cond ((quote-in-input? ip f) (begin (write-char #\' op) (elucidate-program-form ip op (cadr f) #f defined-names documented-names size source-key) (skip-white-space ip op))) ; here also handle other special lexical items such as backquote ((eof-object? f) ; nothing ) ((symbol? f) (match-symbol f ip op defined-names) (skip-white-space ip op)) ((string? f) (match-string f ip op) (skip-white-space ip op)) ((number? f) (match-number f ip op) (skip-white-space ip op)) ((char? f) (match-char f ip op) (skip-white-space ip op)) ((boolean? f) (match-boolean f ip op) (skip-white-space ip op)) ((vector? f) (error "elucidate-program-form: vector not made yet")) ((syntactical-comment? f) ; A linked program source marker to section 10.6:
'Presenting syntactical comments.'
The relation is ambiguous.
The other relevant sections are 10.6, 10.7
Mark char: h (match-syntactical-comment-without-output ip) (read-char ip) ; eats the empty after each syntactical comment ; compensates for this accedential (and wrong) behaviour of lexical-to-syntactical-comments! in SchemeDoc ; ; write anchor name of next defined form before the rendering of the comment (if (define-form? nf) (let ((def-name (defined-name nf))) (write-string-to-port (a-name (as-string def-name)) op) (set! last-define-a-name def-name))) ; render the comment (write-string-to-port (render-syntactical-comment (comment-string-of-syntactical-comment f) (comment-level-of-syntactical-comment f)) op) ; (write-string-to-port "CCC" op) ) ((define-form? f) ; A linked program source marker to section 2.3:
'Traversing and scanning lists'
The relation is ambiguous.
The other relevant sections are 10.7, 10.8
Mark char: a (let* ((bn (bounded-names f)) (reduced-defined-names (list-difference-2 defined-names bn))) (set! enclosing-definition-name (defined-name f)) ; A linked program source marker to section 2.7:
'Preparing the linking to program source markers.'
Mark char: b (skip-white-space ip op) (if (not (eq? last-define-a-name (defined-name f))) ; in case there was no comment before the define form (write-string-to-port (a-name (as-string (defined-name f))) op)) (set! last-define-a-name #f) ; forget about the last written anchor name (write-string-to-port (con (total-doc-navigator (defined-name f) documented-names size source-key) (br)) op) (match-start-parenthesis ip op) (skip-white-space ip op) (match-symbol 'define ip op '()) (skip-white-space ip op) (write-string-to-port (con (start-tag "b") (start-tag "font" 'color (rgb-string-list defined-color))) op) ; make sure that only the next form (no comments) is matched here (elucidate-restricted-form ip op (cadr f)) (write-string-to-port (con (end-tag "font") (end-tag "b")) op) (skip-white-space ip op) (for-each (lambda (sf nf) (skip-white-space ip op) (elucidate-program-form ip op sf nf reduced-defined-names ; A linked program source marker to section 9.2:
'A solution'
Mark char: c documented-names size source-key)) (cddr f) (if (null? (cddr f)) '() (append (cdddr f) (list #f))) ; next forms, of same length as (cddr f) because of trailing #f ) (skip-white-space ip op) (match-end-parenthesis ip op) (skip-white-space ip op))) ((list? f) ; A linked program source marker to section 9.2:
'A solution'
Mark char: d (let* ((bn (bounded-names f)) (reduced-defined-names (list-difference-2 defined-names bn))) (skip-white-space ip op) (match-start-parenthesis ip op) (for-each (lambda (sf nf) (skip-white-space ip op) (elucidate-program-form ip op sf nf reduced-defined-names ; A linked program source marker to section 9.2:
'A solution'
Mark char: e documented-names size source-key)) f (if (null? f) '() (append (cdr f) (list #f))) ; next forms, of same length as f because of trailing #f ) (skip-white-space ip op) (match-end-parenthesis ip op) (skip-white-space ip op))) ((pair? f) ; improper list A linked program source marker to section 9.2:
'A solution'
Mark char: f (let* ((p1 (proper-part f)) (p2 (first-improper-part f)) (bn (bounded-names f)) (reduced-defined-names (list-difference-2 defined-names bn)) ) (skip-white-space ip op) (match-start-parenthesis ip op) (for-each (lambda (sf nf) (skip-white-space ip op) (elucidate-program-form ip op sf nf reduced-defined-names ; A linked program source marker to section 9.2:
'A solution'
Mark char: g documented-names size source-key)) p1 (if (null? p1) '() (append (cdr p1) (list #f))) ; next forms, of same length as f because of trailing #f ) (skip-white-space ip op) (match-dot ip op) (skip-white-space ip op) (elucidate-program-form ip op p2 #f defined-names documented-names size source-key) (skip-white-space ip op) (match-end-parenthesis ip op) (skip-white-space ip op) ) ) (else (error (string-append "elucidate-program-form: unknown kind of expression" (as-string f))))) ) ; A specialized procdures which reads through a syntactical comment on ip without ; outputting anyting on op Show source file in small font Link from match-syntactical-comment-without-output to it's cross reference table entry 10.6. Presenting syntactical comments.
(define (match-syntactical-comment-without-output ip) (read-char ip) ; read start-parenthesis (read ip) ; read comment symbol (read ip) ; read comment level (read ip) ; read comment string (read-char ip) ; read end-parenthesis which follows right next to the string ) ; --------------------------------------------------------------------------------------------------- ; Processing of a syntactical comment string via a state machine. ; ; An internal variable in which we register whether the commen-string parameter ; render-syntactical-comment is considered a sectional-comment. Show source file in small font Link from indeed-section-comment to it's cross reference table entry 
(define indeed-section-comment #f) ; Render comment-string, at comment-level in the HTML program synthesis. ; This is the 'main function' for these purposes which uses a lot of helping functions, and a state ; machine. Show source file in small font Link from render-syntactical-comment to it's cross reference table entry 10.8. Pretty printing syntactical comments
(define (render-syntactical-comment comment-string comment-level) (let* ((sectional-comment (section-name-comment? comment-string)) (decorate-comment ; the function with wich the outermost comment decoration is performed (lambda (comment-rendering) (cond ((and sectional-comment (= comment-level 1)) (html:b (font-color (make-color 49 72 0) comment-rendering) 'style "{background-color: rgb(220,220,220);}")) ; grey background ((and sectional-comment (= comment-level 2)) (html:b (font-color (make-color 49 72 0) comment-rendering) 'style "{background-color: rgb(255,255,0);}")) ; yellow background ((and sectional-comment (>= comment-level 3)) (html:b (font-color (make-color 49 72 0) comment-rendering) 'style "{background-color: rgb(255,102,217);}")) ; pink background (else (font-color comment-color comment-rendering)) ) ) ) ) (set! indeed-section-comment sectional-comment) (let ((comment-string-1 (strip-trailing-characters (list #\newline #\return) comment-string))) (set! state-list '()) (decorate-comment (string-append (make-string comment-level #\;) ; initial comment characters " " (do-render-syntactical-comment comment-string-1 comment-level 0 (string-length comment-string-1) comment-output-string 0 comment-max-length 'normal "")))))) ; The maximum length of a comment (meassured in characters) which can be ; handled by the elucidator Show source file in small font Link from comment-max-length to it's cross reference table entry 
(define comment-max-length 10000) ; The string in which the output of the rendering is placed. Reused from rendering to rendering. Show source file in small font Link from comment-output-string to it's cross reference table entry 
(define comment-output-string (make-string comment-max-length #\space)) Show source file in small font Link from debugging-syntactical-comment-rendering to it's cross reference table entry 
(define debugging-syntactical-comment-rendering #f) Show source file in small font Link from state-list to it's cross reference table entry 
(define state-list '()) Show source file in small font Link from do-render-syntactical-comment to it's cross reference table entry 10.8. Pretty printing syntactical comments
(define (do-render-syntactical-comment c-str c-lev inptr inlength outstr outptr outlength current-state collected-str) (if (>= outptr (- outlength 500)) (error "do-render-syntactical-comment: Close to output string overflow. Make comment-max-length larger")) (if (= inptr inlength) (string-append (substring outstr 0 outptr) (cond ((and (eq? current-state 'source-char) (> (string-length collected-str) 0)) ; pending source marker on end at line (render-source-char collected-str)) (else "")) ) (let* ((inch (string-ref c-str inptr)) (trans-res (syntactical-comment-transition current-state inch collected-str c-lev)) (next-state (car trans-res)) (toput (as-string (cadr trans-res))) (collected-str (caddr trans-res)) ) (if debugging-syntactical-comment-rendering (set! state-list (cons (list (as-string inch) next-state collected-str) state-list))) (put-into-string! outstr outptr toput) (do-render-syntactical-comment c-str c-lev (+ 1 inptr) inlength outstr (+ outptr (string-length toput)) outlength next-state collected-str) ))) Show source file in small font Link from sectional-comment-char to it's cross reference table entry 
(define sectional-comment-char #\:) Show source file in small font Link from sectional-comment-char-string to it's cross reference table entry 
(define sectional-comment-char-string (as-string sectional-comment-char)) Show source file in small font Link from elucidator-marker-char-string to it's cross reference table entry 
(define elucidator-marker-char-string (as-string elucidator-marker-char)) Show source file in small font Link from syntactical-comment-transition to it's cross reference table entry 
(define (syntactical-comment-transition in-state ch collected-str c-level) (let ((char (as-string ch)) (expl (string-append "A link to a program source marker in " (as-string previous-strong-program-word)))) (cond ((and (symbol? in-state) (eq? in-state 'normal)) (cond ((equal? char sectional-comment-char-string) (list 'colon-initial-1 "" "")) ((equal? char elucidator-marker-char-string) (list 'at-sign "" "")) ((equal? char (as-string #\newline)) (list 'newline "" "")) ((equal? char (as-string #\<)) (list 'normal "&lt;" "")) ((equal? char (as-string #\>)) (list 'normal "&gt;" "")) (else (list 'normal char collected-str)))) ((and (symbol? in-state) (eq? in-state 'colon-initial-1)) (cond ((equal? char sectional-comment-char-string) (list 'colon-initial-2 "" "")) ((equal? char elucidator-marker-char-string) (list 'at-sign (as-string sectional-comment-char) "")) ((equal? char (as-string #\newline)) (list 'newline (string-append (as-string sectional-comment-char)) "")) (else (list 'normal (string-append (as-string sectional-comment-char) char) collected-str)))) ((and (symbol? in-state) (eq? in-state 'colon-initial-2)) (cond ((equal? char sectional-comment-char-string) (error "syntactical-comment-transition: more than two colons not allowed")) ((equal? char elucidator-marker-char-string) (error "syntactical-comment-transition: @ in section name not allowed")) ((equal? char (as-string #\newline)) (error "syntactical-comment-transition: newline not allowed in section name")) (else (list 'within-section-name "" (string-append collected-str char))))) ((and (symbol? in-state) (eq? in-state 'within-section-name)) (cond ((equal? char sectional-comment-char-string) (list 'colon-after-1 "" collected-str)) ((equal? char elucidator-marker-char-string) (error "syntactical-comment-transition: @ in section name not allowed")) ((equal? char (as-string #\newline)) (error "syntactical-comment-transition: newline not allowed in section name")) (else (list 'within-section-name "" (string-append collected-str char))))) ((and (symbol? in-state) (eq? in-state 'colon-after-1)) (cond ((equal? char sectional-comment-char-string) (list 'normal (render-sectional-comment collected-str) "")) ((equal? char elucidator-marker-char-string) (error "syntactical-comment-transition: @ in section name not allowed")) ((equal? char (as-string #\newline)) (error "syntactical-comment-transition: newline not allowed in section name")) (else (list 'within-section-name "" (string-append collected-str sectional-comment-char-string char))))) ((and (symbol? in-state) (eq? in-state 'colon-after-2)) ; blind (cond ((equal? char sectional-comment-char-string) (error "syntactical-comment-transition: three colons not allowed")) ((equal? char elucidator-marker-char-string) (list 'at-sign (render-sectional-comment collected-str) "")) ((equal? char (as-string #\newline)) (list 'newline (render-sectional-comment collected-str) "")) (else (list 'normal (string-append (render-sectional-comment collected-str) char) "")))) ((and (symbol? in-state) (eq? in-state 'at-sign)) (cond ((equal? char sectional-comment-char-string) (error "syntactical-comment-transition: colon after source mark char not allowed")) ((equal? char elucidator-marker-char-string) (error "syntactical-comment-transition: double @ not allowed")) ((equal? char (as-string #\newline)) (error "syntactical-comment-transition: newline after @ not allowed")) (else (list 'source-char "" char)))) ((and (symbol? in-state) (eq? in-state 'source-char)) (cond ((equal? char sectional-comment-char-string) (list 'colon-initial-1 elucidator-marker-char-string "")) ((equal? char elucidator-marker-char-string) (list 'at-sign elucidator-marker-char-string "")) ((equal? char (as-string #\space)) (list 'normal (string-append (render-source-char collected-str) " ") "")) ((equal? char (as-string #\return)) (list 'source-char "" collected-str)) ; just eat the return - char 13 ((equal? char (as-string #\newline)) (list 'newline (render-source-char collected-str) "")) (else (list 'normal (string-append elucidator-marker-char-string char) "")))) ((and (symbol? in-state) (eq? in-state 'space-after-source-char)) ; blind (cond ((equal? char sectional-comment-char-string) (list 'colon-initial-1 (render-source-char collected-str) "")) ((equal? char elucidator-marker-char-string) (list 'at-sign (render-source-char collected-str) "")) (else (list 'normal (string-append (render-source-char collected-str) char) "")))) ((and (symbol? in-state) (eq? in-state 'newline)) (cond ((equal? char sectional-comment-char-string) (list 'colon-initial-1 (comment-glyph c-level) "")) ((equal? char elucidator-marker-char-string) (list 'at-sign (comment-glyph c-level) "")) ((equal? char (as-string #\space)) (list 'newline-and-spaces "" char)) ((equal? char (as-string #\newline)) (list 'newline (comment-glyph c-level) "")) (else (list 'normal (string-append (comment-glyph c-level) " " char) "")))) ((and (symbol? in-state) (eq? in-state 'newline-and-spaces)) (cond ((equal? char (as-string #\space)) (list 'newline-and-spaces "" (string-append collected-str char))) ((equal? char sectional-comment-char-string) (list 'colon-initial-1 (string-append (comment-glyph c-level collected-str)) "")) ((equal? char elucidator-marker-char-string) (list 'at-sign (string-append (comment-glyph c-level collected-str)) "")) ((equal? char (as-string #\newline)) (list 'newline (string-append (comment-glyph c-level collected-str)) "")) (else (list 'normal (string-append (comment-glyph c-level collected-str) " " char) "")))) (else (error (string-append "syntactical-comment-transition error: unknown state " (as-string in-state))) ) ))) Show source file in small font Link from comment-glyph to it's cross reference table entry 
(define (comment-glyph comment-level . in-between-newline-and-semicolon) (let ((in-between (if (null? in-between-newline-and-semicolon) #f (car in-between-newline-and-semicolon)))) (string-append (as-string #\newline) (if in-between in-between "") (make-string comment-level #\;) ))) Show source file in small font Link from render-sectional-comment to it's cross reference table entry 
(define (render-sectional-comment section-name) (if indeed-section-comment (begin (set! indeed-section-comment #f) ; such that no other section names in this comment are rendered as sectioin comments (string-append (a-name section-name) (if show-sectional-comment-name (b (font-color red section-name)) "")) ) (string-append (as-string sectional-comment-char) (as-string sectional-comment-char) section-name (as-string sectional-comment-char) (as-string sectional-comment-char)))) Show source file in small font Link from render-source-char to it's cross reference table entry 
(define (render-source-char source-char-string) (string-append (a-name (string-append (as-string enclosing-definition-name) ; A program source marker WITHOUT a link to the documentation "-@" source-char-string)) (doc-source-marker-link ; A program source marker WITHOUT a link to the documentation documentation-source-marker-occurences source-char-string enclosing-definition-name) )) ; End state machine and processing of syntactical comment string ; --------------------------------------------------------------------------------------------------- ; ; ; Return a link to the documentation frame. NOT USED. Show source file in small font Link from doc-navigator to it's cross reference table entry 5.5. Refined linking possibilities
(define (doc-navigator name documented-names) (let ((res (assq name documented-names)) ) (if res (let* ((res-docid (cadr res)) (weak-strong (caddr res)) (res-doc-title (cdr (assq res-docid documentation-key-title-alist))) ) (con (a-tag-target (string-append "documentation.html" "#" (as-string res-docid)) (cond ((eq? strong-weak 'strong) (image "doc-left.gif" title)) ((eq? strong-weak 'weak) (image "doc-left-weak.gif" title)) (else (error "doc-link: problems determining strong or weak documentation link"))) "documentation-frame" ) (br))) ""))) Show source file in small font Link from total-doc-navigator to it's cross reference table entry 2.3. Traversing and scanning lists 2.5. Making links from the program to the documentation 5.5. Refined linking possibilities
(define (total-doc-navigator name documented-names size source-key) (let* ((doc-entries (filter (lambda (e) (eq? name (car e))) documented-names)) (reversed-doc-entries (reverse doc-entries)) (unique-reversed-doc-entries-0 (remove-duplicates-by-predicate reversed-doc-entries (lambda (x y) (and (eq? (cadr x) (cadr y)) (eq? (caddr x) (caddr y))) ))) (unique-reversed-doc-entries (remove-redundant-weak-entries unique-reversed-doc-entries-0)) ) (con ; A program source marker WITHOUT a link to the documentation (if make-large-source-files? (con (if (eq? size 'small) (a-tag (string-append source-key "-LARGE" ".html" "#" (as-string name)) (image "small-square.gif" "Show source file in large font")) (a-tag (string-append source-key ".html" "#" (as-string name)) (image "small-square.gif" "Show source file in small font"))) (horizontal-space 1) ) "") (if link-definitions-to-cross-reference-index? (let* ((name-string (as-string name)) (name-first-letter (as-string (string-ref name-string 0)))) (con (a-tag-target (if alphabetic-cross-reference-index? (string-append "cross-reference-index" "-" (downcase-string name-first-letter) ".html" "#" name-string) (string-append "cross-reference-index" ".html" "#" name-string)) (image "small-green-up-triangle.gif" (string-append "Link from " name-string " to it's cross reference table entry")) "control-frame") (horizontal-space 1) )) "") (if (not (null? unique-reversed-doc-entries)) (string-merge (map (lambda (de) (let* ((doc-id (cadr de)) (strong-weak (caddr de)) (number (cdr (assq doc-id documentation-key-numbering-alist))) (doc-entry-title (cdr (assq doc-id documentation-key-title-alist)))) (doc-link name doc-id (string-append number ". " doc-entry-title) strong-weak)) ) unique-reversed-doc-entries) (make-list (- (length unique-reversed-doc-entries) 1) (horizontal-space 1))) "")))) Show source file in small font Link from remove-redundant-weak-entries to it's cross reference table entry 2.5. Making links from the program to the documentation
(define (remove-redundant-weak-entries entries) ; Entries is a subset of documented-name-occurenes. In this function we remove possible weak entries ; for which also a strong entry exist in the list of entries. (remove-redundant-weak-entries-1 entries entries '())) Show source file in small font Link from remove-redundant-weak-entries-1 to it's cross reference table entry 
(define (remove-redundant-weak-entries-1 all-entries entries res) (letrec ((redundant-weak-entry? (lambda (e1 e2) (and (not (equal? e1 e2)) (eq? 'weak (caddr e1)) (eq? (cadr e1) (cadr e2)))))) (cond ((null? entries) (reverse res)) ((member-by-predicate (car entries) all-entries redundant-weak-entry?) (remove-redundant-weak-entries-1 all-entries (cdr entries) res)) (else (remove-redundant-weak-entries-1 all-entries (cdr entries) (cons (car entries) res)))))) Show source file in small font Link from documentation-url to it's cross reference table entry 
(define (documentation-url doc-id) (string-append "documentation.html" "#" (as-string doc-id))) ; Return a link to the documentation frame given name (a name in the program frame) ; a doc-id (the identification of a section or unit in the documentation frame) and ; title (the title of the section or unit in the documentation frame). ; strong-weak is a symbol (strong or weak) which tells whether to insert a strong or a weak documentation reference Show source file in small font Link from doc-link to it's cross reference table entry 2.5. Making links from the program to the documentation 5.5. Refined linking possibilities
(define (doc-link name doc-id title strong-weak) (a-tag-target (documentation-url doc-id) (cond ((eq? strong-weak 'strong) (image "doc-left.gif" title)) ((eq? strong-weak 'weak) (image "doc-left-weak.gif" title)) (else (error "doc-link: problems determining strong or weak documentation link"))) "documentation-frame")) ; A specialized version of list-difference, where the first parameter is a list of pairs (name . key), ; and the second parameter is a simple list of names ; Returns a list of pairs (a subset of defined-name-pairs). Show source file in small font Link from list-difference-2 to it's cross reference table entry 2.3. Traversing and scanning lists
(define (list-difference-2 defined-name-pairs bounded-names) (list-difference-3 defined-name-pairs bounded-names '())) Show source file in small font Link from list-difference-3 to it's cross reference table entry 
(define (list-difference-3 lst1 lst2 res) (cond ((null? lst1) (reverse res)) ((memq (caar lst1) lst2) (list-difference-3 (cdr lst1) lst2 res)) (else (list-difference-3 (cdr lst1) lst2 (cons (car lst1) res))))) Show source file in small font Link from elucidate-restricted-form to it's cross reference table entry 
(define (elucidate-restricted-form ip op f) ; match the cadr symbol of a define form, without matching trailing comments (cond ((symbol? f) (match-symbol f ip op '())) ((list? f) (match-start-parenthesis ip op) (for-each (lambda (sf) (skip-white-space ip op) (elucidate-restricted-form ip op sf)) f) (skip-white-space ip op) (match-end-parenthesis ip op)) ((pair? f) (let ((p1 (proper-part f)) (p2 (first-improper-part f))) (skip-white-space ip op) (match-start-parenthesis ip op) (for-each (lambda (sf) (skip-white-space ip op) (elucidate-restricted-form ip op sf)) p1) (skip-white-space ip op) (match-dot ip op) (skip-white-space ip op) (elucidate-restricted-form ip op p2) (skip-white-space ip op) (match-end-parenthesis ip op) )))) Show source file in small font Link from quote-in-input? to it's cross reference table entry 2.4. More lexical troubles
(define (quote-in-input? ip form) (let ((ch (peek-char ip))) (if (eq? #\' ch) (begin (read-char ip) (if (not (and (list? form) (> (length form) 1) (eq? (car form) 'quote))) (error "Lexical quote char not matched by (quote ...) form")) #t) #f))) ; defined names is a list of (name . source-key) elements Show source file in small font Link from match-symbol to it's cross reference table entry 2.2. The overall program traversal and scanning.
(define (match-symbol sym ip op defined-names) (read ip) (let* ((source-key (name-memq sym defined-names)) (protected-symbol-string (html-protect (as-string sym))) (symbol (as-symbol protected-symbol-string))) (if source-key (write-string-to-port (html:a (font-color applied-color protected-symbol-string) ; before 01.17.00: symbol 'href (string-append source-key ".html" "#" (as-string sym)) 'title source-key 'style (if underline-program-links "{text-decoration: underline;}" "{text-decoration: none;}") ) op) (let ((scheme-syn-pro? (scheme-syntax-or-procedure? sym))) (if scheme-syn-pro? (write-string-to-port ((scheme-syntax-procedure-decorate scheme-syn-pro?) protected-symbol-string) op) (display protected-symbol-string op)))))) ;; The parameter entry is a an entry from scheme-syntax-procedure-list. ;; Return the a one-argument procedure, with which to decorate a kind symbol in the program presentation. Show source file in small font Link from scheme-syntax-procedure-decorate to it's cross reference table entry 
(define (scheme-syntax-procedure-decorate entry) (cond ((eq? 'syntax (cadr entry)) b) ((eq? 'procedure (cadr entry)) brown-normal) (else id-1))) Show source file in small font Link from brown-normal to it's cross reference table entry 
(define (brown-normal txt) (font-color brown txt)) ; The identify function Show source file in small font Link from id-1 to it's cross reference table entry 
(define (id-1 x) x) ; Return an entry in scheme-syntax-procedure-list, if symbol is found in that list, or else #f Show source file in small font Link from scheme-syntax-or-procedure? to it's cross reference table entry 
(define (scheme-syntax-or-procedure? symbol) (scheme-syntax-or-procedure-1 symbol scheme-syntax-procedure-list)) Show source file in small font Link from scheme-syntax-or-procedure-1 to it's cross reference table entry 
(define (scheme-syntax-or-procedure-1 symbol lst) (cond ((null? lst) #f) ((eq? (car (car lst)) symbol) (car lst)) (else (scheme-syntax-or-procedure-1 symbol (cdr lst))))) ; Return the source-key component of the matching sym in defined-names. ; defined names i a list of pairs, where each pair is of the form (name . source-key). ; If no match, return #f Show source file in small font Link from name-memq to it's cross reference table entry 
(define (name-memq sym defined-names) (cond ((null? defined-names) #f) ((eq? sym (caar defined-names)) (cdar defined-names)) (else (name-memq sym (cdr defined-names))))) Show source file in small font Link from match-string to it's cross reference table entry 2.2. The overall program traversal and scanning.
(define (match-string str ip op) (read ip) (write (html-protect str) op)) Show source file in small font Link from match-char to it's cross reference table entry 2.2. The overall program traversal and scanning.
(define (match-char ch ip op) (read ip) (write ch op)) Show source file in small font Link from match-number to it's cross reference table entry 2.2. The overall program traversal and scanning.
(define (match-number n ip op) (read ip) (write n op)) Show source file in small font Link from match-boolean to it's cross reference table entry 2.2. The overall program traversal and scanning.
(define (match-boolean b ip op) (read ip) (write b op)) Show source file in small font Link from match-start-parenthesis to it's cross reference table entry 2.3. Traversing and scanning lists
(define (match-start-parenthesis ip op) (let ((ch (read-char ip))) (if (eq? ch #\() (write-char #\( op) (error (string-append "match error: start parenthesis expected:" (as-string ch)))))) Show source file in small font Link from match-end-parenthesis to it's cross reference table entry 2.3. Traversing and scanning lists
(define (match-end-parenthesis ip op) (let ((ch (read-char ip))) (if (eq? ch #\)) (write-char #\) op) (error "match error: end parenthesis expected")))) Show source file in small font Link from match-dot to it's cross reference table entry 
(define (match-dot ip op) (let ((ch (read-char ip))) (if (eq? ch #\.) (write-char #\. op) (error "match error: dot expected. Problems if we deal with unnormlized dotted forms")))) Show source file in small font Link from skip-white-space to it's cross reference table entry 2.3. Traversing and scanning lists 10.1. Problems and existing descriptions 10.6. Presenting syntactical comments.
(define (skip-white-space ip op) (let ((ch (peek-char ip))) (cond ((white-space? ch) (begin (read-char ip) (write-char ch op) (skip-white-space ip op))) ((comment-begin? ch) (begin (skip-comment ip op) (skip-white-space ip op))) (else 'empty)))) Show source file in small font Link from white-space? to it's cross reference table entry 
(define (white-space? ch) (if (eof-object? ch) #f (let ((n (char->integer ch))) (or (eq? n 32) (eq? n 9) (eq? n 10) (eq? n 12) (eq? n 13))))) Show source file in small font Link from comment-begin? to it's cross reference table entry 
(define (comment-begin? ch) (eq? #\; ch)) Show source file in small font Link from skip-comment to it's cross reference table entry 2.3. Traversing and scanning lists 10.1. Problems and existing descriptions 10.6. Presenting syntactical comments.
(define (skip-comment ip op) ; skip rest of line. (write-string-to-port (start-tag "font" 'color (rgb-string-list comment-color)) op) (skip-comment-1 ip op) (write-string-to-port (end-tag "font") op)) Show source file in small font Link from report-ambiguous-doc-source-markers to it's cross reference table entry 2.8. Linking from source markers in the program.
(define (report-ambiguous-doc-source-markers amb-list) (let ((doc-sections (map (lambda (pid-did-sm) (let ((doc-id (cadr pid-did-sm))) (cdr (assq doc-id documentation-key-numbering-alist)))) amb-list))) (string-append cr "The relation is ambiguous." cr (if (= 1 (length amb-list)) "The other relevant section is " "The other relevant sections are ") (string-merge doc-sections (make-list (- (length amb-list) 1) ", " ))))) ; Return the link (an a-tag-target) from a program source marker to the documentation. ; Issue a warning in cases of ambiguities or a non-existing relation. Show source file in small font Link from doc-source-marker-link to it's cross reference table entry 2.8. Linking from source markers in the program.
(define (doc-source-marker-link documentation-source-marker-occurences mark-char enclosing-definition-name) (let* ((relevant-occurences (filter (lambda (pid-did-sm) (let ((pid (car pid-did-sm)) (sm (caddr pid-did-sm))) (and (equal? (as-string pid) (as-string enclosing-definition-name)) (equal? (as-string sm) (as-string mark-char))))) documentation-source-marker-occurences)) (lgt (length relevant-occurences))) ; possible warning side effect (cond ((= lgt 0) (display-warning (string-append "No corresponding source marker in the documention: Marker '" (as-string mark-char) "' in " (as-string enclosing-definition-name)))) ((> lgt 1) (display-warning (string-append "Ambiguous source marker '" (as-string mark-char) "' for " (as-string enclosing-definition-name) " in the documentation. Using the first one"))) (else "")) ; no warning (cond ((>= lgt 1) (let* ((used-occ (car relevant-occurences)) (doc-id (cadr used-occ)) (num (cdr (assq doc-id documentation-key-numbering-alist))) (sec-title (cdr (assq doc-id documentation-key-title-alist))) (ambiguous? (if (> lgt 1) (report-ambiguous-doc-source-markers (cdr relevant-occurences)) "")) ; A linked program source marker to section 2.8:
'Linking from source markers in the program.'
Mark char: o (explanation (string-append "A linked program source marker to section " num ":" cr (string-it-single sec-title) ambiguous? cr "Mark char: " (as-string mark-char) )) ) (a-tag-target (string-append "documentation.html" "#" (as-string doc-id) "-" "@" (as-string mark-char)) (source-marker-image mark-char explanation) "documentation-frame"))) (else (source-marker-image mark-char "A program source marker WITHOUT a link to the documentation"))))) Show source file in small font Link from skip-comment-1 to it's cross reference table entry 2.6. Marking detailed places in a program 2.7. Preparing the linking to program source markers. 2.8. Linking from source markers in the program. 10.6. Presenting syntactical comments. 10.8. Pretty printing syntactical comments
(define (skip-comment-1 ip op) ; skip rest of line. (let ((ch (read-char ip))) (cond ((eof-object? ch) #f) ; do nothing. ((eol? ch) (write-char ch op)) ((eq? ch #\<) (write-string-to-port "&lt;" op) (skip-comment-1 ip op)) ((eq? ch #\>) (write-string-to-port "&gt;" op) (skip-comment-1 ip op)) ((eq? ch elucidator-marker-char) (let ((source-marker-char (read-char ip)) ; assume not eof (next-char (read-char ip)) ; assume not eof ) (if (is-white-space? next-char) (write-string-to-port (string-append (a-name (string-append (as-string enclosing-definition-name) ; A linked program source marker to section 2.7:
'Preparing the linking to program source markers.'
Mark char: i "-@" (as-string source-marker-char))) (doc-source-marker-link ; A linked program source marker to section 2.7:
'Preparing the linking to program source markers.'
The relation is ambiguous.
The other relevant section is 2.8
Mark char: a documentation-source-marker-occurences source-marker-char enclosing-definition-name) (as-string next-char)) op) (write-string-to-port (string-append (as-string elucidator-marker-char) (as-string source-marker-char) (as-string next-char)) op)) (skip-comment-1 ip op))) (else (begin (write-char ch op) (skip-comment-1 ip op)))))) Show source file in small font Link from eol? to it's cross reference table entry 
(define (eol? ch) (eq? ch #\newline)) ; --------------------------------------------------------------------------------------------------- ; Handy test procedure of the Scheme elucidator. Show source file in small font Link from lucid to it's cross reference table entry 
(define (lucid file) (let* ((source-list (read-source (add-file-extension file "scm"))) (defining-names (defined-names source-list))) (elucidate-program-source (string-append file ".scm") (string-append file ".html") source-list defining-names '()))) ; --------------------------------------------------------------------------------------------------- ; ; Overall frame setup in terms of the contro, documentation, and program file names. ; Directory prefix is added in front of all three frames of the elucidator. Show source file in small font Link from elucidator-frame to it's cross reference table entry 8.1. Some HTML details.
(define (elucidator-frame control-filename documentation-filename program-filename directory-prefix) (letrec ((frame-file (lambda (f) (string-append directory-prefix (add-file-extension f "html"))))) (html:frameset (con (html:frame "" 'name "control-frame" 'src (frame-file control-filename) 'scrolling "auto") (html:frameset (con (html:frame "" 'name "documentation-frame" 'src (frame-file documentation-filename) 'scrolling "yes") (html:frame "" 'name "program-frame" 'src (frame-file program-filename) 'scrolling "yes") ) 'cols "50%,50%" 'border 5 'bordercolor (rgb-string-list black)) ) 'rows (string-append (as-string control-frame-pixel-height) ",*") 'border 5 'bordercolor (rgb-string-list black))) ) Show source file in small font Link from elucidator-frame-horizontal to it's cross reference table entry 8.1. Some HTML details.
(define (elucidator-frame-horizontal control-filename documentation-filename program-filename) (html:frameset (con (html:frame "" 'name "control-frame" 'src (add-file-extension control-filename "html") 'scrolling "yes") (html:frame "" 'name "documentation-frame" 'src (add-file-extension documentation-filename "html") 'scrolling "yes") (html:frame "" 'name "program-frame" 'src (add-file-extension program-filename "html") 'scrolling "yes") ) 'rows (string-append (as-string control-frame-pixel-height) ",360,*") 'border 5 'bordercolor (rgb-string-list black)) ) Show source file in small font Link from make-frame-file-in-html-dir to it's cross reference table entry 8.1. Some HTML details.
(define (make-frame-file-in-html-dir title frames filename) (write-text-file (html:html (con (html:head (html:title documentation-title)) frames)) (html-destination filename))) Show source file in small font Link from make-frame-file-in-source-dir to it's cross reference table entry 8.1. Some HTML details.
(define (make-frame-file-in-source-dir title frames filename) (write-text-file (html:html (con (html:head (html:title documentation-title)) frames)) (source-destination filename))) ; Return the body of the documentation page. ; This function uses the global variables, such as documentation-abstract and documentation-elements. Show source file in small font Link from documentation-contents to it's cross reference table entry 1.3. Overall documentation processing forms.  4.2. The overall ideas 4.3. The top level functions. 5.1. The function documentation-contents 8.1. Some HTML details.
(define (documentation-contents) (con (a-name "START") (h 1 (font-color blue (guard-text documentation-title))) (present-author-info (map guard-text (list documentation-author documentation-email documentation-affiliation))) (p) (present-abstract (guard-text documentation-abstract)) (vertical-space 1) (accumulate-right string-append "" (map present-documentation-element documentation-elements)) (vertical-space end-file-empty-lines) )) Show source file in small font Link from present-documentation-element to it's cross reference table entry 5.1. The function documentation-contents
(define (present-documentation-element doc-el) (let ((kind (get-value 'kind doc-el))) (cond ((eq? kind 'section) (present-documentation-section doc-el)) ((eq? kind 'entry) (present-documentation-entry doc-el)) (else (error "present-documentation-element: unknown kind of documentation element"))))) Show source file in small font Link from section-number to it's cross reference table entry 1.4. The documentation-entry and documentation-section clauses
(define section-number 0) Show source file in small font Link from subsection-number to it's cross reference table entry 1.4. The documentation-entry and documentation-section clauses
(define subsection-number 0) Show source file in small font Link from section-numbering to it's cross reference table entry 1.4. The documentation-entry and documentation-section clauses
(define (section-numbering) (string-append (as-string section-number))) Show source file in small font Link from subsection-numbering to it's cross reference table entry 1.4. The documentation-entry and documentation-section clauses
(define (subsection-numbering) (string-append (as-string section-number) "." (as-string subsection-number))) Show source file in small font Link from present-documentation-section to it's cross reference table entry 5.1. The function documentation-contents 5.6. Linking between documentation sections and entries. 7.6. Local table of contents
(define (present-documentation-section doc-el) (let* ((title (get-value 'title doc-el)) (section-numbering (get-value 'numbering doc-el)) (section-number (car (get-value 'raw-numbering doc-el))) ; an integer (title-1 (con section-numbering (horizontal-space 2) title)) (intro (get-value 'intro doc-el)) (id (get-value 'id doc-el)) (hidden-id-pres (font 2 documentation-entry-color (as-string id))) (subsection-elements (filter (subsections? section-number) documentation-elements)) ) (con (a-name (internal-reference id)) (con (color-frame-width (con (section-navigation-banner doc-el) (horizontal-space 1) (if present-hidden-ids? hidden-id-pres "") (br) ; A linked program source marker to section 5.6:
'Linking between documentation sections and entries.'
Mark char: i (b (con-space (font-size 5 title-1) )) (br) (do-program-link-documentation intro id) ) documentation-section-color "1200") (indent-pixels 10 (brl (map present-documentation-subsection-element subsection-elements))) ) (vertical-space 1)))) Show source file in small font Link from present-documentation-entry to it's cross reference table entry 5.1. The function documentation-contents 5.6. Linking between documentation sections and entries.
(define (present-documentation-entry doc-el) (let* ((title (get-value 'title doc-el)) (entry-numbering (get-value 'numbering doc-el)) (title-1 (con entry-numbering (horizontal-space 2) title)) (body (get-value 'body doc-el)) (id (get-value 'id doc-el)) (hidden-id-pres (font 2 documentation-entry-color (as-string id))) ) (con (a-name (internal-reference id)) (color-frame-width (con-space (section-navigation-banner doc-el) (if present-hidden-ids? hidden-id-pres "") (br) ; A linked program source marker to section 5.6:
'Linking between documentation sections and entries.'
Mark char: i (b (font-size 4 title-1)) ) documentation-entry-color "1200") (do-program-link-documentation body id) (vertical-space 2)))) ; return a predicate which return #t on entries in section n Show source file in small font Link from subsections? to it's cross reference table entry 5.6. Linking between documentation sections and entries. 7.6. Local table of contents
(define (subsections? n) (lambda (doc-el) (let ((kind (get-value 'kind doc-el)) (raw-num (get-value 'raw-numbering doc-el))) (and (eq? kind 'entry) (eq? n (car raw-num)))))) ; return a more general predicate which returns #t on entry n.m ; n.0 means section n Show source file in small font Link from section-subsection? to it's cross reference table entry 5.6. Linking between documentation sections and entries.
(define (section-subsection? n m) (lambda (doc-el) (let ((raw-num (get-value 'raw-numbering doc-el))) (and (eq? n (car raw-num)) (eq? m (cadr raw-num)))))) Show source file in small font Link from present-author-info to it's cross reference table entry 
(define (present-author-info au) (let ((au1 (if (not (null? au)) (cons (copyright-owner (car au)) (cdr au)) au))) (h 3 (con (apply con (map (lambda (e) (con e (horizontal-space 4))) au1)) )))) Show source file in small font Link from present-abstract to it's cross reference table entry 
(define (present-abstract abstr) (let ((width 1200)) (con (color-frame-width (em (con (b "Abstract. ") abstr)) grey2 width) (p)) )) Show source file in small font Link from guard-text to it's cross reference table entry 
(define (guard-text str) (if str str "???")) Show source file in small font Link from make-source-program-file to it's cross reference table entry 1.3. Overall documentation processing forms.  2. Making the program pages 2.1. Getting started: the top level functions
(define (make-source-program-file source-key source-file language source-list defining-names documented-names size) (elucidate-program-source source-file (string-append (html-directory) source-key (if (eq? size 'large) "-LARGE" "") ".html") source-list defining-names documented-names size source-key)) ; --------------------------------------------------------------------------------------------------- ; ; transform words surrounded by curly brackets (or more correctly, p-link-prefix-char and p-link-suffix-char) ; to links to one of the source programs. Use the information in the global variable ; defining-name-occurences to do so. Show source file in small font Link from linking-output-factor to it's cross reference table entry 
(define linking-output-factor 10) Show source file in small font Link from do-program-link-documentation to it's cross reference table entry 5.1. The function documentation-contents 5.2. The function do-program-link-documentation 10.8. Pretty printing syntactical comments
(define (do-program-link-documentation str doc-id) (let* ((strlgt (string-length str)) (outmax (+ 900 (* linking-output-factor strlgt))) (res-str (make-string outmax #\space)) ; estimate - perhaps not enough ) (set! state-list '()) (do-program-link-documentation-1 doc-id str 0 strlgt res-str 0 outmax 'normal-text ""))) Show source file in small font Link from state-list to it's cross reference table entry 
(define state-list '()) ; for debugging purposes Show source file in small font Link from debugging-program-linking to it's cross reference table entry 
(define debugging-program-linking #f) Show source file in small font Link from do-program-link-documentation-1 to it's cross reference table entry 5.2. The function do-program-link-documentation
(define (do-program-link-documentation-1 doc-id instr inptr inlength outstr outptr outlength current-state collected-word) (if (>= outptr (- outlength 500)) (error "do-program-link-documentation-1: Close to output string overflow. Make linking-output-factor larger")) (if (= inptr inlength) (substring outstr 0 outptr) (let* ((inch (string-ref instr inptr)) (trans-res (program-linking-transition current-state inch collected-word doc-id)) (next-state (car trans-res)) (toput (as-string (cadr trans-res))) (collected-word (caddr trans-res)) ) (if debugging-program-linking (set! state-list (cons (list (as-string inch) next-state collected-word) state-list))) (put-into-string! outstr outptr toput) (do-program-link-documentation-1 doc-id instr (+ 1 inptr) inlength outstr (+ outptr (string-length toput)) outlength next-state collected-word) ))) ; STATES ; normal-text: We are outside a name from which to link ; inside-marker: We have just seen a program source mark ; end-marker: About to output marker or mark literal ; inside-p-link-word: We are inside a word from which to link to program ; entering-p-link-word ; leaving-p-link-word ; inside-d-link-word: We are inside a word from which to link to another section in the documentation ; entering-d-link-word ; leaving-d-link-word Show source file in small font Link from program-linking-transition to it's cross reference table entry 2.6. Marking detailed places in a program 5.2. The function do-program-link-documentation 5.3. The state machines which transform the documentation bodies 5.7. Linking from source markers in the documentation. 5.8. Preparing the linking to the documentation source markers.
(define (program-linking-transition in-state ch collected-word doc-id) (let ((char (as-string ch)) (expl (string-append "A link to a program source marker in " (as-string previous-strong-program-word)))) (cond ((and (symbol? in-state) (eq? in-state 'normal-text)) (cond ((equal? char p-link-prefix-char) (list 'entering-p-link-word "" collected-word)) ((equal? char d-link-prefix-char) (list 'entering-d-link-word "" collected-word)) ((equal? char p-link-suffix-char) (display-warning "Misplaced end-of-link char") (list 'normal-text "" collected-word)) ((equal? char elucidator-marker-char-string) (list 'inside-marker "" "")) ((equal? char elucidator-escape-char-string) (list 'normal-text-escape "" collected-word)) (else (list 'normal-text char collected-word)))) ((and (symbol? in-state) (eq? in-state 'inside-marker)) ; char identifies the marker (cond ((or (equal? char p-link-suffix-char) (equal? char p-link-prefix-char) (equal? char d-link-prefix-char) (equal? char d-link-suffix-char)) (display-warning "Unexpected marker char") (list 'normal-text (string-append elucidator-marker-char-string char) collected-word)) (else (list 'normal-text (begin (source-mark-register previous-strong-program-word doc-id char) (con (source-mark-anchor (source-marker-glyph char expl) char) ; A linked program source marker to section 2.6:
'Marking detailed places in a program'
The relation is ambiguous.
The other relevant sections are 5.7, 5.8
Mark char: a (a-name (string-append (as-string doc-id) "-" "@" (as-string char))))) collected-word)) )) ((and (symbol? in-state) (eq? in-state 'normal-text-escape)) (cond (else (list 'normal-text char collected-word)))) ((and (symbol? in-state) (eq? in-state 'entering-p-link-word)) (cond ((equal? char p-link-suffix-char) (display-warning "Empty link word") (list 'leaving-p-link-word "" collected-word)) ((equal? char p-link-prefix-char) (display-warning "Misplaced begin-of-link char") (list 'inside-p-link-word "" collected-word)) ((or (equal? char d-link-prefix-char) (equal? char d-link-prefix-char)) (display-warning "Misplaced documentation link char") (list 'inside-p-link-word "" collected-word)) (else (list 'inside-p-link-word "" char)))) ((and (symbol? in-state) (eq? in-state 'entering-d-link-word)) (cond ((equal? char d-link-suffix-char) (display-warning "Empty link word") (list 'leaving-d-link-word "" collected-word)) ((equal? char d-link-prefix-char) (display-warning "Misplaced begin-of-link char") (list 'inside-d-link-word "" collected-word)) ((or (equal? char p-link-prefix-char) (equal? char p-link-prefix-char)) (display-warning "Misplaced program link char") (list 'inside-d-link-word "" collected-word)) (else (list 'inside-d-link-word "" char)))) ((and (symbol? in-state) (eq? in-state 'inside-p-link-word)) (cond ((equal? char p-link-suffix-char) (list 'leaving-p-link-word (linking-from-doc-to-prog collected-word doc-id) "")) ((equal? char p-link-prefix-char) (display-warning "Misplaced begin-of-link prog char") (list 'inside-p-link-word "" collected-word)) ((or (equal? char d-link-prefix-char) (equal? char d-link-prefix-char)) (display-warning "Misplaced documentation link char") (list 'inside-p-link-word "" collected-word)) (else (list 'inside-p-link-word "" (string-append collected-word char))))) ((and (symbol? in-state) (eq? in-state 'inside-d-link-word)) (cond ((equal? char d-link-suffix-char) (list 'leaving-d-link-word (linking-from-doc-to-doc collected-word doc-id) "")) ((equal? char d-link-prefix-char) (display-warning "Misplaced begin-of-link doc char") (list 'inside-d-link-word "" collected-word)) ((or (equal? char p-link-prefix-char) (equal? char p-link-prefix-char)) (display-warning "Misplaced program link char") (list 'inside-d-link-word "" collected-word)) (else (list 'inside-d-link-word "" (string-append collected-word char))))) ((and (symbol? in-state) (eq? in-state 'leaving-p-link-word)) (cond ((equal? char p-link-suffix-char) (display-warning "Misplaced end-of-link prog char") (list 'leaving-p-link-word "" collected-word)) ((equal? char p-link-prefix-char) (list 'inside-p-link-word "" collected-word)) ; ?? ((equal? char d-link-prefix-char) (list 'inside-d-link-word "" collected-word)) ; ?? (else (list 'normal-text char collected-word)))) ((and (symbol? in-state) (eq? in-state 'leaving-d-link-word)) (cond ((equal? char d-link-suffix-char) (display-warning "Misplaced end-of-link doc char") (list 'leaving-p-link-word "" collected-word)) ((equal? char p-link-prefix-char) (list 'inside-p-link-word "" collected-word)) ; ?? ((equal? char d-link-prefix-char) (list 'inside-d-link-word "" collected-word)) ; ?? (else (list 'normal-text char collected-word)))) (else (error "program-linking-transition error: unknown state")) ))) ; add an entry to the variable documentation-source-marker-occurences Show source file in small font Link from source-mark-register to it's cross reference table entry 5.8. Preparing the linking to the documentation source markers.
(define (source-mark-register previous-strong-program-word doc-id char) (set! documentation-source-marker-occurences (cons (list previous-strong-program-word doc-id char) documentation-source-marker-occurences))) ;; This function is called during the traversal of a documentation body. ;; It returns the a-tag'ed and fonted link word, which links to another place in the documentation Show source file in small font Link from linking-from-doc-to-doc to it's cross reference table entry 5.2. The function do-program-link-documentation 5.3. The state machines which transform the documentation bodies 5.4. The functions which returns a link to a program unit or a documentation unit
(define (linking-from-doc-to-doc collected-word doc-id) (let* ((ass (assq (as-symbol collected-word) documentation-key-numbering-alist)) (ref-number (if ass (cdr ass) #f)) (url (if ref-number (string-append "documentation.html" "#" collected-word) #f))) (if url (a-tag-target url (font-color documentation-documentation-link-color ref-number) "documentation-frame") (begin (display-warning (string-append "Cannot find a linking target of the documentation linking word: " collected-word)) collected-word)))) ; previous strong word relation in the documentation Show source file in small font Link from previous-strong-program-word to it's cross reference table entry 5.7. Linking from source markers in the documentation.
(define previous-strong-program-word #f) ;; This function is called during the traversal of a documentation body. ;; It returns the a-tag'ed and fonted link word. ;; As a side-effect, it collects the documented names in the list documented-name-occurences. Show source file in small font Link from linking-from-doc-to-prog to it's cross reference table entry 5.2. The function do-program-link-documentation 5.3. The state machines which transform the documentation bodies 5.4. The functions which returns a link to a program unit or a documentation unit 5.5. Refined linking possibilities 5.7. Linking from source markers in the documentation.
(define (linking-from-doc-to-prog word doc-id) (let* ((kind (kind-of-program-link? word)) (strong? (eq? kind 'strong)) (strong-weak-symbol (if strong? 'strong 'weak)) (word-1 (cond ((eq? kind 'strong) (linking-word-of-strong-link word)) ((eq? kind 'none) (linking-word-of-other-link word)) ((and (eq? kind 'weak) (eq? #\+ (string-ref word 0))) (linking-word-of-other-link word)) (else word))) (link-targets (filter (lambda (dno) (equal? word-1 (as-string (car dno)))) defining-name-occurences))) (cond ((eq? kind 'none) ; no linking, only fonting (font-color none-reference-color (kbd word-1))) ((= (length link-targets) 0) (display-warning (string-append "Documentation to program linking: Cannot find linking target of " word-1)) word-1) ((= (length link-targets) 1) (let ((source-key (cdr (car link-targets)))) (if strong? (set! previous-strong-program-word word-1)) ; A linked program source marker to section 5.7:
'Linking from source markers in the documentation.'
Mark char: i (set! documented-name-occurences (cons (list (as-symbol word-1) doc-id strong-weak-symbol) documented-name-occurences)) (html:a (font-color (if strong? documentation-program-link-color documentation-program-link-color-weak) (kbd word-1)) 'href (string-append source-key ".html" "#" word-1) 'target "program-frame" 'title source-key 'style (if underline-documentation-links "{text-decoration: underline;}" "{text-decoration: none;}") ) )) ((>= (length link-targets) 1) (let ((source-key (cdr (car link-targets)))) (if strong? (set! previous-strong-program-word word-1)) ; A linked program source marker to section 5.7:
'Linking from source markers in the documentation.'
Mark char: h (set! documented-name-occurences (cons (list (as-symbol word-1) doc-id strong-weak-symbol) documented-name-occurences)) (display-warning (string-append "Documentation to program linking: Multiple targets of " word-1 ". " "Using that in " source-key)) (html:a (font-color (if strong? documentation-program-link-color documentation-program-link-color-weak) word-1) 'href (string-append source-key ".html" "#" word-1) 'target "program-frame" 'title source-key 'style (if underline-documentation-links "{text-decoration: underline;}" "{text-decoration: none;}") ) ))))) ; does the program link word start with a strong-link-char Show source file in small font Link from strong-program-link? to it's cross reference table entry 5.5. Refined linking possibilities
(define (strong-program-link? word) (if (>= (string-length word) 1) (eq? (string-ref word 0) strong-link-char) #f)) ; Return a symbol which classifies the linking word. ; Possible results are the symbols strong, weak, none. ; If word is empty, return #f Show source file in small font Link from kind-of-program-link? to it's cross reference table entry 
(define (kind-of-program-link? word) (if (>= (string-length word) 1) (let ((ch (string-ref word 0))) (cond ((eq? ch strong-link-char) 'strong) ((eq? ch weak-link-char) 'weak) ((eq? ch none-link-char) 'none) (else 'weak))) #f)) ; Disregard the initial star of star-word. Assume that there is an initial star in star-word Show source file in small font Link from linking-word-of-strong-link to it's cross reference table entry 5.5. Refined linking possibilities
(define (linking-word-of-strong-link star-word) (substring star-word 1 (string-length star-word))) ; Happens to be identical to linking-word-of-strong-link Show source file in small font Link from linking-word-of-other-link to it's cross reference table entry 
(define (linking-word-of-other-link link-word) (substring link-word 1 (string-length link-word))) ; --------------------------------------------------------------------------------------------------- ; ; Return a list of duplicates in name-def-list. ; Name-def-list is a list of name-entries. A name entry is of the ; form (name-symbol source-key-string). Show source file in small font Link from duplicated-definitions to it's cross reference table entry 7.3. The duplicated name index
(define (duplicated-definitions name-def-list) (let* ((sorted-names (sort-list name-def-list name-entry-leq?)) (paired-names (if (null? sorted-names) '() (pair-up sorted-names (cdr sorted-names)))) (filtered-pairs (filter (lambda (p) (eq? (car (car p)) (car (cdr p)))) paired-names)) (duplicate-names (map caar filtered-pairs))) (filter (lambda (ne) (memq (car ne) duplicate-names)) sorted-names))) Show source file in small font Link from present-duplicated-definitions to it's cross reference table entry 7.3. The duplicated name index 8.1. Some HTML details.
(define (present-duplicated-definitions) (let ((dd (duplicated-definitions defining-name-occurences))) (con (indent-pixels 10 (multi-column-list 4 (map present-a-duplicate dd) browser-pixel-width)) (font-size 1 (em "Navigation to duplicates in the same source file is not supported"))))) ; Present a single duplicate. d is a pair of (name . source-key) Show source file in small font Link from present-a-duplicate to it's cross reference table entry 
(define (present-a-duplicate d) (con (a-tag-target (string-append (cdr d) ".html" "#" (as-string (car d))) (font-size 2 (con (as-string (car d)))) "program-frame") (font-size 2 (con " in file " (cdr d))))) Show source file in small font Link from name-entry-leq? to it's cross reference table entry 7.4. The defined name index
(define (name-entry-leq? x y) (string<=? (as-string (car x)) (as-string (car y)))) ; --------------------------------------------------------------------------------------------------- ;; Index support: total index of all defining name occurences. Show source file in small font Link from present-defined-name-index to it's cross reference table entry 7.4. The defined name index 8.1. Some HTML details.
(define (present-defined-name-index sorted-defining-name-occurences) (con (indent-pixels 10 (multi-column-list 6 (map present-a-defining-name-entry sorted-defining-name-occurences) browser-pixel-width)) )) Show source file in small font Link from present-a-defining-name-entry to it's cross reference table entry 7.4. The defined name index
(define (present-a-defining-name-entry d) (let ((sourcefile (cdr d))) (html:a (font 2 defined-color (con (as-string (car d)))) 'href (string-append sourcefile ".html" "#" (as-string (car d))) 'target "program-frame" 'title sourcefile))) ; --------------------------------------------------------------------------------------------------- ;; Index support: cross references involving both applied and defining name occurences Show source file in small font Link from applied-names-multiple-sources to it's cross reference table entry 6.1. Overview 6.2. The function applied-names-multiple-sources.
(define (applied-names-multiple-sources source-list-list) (sort-list (accumulate-right append '() (map applied-names source-list-list)) name-entry-leq?)) Show source file in small font Link from applied-names to it's cross reference table entry 6.2. The function applied-names-multiple-sources.
(define (applied-names source-list) (applied-names-1 source-list '())) Show source file in small font Link from applied-names-1 to it's cross reference table entry 6.2. The function applied-names-multiple-sources.
(define (applied-names-1 source-list res) (cond ((null? source-list) res) ((define-form? (car source-list)) (let* ((define-form (car source-list)) (def-name (defined-name define-form)) (this-contribution (map (lambda (appl-name) (cons appl-name def-name)) (applied-names-one-form define-form)))) (applied-names-1 (cdr source-list) (append this-contribution res)))) (else (applied-names-1 (cdr source-list) res)) ; drop (car source-list) because it is a non-define form )) Show source file in small font Link from applied-names-one-form to it's cross reference table entry 6.2. The function applied-names-multiple-sources. 6.3. Extracting applied names from a single form.
(define (applied-names-one-form f) (cond ((eof-object? f) ; nothing ) ((symbol? f) (if (defining-in-batch? f) (list f) '())) ((string? f) '()) ((number? f) '()) ((char? f) '()) ((boolean? f) '()) ((vector? f) (error "applied-names-one-form: vector not supported yet")) ((and (list? f) (null? f)) '()) ; special processing of forms with defining names ((and (list? f) (function-define-form? f)) (applied-names-one-form (cdddr f))) ((and (list? f) (define-form? f)) (applied-names-one-form (cddr f))) ((and (list? f) (lambda-form? f)) (applied-names-one-form (cddr f))) ((and (list? f) (let-form? f)) (append (applied-names-one-form (let-vals f)) (applied-names-one-form (cddr f)))) ((list? f) (append (applied-names-one-form (car f)) (applied-names-one-form (cdr f)))) ((pair? f) ; improper list (let ((p1 (proper-part f)) (p2 (first-improper-part f))) (append (applied-names-one-form p1) (applied-names-one-form p2)) )) (else (error (string-append "applied-names-one-form: unknown kind of expression" (as-string f)))))) Show source file in small font Link from defining-in-batch? to it's cross reference table entry 6.3. Extracting applied names from a single form.
(define (defining-in-batch? name) (if (assq name defining-name-occurences) #t #f)) Show source file in small font Link from function-define-form? to it's cross reference table entry 
(define (function-define-form? x) (and (list? x) (> (length x) 2) (eq? (car x) 'define) (symbol? (cadr x)) (pair? (caddr x)))) Show source file in small font Link from lambda-form? to it's cross reference table entry 
(define (lambda-form? x) (and (list? x) (> (length x) 2) (eq? (car x) 'lambda))) Show source file in small font Link from let-form? to it's cross reference table entry 
(define (let-form? x) (and (list? x) (> (length x) 2) (or (eq? (car x) 'let) (eq? (car x) 'let*) (eq? (car x) 'letrec)))) ; Return a list of expressions bound to names in let-form Show source file in small font Link from let-vals to it's cross reference table entry 6.3. Extracting applied names from a single form.
(define (let-vals let-form) (let ((binding-forms (if (named-let? let-form) (caddr let-form) (cadr let-form)))) (accumulate-right append '() (map cdr binding-forms)))) ; Return a list of names bound in let-form Show source file in small font Link from let-names to it's cross reference table entry 
(define (let-names let-form) (let ((binding-forms (if (named-let? let-form) (caddr let-form) (cadr let-form)))) (accumulate-right append '() (map (lambda (b) (list (car b))) binding-forms)))) Show source file in small font Link from named-let? to it's cross reference table entry 
(define (named-let? let-form) (symbol? (cadr let-form))) ; Return the formal parameter names of a lamba construct. Always returns a list. ; The paramter lambda-form must be a lambda expression. Show source file in small font Link from lambda-names to it's cross reference table entry 
(define (lambda-names lambda-form) (let ((par-list (cadr lambda-form))) (cond ((list? par-list) par-list) ((symbol? par-list) (list par-list)) ((pair? par-list) (append (proper-part par-list) (list (first-improper-part par-list)))) (error "lambda name: unknown kind of the lambda form's parameter list")))) ; --------------------------------------------------------------------------------------------------- ; Presentation of cross references Show source file in small font Link from present-cross-reference-index to it's cross reference table entry 7.1. The cross reference index 7.2. Alphabetically organized cross reference indexes 8.1. Some HTML details.
(define (present-cross-reference-index appl-def-name-list-1) (let* ((appl-def-name-sublisted ; A linked program source marker to section 7.1:
'The cross reference index'
Mark char: a (sublist-by-predicate appl-def-name-list-1 (lambda (x y n) (not (eq? (car x) (car y)))))) (appl-def-name-sublisted-1 ; A linked program source marker to section 7.1:
'The cross reference index'
Mark char: b (map (lambda (sublist) (remove-duplicates-by-predicate sublist (lambda (x y) (eq? (cdr x) (cdr y))))) appl-def-name-sublisted)) ) (indent-pixels 5 (table-3 0 (list 200 1000) (map present-applied-sublist appl-def-name-sublisted-1))))) Show source file in small font Link from present-applied-sublist to it's cross reference table entry 7.1. The cross reference index
(define (present-applied-sublist sl) (let* ((sorted-sl (sort-list sl (lambda (x y) (string<=? (as-string (cdr x)) (as-string (cdr y)))))) (appl-name (car (car sl))) ; take the first element of an arbitrary entry, the first (def-table (multi-column-list 5 (map present-defined-entry sorted-sl) (- browser-pixel-width 200))) (sourcefile (source-key-of-defining-name appl-name))) (list (con (a-name (as-string appl-name)) ; name this entry in the cross reference index, allows direct access to entry from program (box ; box it in order to allign with def-table (html:a (b (font 2 defined-color (as-string appl-name))) 'href (string-append sourcefile ".html" "#" (as-string appl-name)) 'target "program-frame" 'title sourcefile))) def-table))) Show source file in small font Link from present-defined-entry to it's cross reference table entry 7.1. The cross reference index
(define (present-defined-entry appl-def-entry) (let* ((appl-name (car appl-def-entry)) (def-name (cdr appl-def-entry)) (sourcefile (source-key-of-defining-name def-name)) ) (if def-name (html:a (font-size 2 (con (as-string def-name))) 'href (string-append sourcefile ".html" "#" (as-string def-name)) 'target "program-frame" 'title sourcefile) (font-size 2 (em "not used"))))) ; lookup the source key (file name information) of the name in defining-name-occurences. Show source file in small font Link from source-key-of-defining-name to it's cross reference table entry 
(define (source-key-of-defining-name name) (let ((res (filter (lambda (dno) (eq? name (car dno))) defining-name-occurences))) (cond ((= (length res) 0) "??") ; question mark, leading to undefined link ((= (length res) 1) (cdr (car res))) ; the normal case ((> (length res) 1) (cdr (car res))) ; we take the first ))) ; Merge the def-applied-list and the def-list to a single list. ; Both def-applied-list and the result are alist with entries of the form (name . name-of-definition). ; def-list is just a list of pairs of the form (name . #f) reflecting all the definitions in the documentation bundle. ; The resulting list is also sorted. Show source file in small font Link from merge-defined-and-defined-applied-lists to it's cross reference table entry 7.1. The cross reference index
(define (merge-defined-and-defined-applied-lists def-applied-list def-list) (merge-defined-and-defined-applied-lists-1 def-applied-list def-list '())) ; The special purpose asymmetric merge used above. Show source file in small font Link from merge-defined-and-defined-applied-lists-1 to it's cross reference table entry 
(define (merge-defined-and-defined-applied-lists-1 lst1 lst2 res) (letrec ((lt-cars? (lambda (x y) (string<? (as-string (car x)) (as-string (car y))))) (eq-cars? (lambda (x y) (eq? (car x) (car y)))) ) (cond ((and (null? lst1) (null? lst2)) (reverse res)) ((null? lst1) (append (reverse res) lst2)) ((null? lst2) (append (reverse res) lst1)) ((eq-cars? (car lst1) (car lst2)) ; normal case (merge-defined-and-defined-applied-lists-1 (cdr lst1) (cdr lst2) (cons (car lst1) res))) ((lt-cars? (car lst1) (car lst2)) ; should not happen (merge-defined-and-defined-applied-lists-1 (cdr lst1) lst2 (cons (car lst1) res))) ((lt-cars? (car lst2) (car lst1)) ; if there is a defined name which is not applied (merge-defined-and-defined-applied-lists-1 lst1 (cdr lst2) (cons (car lst2) res))) (else (error "merge-defined-and-defined-applied-lists-1: should not happen!"))))) ; Present the doc-elements in a two column list. If kind is 'detail show toc entries for both ; sections and entries. If kind is 'overall only show sections. Show source file in small font Link from present-documentation-contents to it's cross reference table entry 7.5. Making the table of contents 8.1. Some HTML details.
(define (present-documentation-contents doc-elements kind) (let ((doc-elements-1 (cond ((eq? kind 'detail) doc-elements) ((eq? kind 'overall) (filter (lambda (e) (eq? (get-value 'kind e) 'section)) doc-elements))))) (n-column-list (if (eq? kind 'detail) toc-columns-detail toc-columns-overall) (map present-documentation-content-element doc-elements-1) browser-pixel-width))) Show source file in small font Link from present-documentation-content-element to it's cross reference table entry 7.5. Making the table of contents
(define (present-documentation-content-element element) (let ((kind (get-value 'kind element)) (doc-id (get-value 'id element)) (n (get-value 'numbering element)) (ttl (get-value 'title element))) (font-size 2 (con (cond ((eq? kind 'entry) (horizontal-space 4)) ((eq? kind 'section) "") (else (error "present-documentation-content-element: unknown kind of documentation element"))) n (horizontal-space 2) (a-tag-target (string-append "documentation.html" "#" (as-string doc-id)) ttl "documentation-frame" ))))) ; Return a string which represents an entry in a local table of contents ; within a documentation section Show source file in small font Link from present-documentation-subsection-element to it's cross reference table entry 7.6. Local table of contents
(define (present-documentation-subsection-element element) (let ((doc-id (get-value 'id element)) (n (get-value 'numbering element)) (ttl (get-value 'title element))) (font-size 2 (con n (horizontal-space 2) (a-tag-target (string-append "documentation.html" "#" (as-string doc-id)) (font-color black ttl) "documentation-frame" ))))) ; -------------------------------------------------------------------------------------------------- ;;; Support of a simple, line-base documentation text format. ;;; This is an alternative to the lisp format based on documentation-entry and documentation-section ;;; forms. ; The format is ; ; .SECTION eee ; .TITLE ttt ; .BODY ; Section text ; More section text ; .END ; ----------------------------------------------------------------------------- ; ; .ENTRY eee ; .TITLE ttt ; .BODY ; Entry text ; More entry text ; .END ; ----------------------------------------------------------------------------- ; ; A line starting with -- is a comment ; The lines formed of dashes are comments, and thus ignored ;; Extract and parse documentation from a simple text file. ;; Translate to the documentation-section and -entry forms, and evaluate these. ;; Thus, a documentation-from clause is equivalent to the sequence of documentation-section ;; and documentation-entry forms represented by the clause ;; file is just a name without prefix path. The file is opened in the source-directory Show source file in small font Link from documentation-from to it's cross reference table entry 1.2. Organization of the setup file 1.3. Overall documentation processing forms.  4.2. The overall ideas 4.3. The top level functions.
(define (documentation-from file) (display-message (string-append "Parsing the textual documentation file")) (reset-collection) (let* ((ip (open-input-file (string-append source-directory file)))) (documentation-intro-from-port ip) (documentation-units-from-port ip) (close-input-port ip))) Show source file in small font Link from documentation-intro-from-port to it's cross reference table entry 4.3. The top level functions.
(define (documentation-intro-from-port ip) (let ((skip1 (skip-while white-space-or-separator? ip)) (intro (accept-documentation-intro ip))) (define-documentation-intro! intro))) Show source file in small font Link from documentation-units-from-port to it's cross reference table entry 4.3. The top level functions.
(define (documentation-units-from-port ip) (let ((skip1 (skip-while white-space-or-separator? ip)) (unit (accept-documentation-unit ip)) (separator-skip (skip-while white-space-or-separator? ip))) (if (unit-ok? unit) (define-unit! unit) (error (string-append "documenation-from-port: Malformed documentation unit: " (as-string unit)))) (if (not (eof-object? next-doc-char)) (documentation-units-from-port ip)))) Show source file in small font Link from unit-ok? to it's cross reference table entry 
(define (unit-ok? unit) #t) ; not used Show source file in small font Link from unit-list to it's cross reference table entry 
(define unit-list '()) Show source file in small font Link from define-unit! to it's cross reference table entry 4.3. The top level functions.
(define (define-unit! unit) (let ((doc-form (make-documentation-form unit))) (set! unit-list (cons doc-form unit-list)) (eval doc-form))) Show source file in small font Link from define-documentation-intro! to it's cross reference table entry 4.3. The top level functions.
(define (define-documentation-intro! intro-list) (documentation-intro (first intro-list) (second intro-list) (third intro-list) (fourth intro-list) (fifth intro-list))) ; Transform a unit, as extracted from the documentation, to a documentation-entry or documentation-section Lisp form Show source file in small font Link from make-documentation-form to it's cross reference table entry 4.3. The top level functions.
(define (make-documentation-form unit) (let* ((kind-string (car (car unit))) (kind (cond ((equal? kind-string ".ENTRY") 'documentation-entry) ((equal? kind-string ".SECTION") 'documentation-section) (else (error "make-documentation-form: Unknown documentation kind")))) (id (as-symbol (cadr (car unit)))) (title (cadr unit)) (body (caddr unit))) (list kind (list 'id (list 'quote id)) (list 'title title) (if (eq? kind 'documentation-entry) (list 'body body) (list 'intro body))))) Show source file in small font Link from accept-documentation-unit to it's cross reference table entry 4.3. The top level functions. 4.5. The accept functions
(define (accept-documentation-unit ip) (let ((id (accept-doc-id ip)) (ttl (accept-doc-title ip)) (bd (accept-doc-body ip))) (list id ttl bd))) Show source file in small font Link from accept-documentation-intro to it's cross reference table entry 4.3. The top level functions. 4.5. The accept functions
(define (accept-documentation-intro ip) ; title, author, email, affiliation, and abstract (let ((ttl (accept-doc-title ip)) (aut (accept-doc-author ip)) (email (accept-doc-email ip)) (af (accept-doc-affiliation ip)) (abstr (accept-doc-abstract ip))) (list ttl aut email af abstr))) Show source file in small font Link from accept-doc-author to it's cross reference table entry 4.5. The accept functions
(define (accept-doc-author ip) (let* ((keyword (collect-until is-white-space? ip)) (res (doc-check (equal? keyword ".AUTHOR") ".AUTHOR expected")) (skip1 (skip-while is-white-space? ip)) (res (collect-until end-of-line? ip)) (skip2 (skip-while is-white-space? ip))) res)) Show source file in small font Link from accept-doc-email to it's cross reference table entry 4.5. The accept functions
(define (accept-doc-email ip) (let* ((keyword (collect-until is-white-space? ip)) (res (doc-check (equal? keyword ".EMAIL") ".EMAIL expected")) (skip1 (skip-while is-white-space? ip)) (res (collect-until end-of-line? ip)) (skip2 (skip-while is-white-space? ip))) res)) Show source file in small font Link from accept-doc-affiliation to it's cross reference table entry 4.5. The accept functions
(define (accept-doc-affiliation ip) (let* ((keyword (collect-until is-white-space? ip)) (res (doc-check (equal? keyword ".AFFILIATION") ".AFFILIATION expected")) (skip1 (skip-while is-white-space? ip)) (res (collect-until end-of-line? ip)) (skip2 (skip-while is-white-space? ip))) res)) Show source file in small font Link from accept-doc-abstract to it's cross reference table entry 4.5. The accept functions
(define (accept-doc-abstract ip) (let* ((keyword (collect-until is-white-space? ip)) (res (doc-check (equal? keyword ".ABSTRACT") ".ABSTRACT expected")) (skip1 (skip-while is-white-space? ip)) (body (accept-body-text ip))) body)) ; assume the next char is the dot in ENTRY or SECTION Show source file in small font Link from accept-doc-id to it's cross reference table entry 4.5. The accept functions
(define (accept-doc-id ip) (let* ((unit (collect-until is-white-space? ip)) (res (doc-check (or (equal? unit ".ENTRY") (equal? unit ".SECTION")) ".ENTRY or .SECTION expected")) (skip1 (skip-while is-white-space? ip)) (id (collect-until is-white-space? ip)) (skip2 (skip-while is-white-space? ip))) (list unit id))) Show source file in small font Link from accept-doc-title to it's cross reference table entry 4.5. The accept functions
(define (accept-doc-title ip) (let* ((keyword (collect-until is-white-space? ip)) (res (doc-check (equal? keyword ".TITLE") ".TITLE expected")) (skip1 (skip-while is-white-space? ip)) (ttl (collect-until end-of-line? ip)) (skip2 (skip-while is-white-space? ip))) ttl)) Show source file in small font Link from accept-doc-body to it's cross reference table entry 4.5. The accept functions
(define (accept-doc-body ip) (let* ((keyword (collect-until is-white-space? ip)) (res (doc-check (equal? keyword ".BODY") ".BODY expected")) (skip1 (skip-while is-white-space? ip)) (body (accept-body-text ip))) body)) Show source file in small font Link from accept-body-text to it's cross reference table entry 4.5. The accept functions
(define (accept-body-text ip) (let* ((body-list (reverse (accept-body-text-1 ip '()))) (cr-list (make-list (- (length body-list) 1) cr-string))) (string-merge body-list cr-list))) Show source file in small font Link from cr-string to it's cross reference table entry 
(define cr-string (as-string #\newline)) Show source file in small font Link from accept-body-text-1 to it's cross reference table entry 4.5. The accept functions
(define (accept-body-text-1 ip res) (let ((line (collect-until end-of-line? ip)) (skip1 (eat-eol-chars ip))) (cond ((end-unit? line) res) (else (accept-body-text-1 ip (cons line res)))))) Show source file in small font Link from doc-check to it's cross reference table entry 4.5. The accept functions 4.6. The collection functions
(define (doc-check condition error-text) (if (not condition) (error (string-append "Line " (as-string doc-line-number) ": " error-text)))) Show source file in small font Link from end-unit? to it's cross reference table entry 4.5. The accept functions
(define (end-unit? line) (if (< (string-length line) 4) #f (equal? ".END" (substring line 0 4)))) ; (define (end-unit? line) ; (if (< (string-length line) 4) ; #f ; (let ((res (equal? ".END" (substring line 0 4)))) ; (if res ; (display "end unit") ; (display (string-append "not end unit: " line)) ; ) ; res))) ; ; ; ; ; Collection and skipping functions: Functions to read characters from an input port. ; All functions (as used above) are linebased. As such we can relatively safely assume that there is an upper ; limit on the amount of characters to be collected (although, of course, lines can be long...) ; ; Collection state variables and constants Show source file in small font Link from buffer-length to it's cross reference table entry 4.6. The collection functions
(define buffer-length 10000) Show source file in small font Link from collection-buffer to it's cross reference table entry 4.6. The collection functions
(define collection-buffer (make-string buffer-length #\space)) Show source file in small font Link from next-doc-char to it's cross reference table entry 4.6. The collection functions
(define next-doc-char #f) Show source file in small font Link from doc-line-number to it's cross reference table entry 4.6. The collection functions
(define doc-line-number 1) Show source file in small font Link from reset-collection to it's cross reference table entry 
(define (reset-collection) (set! collection-buffer (make-string buffer-length #\space)) (set! next-doc-char #f) (set! doc-line-number 1)) ; return the string collected from the input port ip. ; collection stops when the predicate p holds holds on the character read. ; The last read character is putted back in the variable next-doc-char Show source file in small font Link from collect-until to it's cross reference table entry 4.5. The accept functions 4.6. The collection functions 4.7. The skipping functions
(define (collect-until p ip) (collect-until-1 p ip collection-buffer 0) ) Show source file in small font Link from collect-until-1 to it's cross reference table entry 4.6. The collection functions
(define (collect-until-1 p ip buffer next) (let ((ch (read-next-doc-char ip))) (if (or (p ch) (eof-object? ch)) (begin (set! next-doc-char ch) (substring buffer 0 next)) (begin (string-set! buffer next ch) (collect-until-1 p ip buffer (+ 1 next)))))) Show source file in small font Link from read-next-doc-char to it's cross reference table entry 4.6. The collection functions 4.7. The skipping functions
(define (read-next-doc-char ip) (if next-doc-char (let ((res next-doc-char)) (set! next-doc-char #f) res) (let ((ch (read-char ip))) (if (and (not (eof-object? ch)) (= 10 (char->integer ch))) (set! doc-line-number (+ doc-line-number 1))) ch))) ; skip characters on ip while p holds Show source file in small font Link from skip-while to it's cross reference table entry 4.5. The accept functions 4.6. The collection functions 4.7. The skipping functions
(define (skip-while p ip) (let ((ch (read-next-doc-char ip))) (if (p ch) (skip-while p ip) (set! next-doc-char ch)))) ; Situation: an eol character (13 (CR) on a PC) is in next-doc-char. ; Drop the buffer, and read a 10 char (LF) if it is there ; Should also work on UNIX Show source file in small font Link from eat-eol-chars to it's cross reference table entry 4.5. The accept functions
(define (eat-eol-chars ip) (let ((ch (read-char ip))) (cond ((eof-object? ch) (set! next-doc-char ch)) ; allow the eof condition to be rediscovered by the context ((= 10 (as-number ch)) (set! next-doc-char #f)) ; force real reading from from ip next time. Buffer is empty (else (set! next-doc-char ch))))) ; put ch in buffer such that it will be read again ; ; not used Show source file in small font Link from skip-once to it's cross reference table entry 
(define (skip-once p ip) (let ((ch (read-next-doc-char ip))) (if (p ch) (let ((ch (read-next-doc-char ip))) (set! next-doc-char ch)) (set! next-doc-char ch)))) ; Useful predicates Show source file in small font Link from is-white-space? to it's cross reference table entry 4.6. The collection functions
(define (is-white-space? ch) (if (eof? ch) #f (let ((n (as-number ch))) (or (eq? n 32) (eq? n 9) (eq? n 10) (eq? n 12) (eq? n 13))))) Show source file in small font Link from white-space-or-separator? to it's cross reference table entry 
(define (white-space-or-separator? ch) (if (eof? ch) #f (or (is-white-space? ch) (eq? #\- ch)))) Show source file in small font Link from end-of-line? to it's cross reference table entry 4.6. The collection functions
(define (end-of-line? ch) (if (eof? ch) #f (let ((n (as-number ch))) (or (eq? n 10) (eq? n 13))))) Show source file in small font Link from eof? to it's cross reference table entry 
(define (eof? ch) (eof-object? ch)) ; --------------------------------------------------------------------------------------------------- ; Test stuff. Delete soon Show source file in small font Link from ttt to it's cross reference table entry 
(define (ttt file) (let* ((ip (open-input-file (string-append source-directory file)))) (tttt ip) (close-input-port ip))) Show source file in small font Link from tttt to it's cross reference table entry 
(define (tttt ip) (let ((ch (read-char ip))) (if (not (is-white-space? ch)) (begin (display ch)) (display (as-number ch))) (if (not (eof-object? ch)) (tttt ip)))) ; --------------------------------------------------------------------------------------------------- ; Procedure making the elucidator help file Show source file in small font Link from make-elucidator-help-page to it's cross reference table entry 8.3. The Help page
(define (make-elucidator-help-page) (let ((kn-email "normark@cs.auc.dk") (kn-www "http://www.cs.auc.dk/~normark/") ) (letrec ((an-entry (lambda (x y) (con (font-color red (b x)) (br) y)))) (write-text-file (page "Elucidator help page" (con-par (h 1 (font-color blue "The Elucidator Help Page")) (con-space "The pages shown in this browser is the result of 'elucidating' a number of programs and a documentation file. The main purpose is to present " (em "internal program documentation") " side by side with a number of source programs. The leftmost window shows the documentation, and the rightmost window one of the programs. The topmost window is a menu and index window, from which a number of aspects can be controlled.") (con-space (em "Elucidative programming") " is variant of " (a-tag "http://www.loria.fr/services/tex/english/litte.html" "literate programming") ", as coined by Knuth in the early eighties. In most literate programming tools (called WEB tools), fragments of programs are defined inside the program documentation. In literate programming, a tool (called tangle) can extract and assemble the program fragments according to the rules of the programming language. Another tool (called weave) formats the documentation, generates indexes, and presents all of it in a nice-looking paper format.") "The main characteristics of elucidative programming in relation to literate programming are:" (ol (list (an-entry "The program source files are not affected at all." "It is not necessary to split the programs into fragments, and to organize these in the context of the program explanations. An existing program source file can be handled.") (an-entry "The program and the documentation are shown side by side." "We do not go for an embedded presentation of the program inside its documentation. Rather, we provide for mutual navigation between program and documentation in a two-frame layout") (an-entry "The program units which we document, are whole abstractions." "Things get simpler when we can settle on documentation of named abstractions instead of arbitrary program fragments (sometimes called 'chunks' or 'scraps')") (an-entry "We support on-line presentation in a browser." "Literate programming tools were primary oriented towards presentation of the weaved results on a static paper medium.") (an-entry "The elucidator tool use specific knowledge about the programming language." (con "The language knowledge is used to identify the names in the program. Applied names are related to their definitions, and the program is decorated with colors and extensive linking. Currently we support the programming language " (a-tag "http://www.cs.indiana.edu/scheme-repository/home.html" "Scheme") ". We wish to support elucidative programming in other languages in the future. ")) (an-entry "Program and documentation indexes are available." "A tables of contents, an index of the program definitions, and a cross reference index is available") (an-entry "The creation of the format, from which the elucidated information is generated, is supported by a special set of editor commands." "In that way it is realistic to handle the practical aspect of documenting a program while it is written") )) (con-space "A " (em "documentation bundle") " consist of a single documentation file, a number of program files, and a setup file. The documentation file is described in very simple, textual format, which allows the use of HTML tags for formatting. As mentioned above, there are no special requirements to the program files. The setup files is a Scheme file, which describes the the constituents of the documentation bundle together with a number of processing parameters. Running the setup file through a Scheme processor generates the HTML pages shown in this browser.") "The icons in the menu and index frame (at the top) are now described:" (table-3 1 (list 100 600) (list (map b (list "Icon" "Explanation")) (list (image "three-frames.gif" "") "Reset the elucidator to vertical layout (the default layout). All frames are reverted to the 'start position'.") (list (image "three-frames-horizontal.gif" "") "Reset the elucidator to a horizontal layout. This is an alternative layout in which the documentation and a selected program are shown under each other, in full width") (list (image "index.gif" "" ) "Presents an index of all defined names in the menu and index frame, just below the icons at the top of the window. The index is pr. default broken into fragments according to starting letter of the defined name.") (list (image "cross-index.gif" "" ) "Presents a cross reference index in the menu and index frame. A cross reference index relates all applied names to the definition, in which they occur. The index is pr. default broken into fragments according to starting letter of the applied name.") (list (image "xx.gif" "") "Present an index of all named defined more than once in the documentation bundle. This is useful information in a Lisp program") (list (image "overall-contents.gif" "") "Present an overall table of contents for the documentation in the menu and index frame. This table of contents only covers the top-level section, but no subsections.") (list (image "contents.gif" "") "Present a table of contents for the documentation in the menu and index frame. This table of contents convers both top-level sections and subsections (also called entries).") (list (image "question-left-arrow.gif" "") "Present an Elucidator help page in the documentation frame to the left") (list (image "question-right-arrow.gif" "") "Present an Elucidator help page in the program frame to the right") ) ) "The icons in the rightmost group allows navigation to each of the program files in a documentation bundle." (con-space "From the documentation frame (to the left) it is possible to adjust the program window, such that a given piece of program is shown. Similarly, from the program frame (to the right), the yellow left arrows " (image "doc-left.gif" "") " can be used to find the section in the documentation, which " (em "explains") " the particular program unit. The light yellow arrows " (image "doc-left-weak.gif" "") " refer to a documentation section which " (em "mentions") " the definition (as opposed to explaining it). We talk about strong and weak relations between the documentation and the program resp. Besides these means of navigation it is possible to navigate inside the documentation frame, and inside the program frames.") (con "Inside the program and inside documentation sections you may find small color bullets like " (image "source-mark-red.gif" "") ". These are called " (em "source markers") ". The source markers are used to point out a particular place in a piece of program, which is discussed in a documentation section. You can click on a source marker in the documentation in order to navigate to the corresponding source marker in the program. Also navigation in the opposite direction is supported from most source markers. The popup text, which appears in most browsers when the cursor rests on a source marker, gives useful additional information about the source marker. Notice that a source marker in the documentation is associated with the closest preceding " (em "strong") " documentation-program relation.") (con-space "The source programs are, by default, shown using a fairly small font size. The small square symbols " (image "small-square.gif" "") " can be used to toggle the program frames to use larger font. Notice that the small square symbol is only shown in certain configurations (when the variable " (kbd "make-large-source-files?") " is true)") (con "The icon " (image "small-green-up-triangle.gif" "") " is an anchor of a link from a definition to an entry in the cross reference index. This link is very convenient because it allows us to follow call chains via the cross reference index: Go from a definition of N to the cross reference entry N. Find via that entry a function F which calls N; Go the cross reference entry of F, and find a function G which calls F, etc.") (con-space "The elucidator is written in Scheme, using the " (a-tag "http://www.cs.auc.dk/~normark/laml/" "LAML") " software packages.") (em "You can use the browser's back button to establish the original contents of this frame, or you can activate the reset elucidator icon in the top left corner to return to the standard layout.") (con-space "Kurt Nørmark" (br) "Aalborg University" (br) kn-email (br) (a-tag kn-www)) ) white black blue blue) (html-destination "elucidator-help") )))) ; --------------------------------------------------------------------------------------------------- ; Source markers ; ; The association between marker characters and colors Show source file in small font Link from marker-associations to it's cross reference table entry 
(define marker-associations (list (list #\a "red" '(255 0 0)) (list #\b "green" '(0 128 0)) (list #\c "blue" '(0 0 255)) (list #\d "black" '(0 0 0)) (list #\e "maroon" '(128 0 0)) (list #\f "grey" '(128 128 128)) (list #\g "purple" '(128 0 128)) (list #\h "silver" '(192 192 192)) (list #\i "tetal" '(0 128 128)) (list #\j "aqua" '(0 255 255)) (list #\k "lime" '(0 255 0)) (list #\l "olive" '(128 128 0)) (list #\m "yellow" '(255 255 0)) (list #\n "navy" '(0 0 128)) (list #\o "fuchsia" '(255 0 255)) )) ; Return a source marker for the characer ch. ; A source marker is graphical image, which identifies a particular place in a source program. Show source file in small font Link from source-marker-image to it's cross reference table entry 2.6. Marking detailed places in a program
(define (source-marker-image ch explanation) (let* ((ch1 (as-char ch)) (ass-res (assq ch1 marker-associations)) (color (if ass-res (cadr ass-res) "error"))) (image (string-append "source-mark-" color ".gif") explanation))) ; Return the source marker glyph (text or image) depending on ch (a char) and the global variable source-marker-kind Show source file in small font Link from source-marker-glyph to it's cross reference table entry 2.6. Marking detailed places in a program
(define (source-marker-glyph ch explanation) (cond ((eq? source-marker-kind 'as-text) (source-marker-text ch #f)) ((eq? source-marker-kind 'as-colored-text) (source-marker-text ch #t)) ((eq? source-marker-kind 'as-image) (source-marker-image ch explanation)) (else (error (string-append "source-marker-glyph: Problems determining the kind of source marker in the documentation: " (as-string source-marker)))))) ; return the string "c marker" where c is a color. ; if color? then color the string by means of font-color application Show source file in small font Link from source-marker-text to it's cross reference table entry 
(define (source-marker-text ch color?) (let* ((ch1 (as-char ch)) (ass-res (assq ch1 marker-associations)) (color (if ass-res (cadr ass-res) "??")) (text (string-append color " " "marker")) (rgb-list (if ass-res (caddr ass-res) '(0 0 0)))) (font-color (if color? rgb-list '(0 0 0)) (b text)))) ; Return an anchor tag of the glyph - typically but not necssarily ; The destination of the anchor is determined by the global variable previous-strong-program-word, ; as encountered earlier in the documentation text. Show source file in small font Link from source-mark-anchor to it's cross reference table entry 5.7. Linking from source markers in the documentation.
(define (source-mark-anchor mark-glyph mark-char) (let ((link-targets (filter (lambda (dno) (equal? previous-strong-program-word (as-string (car dno)))) defining-name-occurences))) (cond ((= (length link-targets) 0) (display-warning (string-append "Linking from source marker in documentation: Cannot find linking target of " word-1)) mark-glyph) ((= (length link-targets) 1) (let ((source-key (cdr (car link-targets)))) (a-tag-target (string-append source-key ".html" "#" previous-strong-program-word "-@" mark-char) mark-glyph "program-frame"))) ((>= (length link-targets) 1) (let ((source-key (cdr (car link-targets)))) (display-warning (string-append "Linking from source marker in documentation: Multiple targets of " previous-strong-program-word)) (a-tag-target (string-append source-key ".html" "#" previous-strong-program-word "-@" mark-char) mark-glyph "program-frame")))))) ; --------------------------------------------------------------------------------------------------- ; Making section navigation banners which allow us to navigate to parrent and sibling sections and entries. ; ; Return a banner which navigates to up, next and down URLs of ; doc-el, which is the elements of a section or entry. Show source file in small font Link from section-navigation-banner to it's cross reference table entry 5.6. Linking between documentation sections and entries.
(define (section-navigation-banner doc-el) (let* ((cur-nums (get-value 'raw-numbering doc-el)) (cur-sect (car cur-nums)) (cur-subsect (cadr cur-nums))) (if (= 0 cur-subsect) ; a section (let ((up (documentation-url "START")) (prev (if (= 1 cur-sect) ; A linked program source marker to section 5.6:
'Linking between documentation sections and entries.'
Mark char: a #f (doc-section-url (- cur-sect 1) 0))) (next (doc-section-url (+ cur-sect 1) 0))) (section-navigation-banner-1 doc-el up prev next)) (let ((up (doc-section-url cur-sect 0)) ; an entry (prev (if (= 1 cur-subsect) ; A linked program source marker to section 5.6:
'Linking between documentation sections and entries.'
Mark char: b #f (doc-section-url cur-sect (- cur-subsect 1)))) (next (doc-section-url cur-sect (+ cur-subsect 1)))) (section-navigation-banner-1 doc-el up prev next))))) ; Return a banner which navigates to the URLs up, prev, and next in doc-el. ; If one of these are #f, present a blind navigation button. ; This function handles the presentation details given the URLS passed as parameters. Show source file in small font Link from section-navigation-banner-1 to it's cross reference table entry 5.6. Linking between documentation sections and entries.
(define (section-navigation-banner-1 doc-el up prev next) (con (if up (a-tag up (image "small-up.gif" "")) (image "small-up-blind.gif" "")) (horizontal-space 1) (if prev (a-tag prev (image "small-prev.gif" "")) (image "small-prev-blind.gif" "")) (horizontal-space 1) (if next (a-tag next (image "small-next.gif" "")) (image "small-next-blind.gif" "")))) ; Return an URL to documentation entry n.m ; if m is 0, we mean section n. ; If no such entry/section exists, return #f Show source file in small font Link from doc-section-url to it's cross reference table entry 5.6. Linking between documentation sections and entries.
(define (doc-section-url n m) (let ((res (filter (section-subsection? n m) documentation-elements))) (cond ((= 1 (length res)) (let ((element (car res))) (documentation-url (get-value 'id element)))) ((= 0 (length res)) #f) ((> (length res) 1) (error (string-append "doc-subsection-url: multiple sections/entries cannot exists: " (as-string n) "." (as-string m))))))) ; --------------------------------------------------------------------------------------------------- ; Splitted cross reference index. Show source file in small font Link from split-defined-applied-names to it's cross reference table entry 7.2. Alphabetically organized cross reference indexes
(define (split-defined-applied-names dan-list) (sublist-by-predicate dan-list (lambda (cur prev n) ; A linked program source marker to section 7.2:
'Alphabetically organized cross reference indexes'
Mark char: a (not (eq? (string-ref (as-string (car cur)) 0) (string-ref (as-string (car prev)) 0)))))) Show source file in small font Link from first-letter-of to it's cross reference table entry 7.2. Alphabetically organized cross reference indexes
(define (first-letter-of x) (as-string (string-ref (as-string x) 0))) ;; makes a cross reference index for a single letter Show source file in small font Link from make-cross-reference-index to it's cross reference table entry 7.2. Alphabetically organized cross reference indexes
(define (make-cross-reference-index da-names letter alphabet) (write-text-file (page (string-append "Alphabetic cross reference index: letter " letter) (con (icon-bar) (b (font 3 blue "Cross reference index: ")) (horizontal-space 2) (alphabetic-link-array-1 "cross-reference-index" alphabet letter) ; at top (present-cross-reference-index da-names) (p) ; fejl! Lav specialiseret udgave (alphabetic-link-array-1 "cross-reference-index" alphabet letter) ; at bottom (vertical-space 8) ) white black black black ) (html-destination (string-append "cross-reference-index" "-" (downcase-string letter))))) ; Make the overall cross reference index, in terms of an alphabet array with links to smaller indexes. Show source file in small font Link from make-overall-cross-reference-index to it's cross reference table entry 7.2. Alphabetically organized cross reference indexes
(define (make-overall-cross-reference-index alphabet) (write-text-file (page "Overall alphabetic cross reference index" (con (icon-bar) (b (font 3 blue "Cross reference index: ")) (horizontal-space 2) (alphabetic-link-array-1 "cross-reference-index" (map downcase-string alphabet)) (br) (font-size 2 (em "Navigate to subindexes via tha alphabet above")) ) white black black black ) (html-destination "cross-reference-index"))) ; --------------------------------------------------------------------------------------------------- ; Splitted defining name index. Show source file in small font Link from split-defining-name-occurences to it's cross reference table entry 
(define (split-defining-name-occurences dno) (sublist-by-predicate dno (lambda (cur prev n) (not (eq? (string-ref (as-string (car cur)) 0) (string-ref (as-string (car prev)) 0)))))) Show source file in small font Link from make-defining-name-index to it's cross reference table entry 
(define (make-defining-name-index dno letter alphabet) (write-text-file (page (string-append "Defining name index: letter " letter) (con (icon-bar) (b (font 3 blue "Index of definitions: ")) (horizontal-space 2) (alphabetic-link-array-1 "defining-name-index" alphabet letter) ; at top (present-defined-name-index dno) ) white black black black ) (html-destination (string-append "defining-name-index" "-" (downcase-string letter))))) Show source file in small font Link from make-overall-defining-name-index to it's cross reference table entry 
(define (make-overall-defining-name-index alphabet) (write-text-file (page "Overall defining name index" (con (icon-bar) (b (font 3 blue "Index of definitions: ")) (horizontal-space 2) (alphabetic-link-array-1 "defining-name-index" (map downcase-string alphabet)) (br) (font-size 2 (em "Navigate to subindexes via tha alphabet above")) ) white black black black ) (html-destination "defining-name-index")))