#cs
(module java (lib "slideshow.ss" "slideshow")
  (require "colors.ss"
           "code.ss")

  (provide ktt ttt vtt ott itt ctt c+tt
	   java java/copy)

  (define (italic-tt s)
    (text s `(bold italic . modern) (current-font-size)))

  (define (ktt s) (colorize (tt s) "black"))
  (define (ttt s) (colorize (tt s) BlueColor))
  (define (attt s) (colorize (italic-tt (substring s 1)) BlueColor))
  (define (vtt s) (colorize (tt s) literal-color))
  (define (ott s) (colorize (tt s) comment-color))
  (define (itt s) (colorize (tt s) id-color))
  (define (aitt s) (colorize (italic-tt (substring s 1)) id-color))
  (define (bitt s) (colorize (italic-tt (substring s 2 (- (string-length s) 2))) id-color))
  (define (ctt s) (colorize (tt s) comment-color))
  (define (c+tt s) (colorize (italic-tt s) comment-color))
  
  (define res
    `((#rx"//.*" ,ctt)
      (#rx"interface" ,ktt)
      (#rx"String" ,ttt)
      (#rx"double" ,ttt)
      (#rx"float" ,ttt)
      (#rx"byte" ,ttt)
      (#rx"int" ,ttt)
      (#rx"short" ,ttt)
      (#rx"long" ,ttt)
      (#rx"boolean" ,ttt)
      (#rx"void" ,ttt)
      (#rx"true" ,vtt)
      (#rx"false" ,vtt)
      (#rx"null" ,vtt)
      (#rx"abstract" ,ktt)
      (#rx"class" ,ktt)
      (#rx"extends" ,ktt)
      (#rx"implements" ,ktt)
      (#rx"this" ,ktt)
      (#rx"new" ,ktt)
      (#rx"if" ,ktt)
      (#rx"else" ,ktt)
      (#rx"return" ,ktt)
      (#rx"super" ,ktt)
      (#rx"while" ,ktt)
      (#rx"for" ,ktt)
      (#rx"static" ,ktt)
      (#rx"public" ,ktt)
      (#rx"private" ,ktt)
      (#rx"protected" ,ktt)
      (#rx"package" ,ktt)
      (#rx"import" ,ktt)
      (#rx"throw" ,ktt)
      (#rx"throws" ,ktt)
      (#rx"switch" ,ktt)
      (#rx"try " ,ktt)
      (#rx"finally" ,ktt)
      (#rx"catch" ,ktt)
      (#rx"instanceof" ,ktt)
      (#rx"do( |$)" ,ktt)
      (#rx"[.][.][.][^.]+[.][.][.]" ,c+tt)
      (#rx"[;(){},.]" ,ott)
      (#rx"\"[^\"]*\"" ,vtt)
      (#rx"__[^_]*__" ,bitt)
      (#rx"(-|)[0-9]+(e[0-9]+)" ,vtt)
      (#rx"(-|)[0-9]+[.][0-9]+(e[0-9]+)" ,vtt)
      (#rx"[A-Z][a-zA-Z0-9]*" ,ttt)
      (#rx"_[A-Z][a-zA-Z0-9]*" ,attt)
      (#rx"[a-zA-Z0-9]+" ,itt)
      (#rx"_[a-zA-Z0-9]+" ,aitt)
      (#rx"[][=+*/-]" ,ktt)))
      
  
  (define (java . l)
    (apply vl-append line-sep
           (map (lambda (s)
                  (let loop ([s s])
                    (let* ([l (map (lambda (re)
                                     (let ([m (regexp-match-positions (car re) s)])
                                       (cons (or m '((+inf.0))) (cadr re))))
                                   res)]
                           [minp (apply min (map caaar l))])
                      (if (equal? minp +inf.0)
                          (tt s)
                          (let ([mf (ormap (lambda (mf)
                                            (and (= (caaar mf) minp)
                                                 mf))
                                          l)])
                            (hbl-append (tt (substring s 0 (caaar mf)))
                                        ((cdr mf) (substring s (caaar mf) (cdaar mf)))
                                        (loop (substring s (cdaar mf)))))))))
                l)))

  (define (java/copy s . l)
    (values (scale/improve-new-text (apply java l) s)
	    (apply string-append
		   (map (lambda (s) (string-append s "\n"))
			l))))
  
  )