stlog/skribe-utils.scm

;;; stlog website --- 
;;; Copyright © 2016 David Thompson <davet@gnu.org>
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
;;; Copyright © 2016 Dylan Jeffers <sapientech@openmailbox.org>
;;;
;;; 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 3 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, see <http://www.gnu.org/licenses/>.

;;; Originally by David Thompson, who agreed tho license this under
;;; GPLv3 or later.  Thanks Dave!

(define-module (skribe-utils)
  #:use-module (ice-9 match)
  #:use-module (syntax-highlight)
  #:use-module (syntax-highlight scheme)
  #:use-module (syntax-highlight xml)
  ;; #:use-module (syntax-highlight c)
  #:export (image/caption
            scheme-code
            xml-code
            ;; c-source
            code-block
            code-block-scheme
            code-block-xml))

(define (image/caption uri caption)
  `((img (@ (class "centered rounded")
            (src ,uri)
            (alt ,caption)))
    (div (@ (class "caption")) ,caption)))

(define (scheme-source source)
  (highlights->sxml
   (highlight lex-scheme
              (match source
                ((source ...)
                 (string-concatenate source))
                (_ source)))))

(define (xml-source source)
  (highlights->sxml
   (highlight lex-xml
              (match source
                ((source ...)
                 (string-concatenate source))
                (_ source)))))

;; (define (c-source source)
;;   (highlights->sxml
;;    (highlight lex-c
;;               (match source
;;                 ((source ...)
;;                  (string-concatenate source))
;;                 (_ source)))))

(define (code-block . source)
  `(div (@ (class "code"))
        ,@source))

(define (code-block-scheme . source)
  (apply code-block (scheme-source source)))

(define (code-block-xml . source)
  (apply code-block (xml-source source)))