You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

136 lines
3.6 KiB
Scheme

(import chicken scheme)
(use colorize irregex srfi-13 files)
(define *file* (cadr (argv)))
(define *file-contents* (read-string))
(define (guess-type-by-file-extension filename)
(and-let* ((extension (pathname-extension (make-pathname "" filename))))
(case (string->symbol extension)
((scm) 'scheme)
((lisp) 'lisp)
((el) 'elisp)
((c h) 'c)
((cpp) 'c++)
((java) 'java)
((m) 'objective-c)
((erl) 'erlang)
((py) 'python)
((rb) 'ruby)
((hs) 'haskell)
((diff) 'diff)
((css) 'css)
((xml) 'xml)
((xhtml) 'xhtml)
((html) 'html)
(else #f))))
(define (guess-type-by-emacs-major-mode-variable file-contents)
(define (file-local-variables file-contents)
(and-let* ((match (irregex-search (irregex "^.*-\\*-.+-\\*-") file-contents)))
(irregex-search (irregex "-\\*-.+-\\*-") (irregex-match-substring match))))
(define (single-word-mode-line vars)
(irregex-match (irregex "\\s*\\w+\\s*") vars))
(define (mode-variable vars)
(irregex-search (irregex "mode:\\s*\\w+") vars))
(case (and-let* ((vars-match (file-local-variables file-contents))
(var-string (irregex-match-substring vars-match))
(vars (string-downcase
(substring var-string 3 (- (string-length var-string) 3)))))
(cond (#f #f)
((single-word-mode-line vars) =>
(compose string->symbol string-trim-both irregex-match-substring))
((mode-variable vars) =>
(lambda (match)
;; remove mode: and trim
(string->symbol
(string-trim-both (substring (irregex-match-substring match) 5)))))
(else #f)))
((scheme) 'scheme)
((lisp) 'lisp)
((common-lisp) 'common-lisp)
((emacs-lisp) 'elisp)
((c h) 'c)
((c++) 'c++)
((java) 'java)
((erlang) 'erlang)
((python) 'python)
((ruby) 'ruby)
((haskell) 'haskell)
((diff) 'diff)
((css) 'css)
((xml) 'xml)
((xhtml) 'xhtml)
((html) 'html)
(else #f)))
(let ((type (or (guess-type-by-file-extension *file*)
(guess-type-by-emacs-major-mode-variable *file-contents*))))
(if (not type)
(begin (display *file-contents*) (exit 0))
(begin
(display
"<style>
.code-highlight .symbol,.code-highlight .default,.code-highlight .comment {
background-color: white;
color:#59443C;
font-weight:400;
}
.code-highlight i {
font-style:normal;
}
.code-highlight i .symbol {
color:#B64926;
}
.code-highlight .paren1,.code-highlight .paren2,.code-highlight .paren3,.code-highlight .paren4,.code-highlight .paren5,.code-highlight .paren6 {
background-color:inherit;
}
.code-highlight .paren1:hover,.code-highlight .paren2:hover,.code-highlight .paren3:hover,.code-highlight .paren4:hover,.code-highlight .paren5:hover,.code-highlight .paren6:hover {
color:#FFF;
font-weight:700;
}
.code-highlight .paren1:hover {
background-color:#DB7859;
}
.code-highlight .paren2:hover {
background-color:#1B804C;
}
.code-highlight .paren3:hover {
background-color:#9F214E;
}
.code-highlight .paren4:hover {
background-color:#DBA059;
}
.code-highlight .paren5:hover {
background-color:#B64926;
}
.code-highlight .paren6:hover {
background-color:#64A422;
}
.code-highlight .comment {
color:#8C8281;
font-style:italic;
}
</style>")
(display "<span class=\"code-highlight\">")
(display
(html-colorize type *file-contents*))
(display "</span>"))))
(exit 0)