skribe-utils.scm 2.2 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970
  1. ;;; 8sync's website ---
  2. ;;; Copyright © 2016 David Thompson <davet@gnu.org>
  3. ;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
  4. ;;;
  5. ;;; This program is free software: you can redistribute it and/or modify
  6. ;;; it under the terms of the GNU General Public License as published by
  7. ;;; the Free Software Foundation, either version 3 of the License, or
  8. ;;; (at your option) any later version.
  9. ;;;
  10. ;;; This program is distributed in the hope that it will be useful,
  11. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. ;;; GNU General Public License for more details.
  14. ;;;
  15. ;;; You should have received a copy of the GNU General Public License
  16. ;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  17. ;;; Originally by David Thompson, who agreed tho license this under
  18. ;;; GPLv3 or later. Thanks Dave!
  19. (define-module (skribe-utils)
  20. #:use-module (ice-9 match)
  21. #:use-module (syntax-highlight)
  22. #:use-module (syntax-highlight scheme)
  23. #:use-module (syntax-highlight xml)
  24. ;; #:use-module (syntax-highlight c)
  25. #:export (image/caption
  26. scheme-code
  27. xml-code
  28. ;; c-source
  29. code-block
  30. code-block-scheme))
  31. (define (image/caption uri caption)
  32. `((img (@ (class "centered rounded")
  33. (src ,uri)
  34. (alt ,caption)))
  35. (div (@ (class "caption")) ,caption)))
  36. (define (scheme-source source)
  37. (highlights->sxml
  38. (highlight lex-scheme
  39. (match source
  40. ((source ...)
  41. (string-concatenate source))
  42. (_ source)))))
  43. (define (xml-source source)
  44. (highlights->sxml
  45. (highlight lex-xml
  46. (match source
  47. ((source ...)
  48. (string-concatenate source))
  49. (_ source)))))
  50. ;; (define (c-source source)
  51. ;; (highlights->sxml
  52. ;; (highlight lex-c
  53. ;; (match source
  54. ;; ((source ...)
  55. ;; (string-concatenate source))
  56. ;; (_ source)))))
  57. (define (code-block . source)
  58. `(div (@ (class "code"))
  59. ,@source))
  60. (define (code-block-scheme . source)
  61. (apply code-block (scheme-source source)))