; 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

In elucidator: 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. In elucidator: Link from elucidator-verbose-mode to it's cross reference table entry 
(define elucidator-verbose-mode #t) In elucidator: 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)))) In elucidator: 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 In elucidator: 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 In elucidator: Link from scheme-library to it's cross reference table entry 
(define scheme-library "lib") ;; The directory in which the libraries are located In elucidator: 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 In elucidator: 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. In elucidator: Link from source-directory to it's cross reference table entry 
(define source-directory #f) ; The fragment of a file path which distinguishes the source-directory and the HTML destination directory. ; As default, the html files are placed in a subdirectory of the source directory named 'html'. ; You can redefine this function after the elucidator software is loaded in order to provide for another html destination. In elucidator: Link from relative-source-html-destination-path-fragment to it's cross reference table entry 
(define (relative-source-html-destination-path-fragment) "html/") ;; The directory in which the generated html files are located. Depends on source-directory In elucidator: Link from html-directory to it's cross reference table entry 
(define (html-directory) (string-append source-directory (relative-source-html-destination-path-fragment))) ; Return the full path to the file name in the internal directory. ; The parameter name includes a possible extension In elucidator: 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 In elucidator: Link from documentation-source-file to it's cross reference table entry 
(define (documentation-source-file name) (string-append source-directory name)) ; Return a file relative to the startup directory In elucidator: Link from relative-to-startup-dir to it's cross reference table entry 
(define (relative-to-startup-dir dir) (string-append (startup-directory) dir)) ; --------------------------------------------------------------------------------------------------- ; 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 elucidator software") ; Read the scheme knowledge list In elucidator: Link from scheme-syntax-procedure-list to it's cross reference table entry 
(define scheme-syntax-procedure-list (file-read (string-append laml-dir "r4rs/" "scheme-knowledge.lsp"))) ; The URL prefix to the directory with the RS4R Scheme Report. ; Redefine in LAML setup file. In elucidator: Link from rs4r-url-prefix to it's cross reference table entry 
(define rs4r-url-prefix #f) ; The color scheme of the program windows. ; An alist mapping group strings to colors, or #f in case ; no color scheme is defined. Redefine in LAML setup file. In elucidator: Link from elucidator-color-scheme to it's cross reference table entry 8.3. The program file menu and coloring schemes
(define elucidator-color-scheme #f) ; --------------------------------------------------------------------------------------------------- ;;; 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. In elucidator: Link from make-duplicated-name-index? to it's cross reference table entry 
(define make-duplicated-name-index? #t) In elucidator: Link from make-cross-reference-index? to it's cross reference table entry 
(define make-cross-reference-index? #t) In elucidator: Link from make-defining-name-index? to it's cross reference table entry 
(define make-defining-name-index? #t) In elucidator: 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? In elucidator: 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. In elucidator: 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 In elucidator: 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 In elucidator: 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)) In elucidator: 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. In elucidator: 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 In elucidator: 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 In elucidator: 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 ; ; Present a separate frame with a menu of programs in the documentation bundle. ; The value of this variable must be boolean. In elucidator: Link from separate-program-menu? to it's cross reference table entry 8.3. The program file menu and coloring schemes
(define separate-program-menu? #f) ; A boolean variable that tells whether to underline links in program files In elucidator: 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 In elucidator: 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. In elucidator: Link from comment-handling to it's cross reference table entry 10.3. Solution
(define comment-handling 'syntactical) In elucidator: 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 In elucidator: 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 In elucidator: 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. In elucidator: 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. In elucidator: Link from elucidator-marker-char to it's cross reference table entry 
(define elucidator-marker-char #\@) In elucidator: 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 In elucidator: Link from elucidator-escape-char to it's cross reference table entry 
(define elucidator-escape-char #\\) In elucidator: 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 In elucidator: Link from documentation-filename-without-extension to it's cross reference table entry 
(define documentation-filename-without-extension #f) In elucidator: Link from documentation-title to it's cross reference table entry 4.2. The overall ideas
(define documentation-title #f) In elucidator: Link from documentation-author to it's cross reference table entry 4.2. The overall ideas
(define documentation-author #f) In elucidator: Link from documentation-email to it's cross reference table entry 
(define documentation-email #f) In elucidator: Link from documentation-affiliation to it's cross reference table entry 
(define documentation-affiliation #f) In elucidator: 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 In elucidator: 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. In elucidator: 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 In elucidator: Link from source-key-list to it's cross reference table entry 11.2. The solution to the problem
(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). In elucidator: 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) In elucidator: 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...) ...). In elucidator: 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). In elucidator: 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 In elucidator: 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 In elucidator: 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. In elucidator: 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. In elucidator: 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. In elucidator: 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 In elucidator: 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 In elucidator: 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 In elucidator: 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 In elucidator: 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 In elucidator: 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 In elucidator: 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 In elucidator: 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 In elucidator: 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 In elucidator: 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 In elucidator: 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. In elucidator: 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. In elucidator: 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. In elucidator: 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. In elucidator: 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. In elucidator: 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. In elucidator: 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. In elucidator: Link from alphabetic-defined-name-index? to it's cross reference table entry 
(define alphabetic-defined-name-index? #t) ; --------------------------------------------------------------------------------------------------- In elucidator: 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. In elucidator: 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. In elucidator: Link from program-source to it's cross reference table entry 1.2. Organization of the setup file 8.3. The program file menu and coloring schemes
(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 In elucidator: 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. In elucidator: 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). In elucidator: 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. In elucidator: 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) ; only make html directory in the simple case where it resides as a subdirectory in the source-directory (if (and (equal? "html/" (relative-source-html-destination-path-fragment)) (not (directory-exists? (string-append source-directory "html/")))) (make-directory-in-directory source-directory "html")) (ensure-directory-existence! (string-append source-directory (relative-source-html-destination-path-fragment)) "images") (ensure-directory-existence! source-directory "internal") ) ;; 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. In elucidator: 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.4. 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 (relative-source-html-destination-path-fragment) "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) (color-of-group "doc") black black black ) (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) (defaulted-get-value 'group ps "program") (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) (defaulted-get-value 'group ps "program") (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)) (color-of-group "index") black black black ) (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) ) (color-of-group "index") 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) ) (color-of-group "index") 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) ) (color-of-group "index") 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) ) (color-of-group "index") 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) ) (color-of-group "index") black black black ) (html-destination "documentation-toc-detail")) ; Making program menu frame (write-text-file (page "Program Menu" (source-file-links-for-program-menu program-source-list) (color-of-group "index") black black black ) (html-destination "program-menu")) ; 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" "program-menu" "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" "program-menu" "documentation" (get-value 'key (car program-source-list)) ; program starting point "html/" ) (source-filename-without-extension scheme-system)) (make-frame-file-in-html-dir "Schpeme Elucidator" (elucidator-frame-horizontal ; always in html-dir "documentation-toc-overall" "program-menu" "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 In elucidator: 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). In elucidator: 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 In elucidator: 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 In elucidator: 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))) In elucidator: 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. In elucidator: 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)))) In elucidator: Link from icon-bar to it's cross reference table entry 8.2. The icons 8.3. The program file menu and coloring schemes
(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") " " (if (not separate-program-menu?) (source-file-links program-source-list) "") )) 'middle )) ; do we have to process program-source (a triple of key, file-location and language)? In elucidator: 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 In elucidator: Link from restore-defined-names to it's cross reference table entry 1.3. Overall documentation processing forms.  13.1. The problems and errors
(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) (map (lambda (entry) (cons (as-symbol (car entry)) (cdr entry))) 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 In elucidator: Link from store-defined-names to it's cross reference table entry 1.3. Overall documentation processing forms.  13.1. The problems and errors
(define (store-defined-names source-key defined-names) (let ((store-filename (defining-names-file source-key)) (keyed-names (map (lambda (dn) (cons (as-string 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 In elucidator: 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")) ; source file links - inline version for icon-bar In elucidator: Link from source-file-links to it's cross reference table entry 8.3. The program file menu and coloring schemes
(define (source-file-links program-source-list) (let* ((source-key-list (map (lambda (ps) (get-value 'key ps)) program-source-list)) ; extract keys from program-source-list (source-group-list (map (lambda (ps) (defaulted-get-value 'group ps "program")) program-source-list)) ; similarly extract the groups (source-file-list (map (lambda (ps) (get-value 'file-location ps)) program-source-list)) ; similarly extract the file-locations ) (table-1 1 (map (lambda (sk) (* (string-length sk) 7)) source-key-list) (map color-of-group source-group-list) (list (map2 (lambda (sk sf) (html:a (font-size 2 sk) 'href (add-file-extension sk "html") 'title sf 'target "program-frame" 'style (if underline-program-links "{text-decoration: underline;}" "{text-decoration: none;}") ) ) source-key-list source-file-list))))) ; source file links - version of program menu frame In elucidator: Link from source-file-links-for-program-menu to it's cross reference table entry 8.3. The program file menu and coloring schemes
(define (source-file-links-for-program-menu program-source-list) (let* ((source-key-list (map (lambda (ps) (get-value 'key ps)) program-source-list)) ; extract keys from program-source-list (source-group-list (map (lambda (ps) (defaulted-get-value 'group ps "program")) program-source-list)) ; similarly extract the groups (source-file-list (map (lambda (ps) (get-value 'file-location ps)) program-source-list)) ; similarly extract the file-locations ) (table-4 1 (list 240) (map color-of-group source-group-list) (map2 (lambda (sk sf) (list (html:a (font-size 2 sk) 'href (add-file-extension sk "html") 'title sf 'target "program-frame" 'style (if underline-program-links "{text-decoration: underline;}" "{text-decoration: none;}") ) ) ) source-key-list source-file-list)))) ; --------------------------------------------------------------------------------------------------- ; ; ; Syntax functions ; ; Return a syntax function In elucidator: 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 In elucidator: 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 key value from elements. Elements is assumed to be a list of double-lists. ; In this context, a double list is a list of length two. ; Example of elements (("x" 5) ("y" 6)). In elucidator: 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)))))) ; As get-value, but instead of a fatal error we return default-value if key is not in elements. In elucidator: Link from defaulted-get-value to it's cross reference table entry 
(define (defaulted-get-value key elements default-value) (let ((res (assoc key elements))) (if (and (list? res) (> (length res) 1)) (cadr res) default-value))) ; Get the list of values of an element In elucidator: Link from get-values to it's cross reference table entry 
(define (get-values key elements) (cdr (assoc key elements))) In elucidator: Link from key to it's cross reference table entry 
(define key (make-syntax-function 'key)) In elucidator: Link from file-location to it's cross reference table entry 
(define file-location (make-syntax-function 'file-location)) In elucidator: Link from language to it's cross reference table entry 
(define language (make-syntax-function 'language)) In elucidator: Link from group to it's cross reference table entry 
(define group (make-syntax-function 'group)) In elucidator: Link from id to it's cross reference table entry 
(define id (make-syntax-function 'id)) In elucidator: 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)) In elucidator: Link from index-words to it's cross reference table entry 
(define index-words (make-syntax-function 'index-words)) In elucidator: Link from intro to it's cross reference table entry 
(define intro (make-syntax-function 'intro)) In elucidator: Link from sources to it's cross reference table entry 
(define sources (make-syntax-function 'sources)) In elucidator: 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 In elucidator: 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")) In elucidator: Link from source-destination to it's cross reference table entry 
(define (source-destination filename) (string-append source-directory filename ".html")) ; --------------------------------------------------------------------------------------------------- ; Color settings ;; apply black and white coloring if you make hard copies for black and white proceedings or articles In elucidator: Link from black-and-white-coloring to it's cross reference table entry 
(define black-and-white-coloring #f) In elucidator: 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)) In elucidator: Link from comment-color to it's cross reference table entry 
(define comment-color (make-color 112 168 0)) In elucidator: Link from applied-color to it's cross reference table entry 
(define applied-color (make-color 0 0 128)) In elucidator: Link from documentation-section-color to it's cross reference table entry 
(define documentation-section-color (make-color 0 204 255)) In elucidator: Link from documentation-entry-color to it's cross reference table entry 
(define documentation-entry-color (make-color 0 204 255)) In elucidator: Link from documentation-program-link-color to it's cross reference table entry 
(define documentation-program-link-color red) In elucidator: Link from documentation-program-link-color-weak to it's cross reference table entry 
(define documentation-program-link-color-weak applied-color) In elucidator: Link from documentation-documentation-link-color to it's cross reference table entry 
(define documentation-documentation-link-color blue) In elucidator: Link from none-reference-color to it's cross reference table entry 
(define none-reference-color (make-color 70 70 70)) In elucidator: Link from r4rs-scheme-color to it's cross reference table entry 
(define r4rs-scheme-color brown) In elucidator: Link from default-background-color to it's cross reference table entry 8.3. The program file menu and coloring schemes
(define default-background-color white) In elucidator: Link from documentation-background-color to it's cross reference table entry 
(define documentation-background-color (make-color 255 236 217)) In elucidator: Link from program-background-color-1 to it's cross reference table entry 
(define program-background-color-1 white) ; white In elucidator: Link from program-background-color-2 to it's cross reference table entry 
(define program-background-color-2 (make-color 221 255 221)) ; very light green In elucidator: Link from program-background-color-3 to it's cross reference table entry 
(define program-background-color-3 (make-color 198 226 255)) ; very light blue (make-color 222 222 239) In elucidator: Link from program-background-color-4 to it's cross reference table entry 
(define program-background-color-4 (make-color 255 230 230)) ; very light red In elucidator: Link from program-background-color-5 to it's cross reference table entry 
(define program-background-color-5 (make-color 226 226 199)) ; very light brown In elucidator: Link from program-background-color-6 to it's cross reference table entry 
(define program-background-color-6 (make-color 255 255 193)) ; very light yellow In elucidator: Link from program-background-color-7 to it's cross reference table entry 
(define program-background-color-7 (make-color 224 224 224)) ; very light grey ;; Re-assigns the colors in order to provide for good printing in black and white In elucidator: Link from apply-black-and-white-hardcopy-colors! to it's cross reference table entry 
(define (apply-black-and-white-hardcopy-colors!) (set! defined-color black) (set! comment-color black) (set! applied-color black) (set! documentation-section-color (make-color 0 204 255)) (set! documentation-entry-color (make-color 0 204 255)) (set! documentation-program-link-color black) (set! documentation-program-link-color-weak black) (set! documentation-documentation-link-color black) (set! none-reference-color black) (set! underline-program-links #f) (set! underline-documentation-links #t) (set! r4rs-scheme-color black) ) (if black-and-white-coloring (apply-black-and-white-hardcopy-colors!)) ; --------------------------------------------------------------------------------------------------- In elucidator: Link from image-file-access to it's cross reference table entry 
(define image-file-access 'sub-directory) In elucidator: 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 In elucidator: 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))) In elucidator: 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. In elucidator: 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 '())) In elucidator: 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)))))) In elucidator: 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))) In elucidator: 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 In elucidator: 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)) In elucidator: 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). In elucidator: 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))) In elucidator: 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) ...) In elucidator: 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 '()))) In elucidator: 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 knowledge selectors: All take an entry in the Scheme knowledge list. In elucidator: Link from symbol-of-scheme-knowledge to it's cross reference table entry 
(define symbol-of-scheme-knowledge (make-selector-function 1 'symbol-of-scheme-knowledge)) In elucidator: Link from category-of-scheme-knowledge to it's cross reference table entry 
(define category-of-scheme-knowledge (make-selector-function 2 'category-of-scheme-knowledge)) In elucidator: Link from essentiality-of-scheme-knowledge to it's cross reference table entry 
(define essentiality-of-scheme-knowledge (make-selector-function 3 'essentiality-of-scheme-knowledge)) ; piece the URL together from third and fourth component of entry, or return #f if they are missing In elucidator: Link from url-of-scheme-knowledge to it's cross reference table entry 
(define (url-of-scheme-knowledge entry) (if (and rs4r-url-prefix (>= (length entry) 4)) (string-append rs4r-url-prefix "r4rs_" (as-string (fourth entry)) ".htm#" (fifth entry)) #f)) ; --------------------------------------------------------------------------------------------------- ;;; 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. In elucidator: 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 source-group) (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") (color-of-group source-group) 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) ))) In elucidator: 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 In elucidator: 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. In elucidator: 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 In elucidator: 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. In elucidator: 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 2.7:
'Preparing the linking to program source markers.'
The relation is ambiguous.
The other relevant sections are 10.6, 10.6, 10.7
Mark char: h (let ((sectional-comment (section-name-comment? (comment-string-of-syntactical-comment f)))) (if sectional-comment (set! enclosing-definition-name sectional-comment)) (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 (if sectional-comment (write-string-to-port (con (total-doc-navigator (as-symbol sectional-comment) documented-names size source-key) (br)) op)) ; 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 section is 10.7
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 In elucidator: 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 comment string parameter of ; render-syntactical-comment is considered a sectional-comment. In elucidator: 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. In elucidator: 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(255,255,0);}")) ; yellow 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,255,0);}")) ; yellow 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 In elucidator: 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. In elucidator: Link from comment-output-string to it's cross reference table entry 
(define comment-output-string (make-string comment-max-length #\space)) In elucidator: Link from debugging-syntactical-comment-rendering to it's cross reference table entry 
(define debugging-syntactical-comment-rendering #f) In elucidator: Link from state-list to it's cross reference table entry 
(define state-list '()) In elucidator: 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) ))) In elucidator: Link from sectional-comment-char to it's cross reference table entry 
(define sectional-comment-char #\:) In elucidator: Link from sectional-comment-char-string to it's cross reference table entry 
(define sectional-comment-char-string (as-string sectional-comment-char)) In elucidator: Link from elucidator-marker-char-string to it's cross reference table entry 
(define elucidator-marker-char-string (as-string elucidator-marker-char)) ; A simple version of html-protect which only work and single character strings. In elucidator: Link from hp to it's cross reference table entry 
(define (hp single-string-char) (cond ((equal? single-string-char "<") "&lt;") ((equal? single-string-char ">") "&gt;") (else single-string-char))) In elucidator: Link from syntactical-comment-transition to it's cross reference table entry 10.8. Pretty printing syntactical comments
(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 "<" "")) ; ((equal? char (as-string #>)) (list 'normal ">" "")) (else (list 'normal (hp 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) (hp 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) (hp 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 (hp 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) (hp 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) " " (hp 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) " " (hp char)) "")))) (else (error (string-append "syntactical-comment-transition error: unknown state " (as-string in-state))) ) ))) In elucidator: 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 #\;) ))) In elucidator: 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)))) In elucidator: 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. In elucidator: 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))) ""))) In elucidator: 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 "In " source-key ": " "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))) "")))) In elucidator: 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 '())) In elucidator: 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)))))) In elucidator: 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 In elucidator: 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). In elucidator: 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 '())) In elucidator: 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))))) In elucidator: 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) )))) In elucidator: 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 In elucidator: 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 ((entry (scheme-knowledge-entry sym))) (if entry (let ((url (url-of-scheme-knowledge entry))) (if url (write-string-to-port (html:a ((scheme-syntax-procedure-decorate entry) protected-symbol-string) 'href url 'style (if underline-program-links "{text-decoration: underline;}" "{text-decoration: none;}") 'target "documentation-frame") op) (write-string-to-port ((scheme-syntax-procedure-decorate entry) 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. In elucidator: Link from scheme-syntax-procedure-decorate to it's cross reference table entry 
(define (scheme-syntax-procedure-decorate entry) (cond ((eq? 'syntax (category-of-scheme-knowledge entry)) b) ((eq? 'procedure (category-of-scheme-knowledge entry)) brown-normal) (else id-1))) In elucidator: Link from brown-normal to it's cross reference table entry 
(define (brown-normal txt) (font-color r4rs-scheme-color (if black-and-white-coloring (em txt) txt))) ; The identify function In elucidator: 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 In elucidator: Link from scheme-knowledge-entry to it's cross reference table entry 
(define (scheme-knowledge-entry symbol) (scheme-knowledge-entry-1 symbol scheme-syntax-procedure-list)) In elucidator: Link from scheme-knowledge-entry-1 to it's cross reference table entry 
(define (scheme-knowledge-entry-1 symbol lst) (cond ((null? lst) #f) ((eq? (symbol-of-scheme-knowledge (car lst)) symbol) (car lst)) (else (scheme-knowledge-entry-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 In elucidator: 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))))) In elucidator: 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)) In elucidator: 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)) In elucidator: 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)) In elucidator: 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)) In elucidator: 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)))))) In elucidator: 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")))) In elucidator: 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")))) In elucidator: 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)))) In elucidator: 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))))) In elucidator: Link from comment-begin? to it's cross reference table entry 
(define (comment-begin? ch) (eq? #\; ch)) In elucidator: 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)) In elucidator: 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. In elucidator: 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"))))) In elucidator: 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)))))) In elucidator: Link from eol? to it's cross reference table entry 
(define (eol? ch) (eq? ch #\newline)) ; --------------------------------------------------------------------------------------------------- ; Handy test procedure of the Scheme elucidator. OBSOLETE. In elucidator: 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 control, documentation, and program file names. ; Directory prefix is added in front of all three frames of the elucidator. In elucidator: Link from elucidator-frame to it's cross reference table entry 8.1. Some HTML details.
(define (elucidator-frame control-filename program-menu-filename documentation-filename program-filename directory-prefix) (letrec ((frame-file (lambda (f) (string-append directory-prefix (add-file-extension f "html"))))) (html:frameset (con (control-frame control-filename program-menu-filename directory-prefix) (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))) ) In elucidator: Link from elucidator-frame-horizontal to it's cross reference table entry 8.1. Some HTML details.
(define (elucidator-frame-horizontal control-filename program-menu-filename documentation-filename program-filename directory-prefix) (letrec ((frame-file (lambda (f) (string-append directory-prefix (add-file-extension f "html"))))) (html:frameset (con (control-frame control-filename program-menu-filename directory-prefix) (html:frame "" 'name "documentation-frame" 'src (frame-file documentation-filename) 'scrolling "yes") (html:frame "" 'name "program-frame" 'src (frame-file program-filename) 'scrolling "yes") ) 'rows (string-append (as-string control-frame-pixel-height) ",360,*") 'border 5 'bordercolor (rgb-string-list black))) ) ; Return a control frame or frameset. In elucidator: Link from control-frame to it's cross reference table entry 8.3. The program file menu and coloring schemes
(define (control-frame control-filename program-menu-filename directory-prefix) (letrec ((frame-file (lambda (f) (string-append directory-prefix (add-file-extension f "html"))))) (if separate-program-menu? (html:frameset (con (html:frame "" 'name "control-frame" 'src (frame-file control-filename) 'scrolling "auto") (html:frame "" 'name "program-menu" 'src (frame-file program-menu-filename) 'scrolling "auto") ) 'cols "*,240" 'border 1 'bordercolor (rgb-string-list black)) (html:frame "" 'name "control-frame" 'src (frame-file control-filename) 'scrolling "auto")))) In elucidator: 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))) In elucidator: 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. In elucidator: 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) )) In elucidator: 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"))))) In elucidator: Link from section-number to it's cross reference table entry 1.4. The documentation-entry and documentation-section clauses
(define section-number 0) In elucidator: Link from subsection-number to it's cross reference table entry 1.4. The documentation-entry and documentation-section clauses
(define subsection-number 0) In elucidator: 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))) In elucidator: 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))) In elucidator: 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)))) In elucidator: 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 In elucidator: 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 In elucidator: 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)))))) In elucidator: 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)) )))) In elucidator: 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)) )) In elucidator: Link from guard-text to it's cross reference table entry 
(define (guard-text str) (if str str "???")) In elucidator: 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-group 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 source-group)) ; --------------------------------------------------------------------------------------------------- ; ; 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. In elucidator: Link from linking-output-factor to it's cross reference table entry 
(define linking-output-factor 10) In elucidator: 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 ""))) In elucidator: Link from state-list to it's cross reference table entry 
(define state-list '()) ; for debugging purposes In elucidator: Link from debugging-program-linking to it's cross reference table entry 
(define debugging-program-linking #f) In elucidator: 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 In elucidator: Link from program-linking-transition to it's cross reference table entry 2.6. Marking detailed places in a program 2.7. Preparing the linking to program source markers. 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 In elucidator: 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 In elucidator: 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-number (assq (as-symbol collected-word) documentation-key-numbering-alist)) (ass-title (assq (as-symbol collected-word) documentation-key-title-alist)) (ref-number (if ass-number (cdr ass-number) #f)) (ref-title (if ass-title (cdr ass-title) #f)) ; the title of the section referred (url (if ref-number (string-append "documentation.html" "#" collected-word) #f))) (if url (html:a (font-color documentation-documentation-link-color ref-number) 'href url 'style "{text-decoration: underline;}" 'target "documentation-frame" 'title (if ref-title ref-title "")) (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 In elucidator: 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. In elucidator: 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. 11.2. The solution to the problem
(define (linking-from-doc-to-prog word doc-id) (let* ((kind (kind-of-program-link? word)) (qualification (qualified-program-link? word)) (word-1 (proper-linking-word word qualification)) (strong? (eq? kind 'strong)) (strong-weak-symbol (if strong? 'strong 'weak)) (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))) ((and (empty-string? word-1) (not (empty-string? qualification))) ; link to file as such (let ((source-key qualification)) (html:a (font-color (if strong? documentation-program-link-color documentation-program-link-color-weak) (kbd (b source-key))) 'href (string-append source-key ".html") 'target "program-frame" 'title (string-append "Link to program file: " source-key) 'style (if underline-documentation-links "{text-decoration: underline;}" "{text-decoration: none;}") ) )) ((= (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)) (if (and qualification (not (equal? qualification source-key))) (display-warning (string-append "Disregarding the qualification of " word))) (html:a (font-color (if strong? documentation-program-link-color documentation-program-link-color-weak) (if (and strong? black-and-white-coloring) (b (kbd word-1)) (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;}") ) )) ((and (> (length link-targets) 1) qualification) ; A linked program source marker to section 11.2:
'The solution to the problem'
Mark char: a (let* ((possible-source-keys (map cdr link-targets)) (qualification-ok (member qualification possible-source-keys)) (source-key (if qualification-ok qualification (cdr (car link-targets))))) (if strong? (set! previous-strong-program-word word-1)) (set! documented-name-occurences (cons (list (as-symbol word-1) doc-id strong-weak-symbol) documented-name-occurences)) (if (not qualification-ok) (display-warning (string-append "Illegal qualification in " word ". Using that in " source-key))) (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 "Multiple targets of the program reference " word-1 ". Consider a qualification. " "Using that in " source-key)) (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;}") ) )) ))) ; Return the qualification (source key) of word, or #f if there ; is no qualification. The parameter word is of the form ; *qual$ref, qual$ref, or just ref (loosely speaking). ; A qualification must match one of the source ; keys in source-key-list to qualify. In elucidator: Link from qualified-program-link? to it's cross reference table entry 11.2. The solution to the problem
(define (qualified-program-link? word) (let ((end-qual (find-in-string word #\$))) (if end-qual (let* ((init-char (string-ref word 0)) (start-qual (cond ((eq? init-char strong-link-char) 1) ((eq? init-char weak-link-char) 1) ((eq? init-char none-link-char) 1) (else 0))) (candidate-qual (substring word start-qual end-qual))) (if (member candidate-qual source-key-list) candidate-qual #f)) #f))) ; Return the proper linking word from word (without qualification and kind-information). In elucidator: Link from proper-linking-word to it's cross reference table entry 11.2. The solution to the problem
(define (proper-linking-word word qualification) (if qualification (substring word (+ 1 (find-in-string word #\$)) (string-length word)) (let* ((init-char (string-ref word 0)) (start (cond ((eq? init-char strong-link-char) 1) ((eq? init-char weak-link-char) 1) ((eq? init-char none-link-char) 1) (else 0)))) (substring word start (string-length word))))) ; does the program link word start with a strong-link-char In elucidator: 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 In elucidator: 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 In elucidator: 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 In elucidator: 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). In elucidator: 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))) In elucidator: 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) In elucidator: 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))))) In elucidator: 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. In elucidator: 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)) )) In elucidator: 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 In elucidator: 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?)) In elucidator: 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 '())) In elucidator: 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 )) In elucidator: 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)))))) In elucidator: 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)) In elucidator: 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)))) In elucidator: 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))) In elucidator: 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 In elucidator: 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 In elucidator: 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)))) In elucidator: 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. In elucidator: 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 In elucidator: 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))))) In elucidator: 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))) In elucidator: 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. In elucidator: 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. In elucidator: 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. In elucidator: 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. In elucidator: 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))) In elucidator: 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 In elucidator: 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 In elucidator: 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))) In elucidator: 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))) In elucidator: 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)))) In elucidator: Link from unit-ok? to it's cross reference table entry 
(define (unit-ok? unit) #t) ; not used In elucidator: Link from unit-list to it's cross reference table entry 
(define unit-list '()) In elucidator: 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))) In elucidator: 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 In elucidator: 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))))) In elucidator: 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))) In elucidator: 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))) In elucidator: 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)) In elucidator: 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)) In elucidator: 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)) In elucidator: 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 In elucidator: 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))) In elucidator: 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)) In elucidator: 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)) In elucidator: 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))) In elucidator: Link from cr-string to it's cross reference table entry 
(define cr-string (as-string #\newline)) In elucidator: 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)))))) In elucidator: 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)))) In elucidator: 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 In elucidator: Link from buffer-length to it's cross reference table entry 4.6. The collection functions
(define buffer-length 10000) In elucidator: Link from collection-buffer to it's cross reference table entry 4.6. The collection functions
(define collection-buffer (make-string buffer-length #\space)) In elucidator: Link from next-doc-char to it's cross reference table entry 4.6. The collection functions
(define next-doc-char #f) In elucidator: Link from doc-line-number to it's cross reference table entry 4.6. The collection functions
(define doc-line-number 1) In elucidator: 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 In elucidator: 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) ) In elucidator: 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)))))) In elucidator: 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 In elucidator: 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 In elucidator: 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 In elucidator: 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 In elucidator: 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))))) In elucidator: 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)))) In elucidator: 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))))) In elucidator: Link from eof? to it's cross reference table entry 
(define (eof? ch) (eof-object? ch)) ; --------------------------------------------------------------------------------------------------- ; Test stuff. Delete soon In elucidator: 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))) In elucidator: 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 In elucidator: Link from make-elucidator-help-page to it's cross reference table entry 8.4. 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 "The " (a-tag-target "http://www.cs.auc.dk/~normark/elucidative-programming/index.html" "elucidative programming home page" "elu-home") " and the " (a-tag-target "http://dopu.cs.auc.dk" "DOPU page" "dopu-home") " are the primary places to find information about elucidative programming.") (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 In elucidator: 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. In elucidator: 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 In elucidator: 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 In elucidator: 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. In elucidator: 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 " )) 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. In elucidator: 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. ; up, prev, and next may be an URL (a string) or a cons-pair of (URL . section-title), or #f. ; If one of these are #f, present a blind navigation button. ; This function handles the presentation details given the URLS passed as parameters. In elucidator: 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) (letrec ((url-of (lambda (x) (cond ((pair? x) (car x)) ((string? x) x) (else (error "url-of: unknown type of parameter"))))) (title-of (lambda (x) (cond ((pair? x) (cdr x)) ((string? x) "") (else (error "title-of: unknown type of parameter")))))) (con (if up (a-tag (url-of up) (image "small-up.gif" (title-of up))) (image "small-up-blind.gif" "")) (horizontal-space 1) (if prev (a-tag (url-of prev) (image "small-prev.gif" (title-of prev))) (image "small-prev-blind.gif" "")) (horizontal-space 1) (if next (a-tag (url-of next) (image "small-next.gif" (title-of next))) (image "small-next-blind.gif" ""))))) ; Return a cons pair of URL and section title of documentation entry n.m ; if m is 0, we mean section n. ; If no such entry/section exists, return #f In elucidator: 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)) (id (get-value 'id element)) (ttl (get-value 'title element)) ) (cons (documentation-url id) ttl))) ((= 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. In elucidator: 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)))))) In elucidator: 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 In elucidator: 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) ) (color-of-group "index") 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. In elucidator: 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")) ) (color-of-group "index") black black black ) (html-destination "cross-reference-index"))) ; --------------------------------------------------------------------------------------------------- ; Splitted defining name index. In elucidator: 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)))))) In elucidator: 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) ) (color-of-group "index") black black black ) (html-destination (string-append "defining-name-index" "-" (downcase-string letter))))) In elucidator: 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")) ) (color-of-group "index") black black black ) (html-destination "defining-name-index"))) ; --------------------------------------------------------------------------------------------------------------- ; ; A high level syntax function for definition of the color scheme ; Returns an association list that maps group strings to colors In elucidator: Link from make-color-scheme to it's cross reference table entry 8.3. The program file menu and coloring schemes
(define (make-color-scheme . group-color-plist) (propertylist-to-alist group-color-plist)) ; Return the color that is going to represent group. ; Group is the string given as group in program-source forms In elucidator: Link from color-of-group to it's cross reference table entry 8.3. The program file menu and coloring schemes
(define (color-of-group group) (if elucidator-color-scheme (let ((group-color (assoc group elucidator-color-scheme))) (if (pair? group-color) (cdr group-color) default-background-color)) default-background-color))