summaryrefslogtreecommitdiff
path: root/syntax-highlight.scm
blob: 6a15daba2f682f4ab20b8123234f2e469f696bec (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
;;; guile-syntax-highlight -- General-purpose syntax highlighter
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;;
;;; Guile-syntax-highlight is free software; you can redistribute it
;;; and/or modify it under the terms of the GNU Lesser General Public
;;; License as published by the Free Software Foundation; either
;;; version 3 of the License, or (at your option) any later version.
;;;
;;; Guile-syntax-highlight 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 Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with guile-syntax-highlight.  If not, see
;;; <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; General-purpose syntax highlighting framework.
;;
;;; Code:

(define-module (syntax-highlight)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-41)
  #:use-module (syntax-highlight utils)
  #:export (highlight
            highlights->sxml))

(define* (highlight highlighter #:optional (stream (current-input-port)))
  "Apply HIGHLIGHTER, a syntax highlighting procedure, to STREAM.
STREAM may be an open port, string, or SRFI-41 character stream.  If
STREAM is not specified, characters are read from the current input
port."
  (let-values (((result stream)
                (highlighter (cond
                              ((port? stream)
                               (port->stream stream))
                              ((string? stream)
                               (string->stream stream))
                              ((stream? stream)
                               stream)
                              (else
                               (error "Cannot convert to stream: " stream))))))
    result))

(define (highlights->sxml highlights)
  "Convert HIGHLIGHTS, a list of syntax highlighting expressions, into
a list of SXML 'span' nodes.  Each 'span' node has a 'class' attribute
corresponding to the highlighting tag name."
  (define (tag->class tag)
    (string-append "syntax-" (symbol->string tag)))

  (map (match-lambda
         ((? string? str) str)
         ((tag text)
          `(span (@ (class ,(tag->class tag))) ,text)))
       highlights))