diff options
| author | Ludovic Court`es | 2005-11-02 10:08:38 +0000 |
|---|---|---|
| committer | Ludovic Court`es | 2005-11-02 10:08:38 +0000 |
| commit | b76d5e1b252967521f210eac10ddbf089dde8c6a (patch) | |
| tree | 00fc81c51256991c04799d79a749bbdd5b9fad30 /legacy/bigloo/xml.scm | |
| parent | ba63b8d4780428d9f63f6ace7f49361b77401112 (diff) | |
| parent | f553cb65b157b6df9563cefa593902d59301461b (diff) | |
| download | skribilo-b76d5e1b252967521f210eac10ddbf089dde8c6a.tar.gz skribilo-b76d5e1b252967521f210eac10ddbf089dde8c6a.tar.lz skribilo-b76d5e1b252967521f210eac10ddbf089dde8c6a.zip | |
Cleaned up the source tree and the installation process.
Patches applied:
* lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-6
Cosmetic changes.
* lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-7
Removed useless files, integrated packages.
* lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-8
Removed useless files, integrated packages.
* lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-9
Moved the STkLos and Bigloo code to `legacy'.
* lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-10
Installed Autoconf/Automake machinery. Fixed a few things.
* lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-11
Changes related to source-highlighting and to the manual.
git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-10
Diffstat (limited to 'legacy/bigloo/xml.scm')
| -rw-r--r-- | legacy/bigloo/xml.scm | 92 |
1 files changed, 92 insertions, 0 deletions
diff --git a/legacy/bigloo/xml.scm b/legacy/bigloo/xml.scm new file mode 100644 index 0000000..d4c662e --- /dev/null +++ b/legacy/bigloo/xml.scm @@ -0,0 +1,92 @@ +;*=====================================================================*/ +;* serrano/prgm/project/skribe/src/bigloo/xml.scm */ +;* ------------------------------------------------------------- */ +;* Author : Manuel Serrano */ +;* Creation : Mon Sep 1 12:08:39 2003 */ +;* Last change : Mon May 17 10:14:24 2004 (serrano) */ +;* Copyright : 2003-04 Manuel Serrano */ +;* ------------------------------------------------------------- */ +;* XML fontification */ +;*=====================================================================*/ + +;*---------------------------------------------------------------------*/ +;* The module */ +;*---------------------------------------------------------------------*/ +(module skribe_xml + + (include "new.sch") + + (import skribe_types + skribe_lib + skribe_resolve + skribe_eval + skribe_api + skribe_param + skribe_source) + + (export xml)) + +;*---------------------------------------------------------------------*/ +;* xml ... */ +;*---------------------------------------------------------------------*/ +(define xml + (new language + (name "xml") + (fontifier xml-fontifier) + (extractor #f))) + +;*---------------------------------------------------------------------*/ +;* xml-fontifier ... */ +;*---------------------------------------------------------------------*/ +(define (xml-fontifier s) + (let ((g (regular-grammar () + ((: #\; (in "<!--") (* (or all #\Newline)) "-->") + ;; italic comments + (let ((str (split-string-newline (the-string)))) + (append (map (lambda (s) + (if (eq? s 'eol) + "\n" + (new markup + (markup '&source-line-comment) + (body s)))) + str) + (ignore)))) + ((+ (or #\Newline #\Space)) + ;; separators + (let ((str (the-string))) + (cons str (ignore)))) + ((or (: #\< (+ (out #\> #\space #\tab #\Newline))) #\>) + ;; markup + (let ((str (the-string))) + (let ((c (new markup + (markup '&source-module) + (body (the-string))))) + (cons c (ignore))))) + ((+ (out #\< #\> #\Space #\Tab #\= #\")) + ;; regular text + (let ((string (the-string))) + (cons string (ignore)))) + ((or (: "\"" (* (or (out #a000 #\\ #\") (: #\\ all))) "\"") + (: "\'" (* (or (out #a000 #\\ #\') (: #\\ all))) "\'")) + ;; strings + (let ((str (split-string-newline (the-string)))) + (append (map (lambda (s) + (if (eq? s 'eol) + "\n" + (new markup + (markup '&source-string) + (body s)))) + str) + (ignore)))) + ((in "\"=") + (let ((str (the-string))) + (cons str (ignore)))) + (else + (let ((c (the-failure))) + (if (eof-object? c) + '() + (error "source(xml)" "Unexpected character" c))))))) + (with-input-from-string s + (lambda () + (read/rp g (current-input-port)))))) + |