091eed218e1b496fa8b6680b47cf9792f2ad00fc
[guile-syntax-highlight.git] / syntax-highlight.scm
1 ;;; guile-syntax-highlight -- General-purpose syntax highlighter
2 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
3 ;;;
4 ;;; Guile-syntax-highlight is free software; you can redistribute it
5 ;;; and/or modify it under the terms of the GNU Lesser General Public
6 ;;; License as published by the Free Software Foundation; either
7 ;;; version 3 of the License, or (at your option) any later version.
8 ;;;
9 ;;; Guile-syntax-highlight is distributed in the hope that it will be
10 ;;; useful, but WITHOUT ANY WARRANTY; without even the implied
11 ;;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 ;;; See the GNU Lesser General Public License for more details.
13 ;;;
14 ;;; You should have received a copy of the GNU Lesser General Public
15 ;;; License along with guile-syntax-highlight. If not, see
16 ;;; <http://www.gnu.org/licenses/>.
17
18 ;;; Commentary:
19 ;;
20 ;; General-purpose syntax highlighting framework.
21 ;;
22 ;;; Code:
23
24 (define-module (syntax-highlight)
25 #:use-module (ice-9 match)
26 #:use-module (srfi srfi-1)
27 #:use-module (srfi srfi-11)
28 #:use-module (srfi srfi-26)
29 #:use-module (srfi srfi-41)
30 #:use-module (syntax-highlight utils)
31 #:export (highlight
32 highlights->sxml))
33
34 (define* (highlight highlighter #:optional (stream (current-input-port)))
35 "Apply HIGHLIGHTER, a syntax highlighting procedure, to STREAM.
36 STREAM may be an open port, string, or SRFI-41 character stream. If
37 STREAM is not specified, characters are read from the current input
38 port."
39 (let-values (((result remaining)
40 (highlighter (cond
41 ((port? stream)
42 (port->stream stream))
43 ((string? stream)
44 (string->stream stream))
45 ((stream? stream)
46 stream)
47 (else
48 (error "Cannot convert to stream: " stream))))))
49 ;; If there's a remainder, it means that parsing failed. We want
50 ;; to preserve *all* of the input text, even if it is invalid.
51 ;; So, we take the stuff that could be parsed and tack on the
52 ;; stuff that wasn't.
53 (if (stream-null? remaining)
54 result
55 (append result (list (stream->string remaining))))))
56
57 (define (highlights->sxml highlights)
58 "Convert HIGHLIGHTS, a list of syntax highlighting expressions, into
59 a list of SXML 'span' nodes. Each 'span' node has a 'class' attribute
60 corresponding to the highlighting tag name."
61 (define (tag->class tag)
62 (string-append "syntax-" (symbol->string tag)))
63
64 (map (match-lambda
65 ((? string? str) str)
66 ((tag text)
67 `(span (@ (class ,(tag->class tag))) ,text)))
68 highlights))