110 lines
2.7 KiB
Text
110 lines
2.7 KiB
Text
|
#!@GUILE@ --no-auto-compile
|
||
|
|
-*- scheme -*-
|
||
|
|
!#
|
||
|
|
|
||
|
|
;; Can be called with a trailing argument pointing to the file on disk.
|
||
|
|
|
||
|
|
(use-modules
|
||
|
|
(runewidth internal)
|
||
|
|
(ice-9 pretty-print)
|
||
|
|
(ice-9 peg)
|
||
|
|
(ice-9 format)
|
||
|
|
(ice-9 exceptions)
|
||
|
|
(ice-9 match)
|
||
|
|
(srfi srfi-1))
|
||
|
|
|
||
|
|
(define stdout (current-output-port))
|
||
|
|
|
||
|
|
(define emoji-url
|
||
|
|
"https://unicode.org/Public/13.0.0/ucd/emoji/emoji-data.txt")
|
||
|
|
|
||
|
|
(define-peg-pattern @emoji-category all
|
||
|
|
(* (peg "[a-zA-Z_]")))
|
||
|
|
|
||
|
|
(define-peg-pattern @emoji-datum body
|
||
|
|
(and @codepoint-range (* @ws) (ignore ";") (* @ws) @emoji-category))
|
||
|
|
|
||
|
|
(define-peg-pattern @emoji-line body
|
||
|
|
(and @emoji-datum (* @ws) @comment))
|
||
|
|
|
||
|
|
(define emoji-list '())
|
||
|
|
|
||
|
|
(define (process-emoji-line line)
|
||
|
|
(define tree (peg:tree (match-pattern @emoji-line line)))
|
||
|
|
|
||
|
|
(define (in-surrogate-range num)
|
||
|
|
(and (>= num #xd800)
|
||
|
|
(<= num #xdfff)))
|
||
|
|
|
||
|
|
(unless (or (not tree)
|
||
|
|
(null? tree)
|
||
|
|
(eq? '@comment (car tree)))
|
||
|
|
|
||
|
|
(match tree
|
||
|
|
(((('@codepoint-range
|
||
|
|
('@codepoint codepoints) ...)
|
||
|
|
('@emoji-category category))
|
||
|
|
('@comment comment))
|
||
|
|
|
||
|
|
(with-exception-handler
|
||
|
|
(λ (err)
|
||
|
|
(format stdout "Skipping line due to error :: ")
|
||
|
|
(format-exception-msg stdout err))
|
||
|
|
(λ ()
|
||
|
|
(let ((f (hex-string->integer (first codepoints)))
|
||
|
|
(l (hex-string->integer (last codepoints))))
|
||
|
|
|
||
|
|
(when (or (in-surrogate-range f)
|
||
|
|
(in-surrogate-range l))
|
||
|
|
(error (format #f "chars in surrogate range ~x -> ~x" f l)))
|
||
|
|
|
||
|
|
(when (and (equal? "Extended_Pictographic" category)
|
||
|
|
(> l #xFF))
|
||
|
|
(set! emoji-list (cons (list f l) emoji-list)))))
|
||
|
|
#:unwind? #t)))))
|
||
|
|
|
||
|
|
(define line-func
|
||
|
|
(if (= 2 (length (command-line)))
|
||
|
|
(λ ()
|
||
|
|
(file-to-lines (last (command-line)) stdout))
|
||
|
|
(λ ()
|
||
|
|
(wget-to-lines emoji-url stdout))))
|
||
|
|
|
||
|
|
(define file "runewidth/emoji.scm")
|
||
|
|
|
||
|
|
(format stdout "Writing to ~a...\n" file)
|
||
|
|
|
||
|
|
(with-output-to-file file
|
||
|
|
(λ ()
|
||
|
|
(display ";; Code generated by script/generate. DO NOT EDIT\n\n")
|
||
|
|
|
||
|
|
(for-each process-emoji-line (line-func))
|
||
|
|
|
||
|
|
(pretty-print
|
||
|
|
`(define-module (runewidth emoji)
|
||
|
|
#:use-module (srfi srfi-1)
|
||
|
|
#:export (char-set:emoji)))
|
||
|
|
|
||
|
|
(pretty-print
|
||
|
|
`(define emoji-list ',emoji-list))
|
||
|
|
|
||
|
|
(display "\n")
|
||
|
|
|
||
|
|
(pretty-print
|
||
|
|
`(define char-set:emoji (char-set)))
|
||
|
|
|
||
|
|
(display "\n")
|
||
|
|
|
||
|
|
(pretty-print
|
||
|
|
`(for-each
|
||
|
|
(λ (pair)
|
||
|
|
(ucs-range->char-set!
|
||
|
|
(first pair)
|
||
|
|
(+ 1 (second pair))
|
||
|
|
#t char-set:emoji))
|
||
|
|
emoji-list))
|
||
|
|
|
||
|
|
(display "Code generation complete.\n" stdout)))
|
||
|
|
|
||
|
|
(format stdout "Written to ~a.\n" file)
|