gitile/highlight/gitignore.scm \

	gitile/highlight/shell.scm \

	gitile/highlight/utils.scm

  #:use-module (gitile highlight gitignore)

  #:use-module ((gitile highlight utils) #:prefix gitile:)

       ,@(split-tr (gitile:highlights->sxml (highlight-code content language))))))

  (gitile:highlights->sxml (highlight-code content language)))

(define-module (gitile highlight css)

  #:use-module (ice-9 match)

  #:use-module (srfi srfi-1)

  #:use-module (srfi srfi-11)

  #:use-module (srfi srfi-26)

  #:use-module (syntax-highlight lexers)

  #:export (lex-css))

(define %css-units

  '("cm" "mm" "in" "px" "pt" "pc" "em" "ex" "ch" "rem" "vw" "vh" "vmin" "vmax" "%"))

(define %css-functions

  '("url" "attr" "calc" "cubic-bezier" "hsl" "hsla" "linear-gradient"

    "radial-gradient" "repeating-linear-gradient" "repeating-radial-gradient"

    "rgb" "rgba" "var"))

(define lex-css-whitespace

  (lex-char-set char-set:whitespace))

(define lex-comment

  (lex-tag 'comment (lex-delimited "/*" #:until "*/")))

(define lex-whitespace

  (lex-any

    lex-css-whitespace

    lex-comment))

(define lex-number

  (lex-all

    (lex-char-set char-set:digit)

    (lex-maybe

      (lex-all

        (lex-string ".")

        (lex-char-set char-set:digit)))))

(define lex-css-string

  (lex-any

    (lex-tag 'string (lex-delimited "\""))

    (lex-tag 'string (lex-delimited "'"))))

(define lex-selector

  (lex-any

    (lex-all (lex-string ".") (lex-tag 'class (lex-char-set char-set:letter+digit)))

    (lex-all (lex-string "#") (lex-tag 'id (lex-char-set char-set:letter+digit)))

    (lex-all (lex-string "[")

             (lex-tag 'attr (lex-char-set char-set:letter))

             (lex-any (map lex-string '("=" "~=" "|=" "^=" "$=" "*=")))

             (lex-tag 'value (lex-any lex-css-string

                                      (lex-char-set

                                        (char-set-adjoin char-set:letter+digit #\_))))

             (lex-string "]"))

    (lex-all (lex-string "[")

             (lex-tag 'attr (lex-char-set char-set:letter))

             (lex-string "]"))

    (lex-tag 'selector (lex-all (lex-string "::") (lex-char-set char-set:letter+digit)))

    (lex-tag 'selector (lex-all (lex-string ":") (lex-char-set char-set:letter+digit)))))

(define lex-size

  (lex-tag 'size (lex-all lex-number (lex-any (map lex-string %css-units)))))

(define lex-base-property-value

  (lex-any

    (lex-tag 'size (lex-all lex-number (lex-any (map lex-string %css-units))))

    (lex-tag 'number lex-number)

    (lex-tag 'keyword (lex-char-set (char-set-adjoin char-set:letter #\-)))

    (lex-all (lex-string "#") (lex-tag 'color (lex-char-set (string->char-set "0123456789abcdefABCDEF"))))

    lex-css-string))

(define lex-expression

  (lex-all

    lex-base-property-value

    (lex-zero-or-more

      (lex-all

        lex-whitespace

        (lex-any* (map lex-string '("+" "-" "*" "/")))

        lex-whitespace

        lex-base-property-value))))

(define lex-property-value

  (lex-any

    lex-base-property-value

    (lex-all

      (lex-tag 'function (map lex-string %css-functions))

      (lex-string "(")

      (lex-zero-or-more

        (lex-any

          lex-whitespace

          (lex-string ",")

          lex-expression))

      (lex-string ")"))))

(define lex-property

  (lex-all

    (lex-tag 'property (lex-char-set (char-set-adjoin char-set:letter #\-)))

    lex-whitespace

    (lex-string ":")

    lex-whitespace

    (lex-zero-or-more

      (lex-any

        lex-property-value

        lex-whitespace

        (lex-string ",")

        lex-whitespace))

    (lex-maybe (lex-string ";"))))

(define lex-css

  (lex-consume

    (lex-any

      lex-whitespace

      lex-css-string

      (lex-tag 'tag (lex-any (lex-char-set char-set:letter+digit) (lex-string "*")))

      (lex-tag 'operator (lex-any (map lex-string '(">" "+" "~"))))

      (lex-tag 'selector lex-selector)

      (lex-all (lex-string "(")

               (lex-any lex-selector (lex-char-set char-set:digit))

               (lex-string ")"))

      (lex-string ",")

      (lex-all (lex-string "{")

               (lex-zero-or-more

                 (lex-any

                   lex-whitespace

                   lex-comment

                   lex-property))

               (lex-string "}")))))

;;;; Copyright (C) 2021 Julien Lepiller <julien@lepiller.eu>

;;;;

;;;; SPDX-License-Identifier: AGPL-3.0-or-later

;;;;

;;;; This program is free software: you can redistribute it and/or modify

;;;; it under the terms of the GNU Affero 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 Affero General Public License for more details.

;;;;

;;;; You should have received a copy of the GNU Affero General Public License

;;;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;;;

(define-module (gitile highlight gitignore)

  #:use-module (ice-9 match)

  #:use-module (srfi srfi-1)

  #:use-module (srfi srfi-11)

  #:use-module (srfi srfi-26)

  #:use-module (syntax-highlight lexers)

  #:use-module (gitile highlight utils)

  #:export (lex-gitignore))

(define lex-line

  (lex-consume-until

    (lex-string "\n")

    (lex-any

      (lex-tag 'special (apply lex-any (map lex-string '("*" "**" "?"))))

      (lex-tag 'range (lex-delimited "[" #:until "]"))

      (apply lex-any (map lex-string '("\\!" "\\*" "\\\\" "\\?")))

      (lex-char-set (char-set-complement (char-set #\newline #\\ #\* #\?))))

    #:tag 'line))

(define lex-gitignore

  (lex-consume

    (lex-any (lex-tag 'comment (lex-delimited "#" #:until "\n"))

             (lex-tag 'special (lex-string "!"))

             lex-line)))

  #:use-module (gitile highlight utils)

;;;; Copyright (C) 2021 Julien Lepiller <julien@lepiller.eu>

;;;;

;;;; SPDX-License-Identifier: AGPL-3.0-or-later

;;;;

;;;; This program is free software: you can redistribute it and/or modify

;;;; it under the terms of the GNU Affero 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 Affero General Public License for more details.

;;;;

;;;; You should have received a copy of the GNU Affero General Public License

;;;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;;;

(define-module (gitile highlight utils)

  #:use-module (ice-9 match)

  #:use-module (srfi srfi-1)

  #:use-module (srfi srfi-11)

  #:use-module (syntax-highlight lexers)

  #:export (highlights->sxml

            lex-consume-until))

(define (flatten-highlights highlights)

  (define (flatten-highlights-aux content tokens)

    (match content

      ((? string? s) (if (null? tokens)

                         (list s)

                         `((,@tokens ,s))))

      (((? symbol? token) content ...)

       (flatten-highlights-aux content (cons token tokens)))

      ((? list? content)

       (append-map (lambda (c) (flatten-highlights-aux c tokens)) content))))

  (flatten-highlights-aux highlights '()))

(define (highlights->sxml highlights)

  (define flat-highlights (flatten-highlights highlights))

  (define (tag->class tag)

    (string-append "syntax-" (symbol->string tag)))

  (map (match-lambda

         ((? string? str) str)

         ((content ...)

          (let loop ((tags '()) (text "") (content content))

            (match content

             (() `(span (@ (class ,(string-join (map tag->class tags) " "))) ,text))

             (((? symbol? tag) content ...)

              (loop (cons tag tags) text content))

             (((? string? s) content ...)

              (loop tags (string-append text s) content))))))

       flat-highlights))

(define* (lex-consume-until until lexer #:key (tag #f))

  "Return a lexer that always succeeds with a list of as many consecutive

successful applications of LEXER as possible, consuming the entire input text,

or until a successful match of UNTIL, whichever comes first.  Sections of text

that could not be lexed are returned as plain strings."

  (define (substring* cursor start)

    (substring (cursor-text cursor) start (cursor-position cursor)))

  (define (consume-until tokens cursor)

    (if (cursor-end? cursor)

        (values tokens cursor)

        (let-values (((result remainder) (until tokens cursor)))

          (if result

              (values result remainder)

              (let-values (((result remainder) (lexer tokens cursor)))

                (if result

                    (consume-until result remainder)

                    (values (token-add tokens (cursor->string cursor))

                            (move-cursor-to-end cursor))))))))

  (if tag

      (lambda (tokens cursor)

        (let-values (((result remainder) (consume-until empty-tokens cursor)))

          (values (token-add tokens (list tag (tokens->list result))) remainder)))

      consume-until))

                     (commit "51727cbb7fc05ef743aab2d7b16314ea1ed790e4")))

              (file-name (git-file-name "guile-syntax-highlight" "0.1.51727cb"))

                "1cvacy4y5qxajygb1qg8hvhjdf2xnnwnm5j918cabsi8wfwchig7"))))

  (source #f)