gitile/highlight/utils.scm \

	gitile/highlight/gitignore.scm

/* language-specific */

/***

 * SCHEME *

 *        ***/

/***

 * GITIGNORE *

 *           ***/

.language-gitignore .syntax-special {

  color: var(--keyword);

}

  #:use-module (gitile highlight gitignore)

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

                     ("gitignore" "gitignore")

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

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

    ("gitignore" (highlight lex-gitignore content))

    (match (pk 'split-lines-content content)

  (pk 'split-tr content)

(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)))

(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)

    (pk 'content content 'tokens tokens)

    (match content

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

                         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))))

  (pk 'content highlights)

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

(define (highlights->sxml highlights)

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

  (define (tag->class tag)

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

  (pk 'highlights flat-highlights)

  (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 (pk (token-add tokens (list tag (tokens->list result)))) remainder)))

      consume-until))