diff options
Diffstat (limited to 'src/guile/skribilo/source/xml.scm')
-rw-r--r-- | src/guile/skribilo/source/xml.scm | 80 |
1 files changed, 80 insertions, 0 deletions
diff --git a/src/guile/skribilo/source/xml.scm b/src/guile/skribilo/source/xml.scm new file mode 100644 index 0000000..05eac17 --- /dev/null +++ b/src/guile/skribilo/source/xml.scm @@ -0,0 +1,80 @@ +;;; xml.scm -- XML syntax highlighting. +;;; +;;; Copyright 2005, 2007 Ludovic Courtès <ludovic.courtes@laas.fr> +;;; +;;; +;;; 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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + + +(define-module (skribilo source xml) + :export (xml) + :use-module (skribilo lib) + :use-module (ice-9 regex)) + + +(define %comment-rx (make-regexp "<!--(.|\\n)*-->" regexp/extended)) + +(define (xml-fontifier str) + (let loop ((start 0) + (result '())) + (if (>= start (string-length str)) + (reverse! result) + (case (string-ref str start) + ((#\") + (let ((end (string-index str start #\"))) + (if (not end) + (skribe-error 'xml-fontifier + "unterminated XML string" + (string-drop str start)) + (loop end + (cons (new markup + (markup '&source-string) + (body (substring str start end))) + result))))) + ((#\<) + (let ((end (string-index str #\> start))) + (if (not end) + (skribe-error 'xml-fontifier + "unterminated XML tag" + (string-drop str start)) + (let ((comment? (regexp-exec %comment-rx + (substring str start end)))) + (loop end + (cons (if comment? + (new markup + (markup '&source-comment) + (body (substring str start end))) + (new markup + (markup '&source-module) + (body (substring str start end)))) + result)))))) + + (else + (loop (+ 1 start) + (if (or (null? result) + (not (string? (car result)))) + (cons (string (string-ref str start)) result) + (cons (string-append (car result) + (string (string-ref str start))) + (cdr result))))))))) + + +(define xml + (new language + (name "xml") + (fontifier xml-fontifier) + (extractor #f))) + +;;; xml.scm ends here |