custom.scm

(define custom-table?
  (lambda (table-repls)
    (and (list? table-repls)
         (every (lambda (row)
                  (and (list? row)
                       (every (lambda (cell)
                                (string? cell))
                              row)))
                table-repls))))

(define custom-list-as-table
  (lambda (tbl)
    (string-append "'("
      (string-join
        (map (lambda (lst)
          (string-append "(" 
            (string-join
              (map (lambda (elem)
                (string-escape elem)) lst) " ") ")")) tbl) " ") ")")))

japanese-custom.scm

(require-extension (srfi 1))
(require "japanese.scm")

(define ja-rk-rule-rule->table (lambda (rule)
  (map
    (lambda (item)
      ; ((("k" "a")) ("か" "カ" "ｶ")) -> ("ka" "" "か")
      ; ((("k" "k") "k") ("っ" "ッ" "ｯ")) -> ("kk" "k" "っ")
      ; ((("k" "y" "a")) (("き" "キ" "ｷ") ("ゃ" "ャ" "ｬ"))) -> ("kya" "" "きゃ")
      (list
        ; ((("k" "a")) ("か" "カ" "ｶ")) -> "ka"
        (fold-right string-append ""
          (caar item))
        (let ((next-input (cdar item)))
          (or
            (and
              ; ((("k" "a")) ("か" "カ" "ｶ")) -> ""
              (null? next-input) "")
            ; ((("k" "k") "k") ("っ" "ッ" "ｯ")) -> "k"
            (car next-input)))
        (let*
          ((output (cadr item))
            (single-output (car output)))
          (or
            (and
              ; ((("k" "a")) ("か" "カ" "ｶ")) -> "か"
              (string? single-output) single-output)
            ; ((("k" "y" "a")) (("き" "キ" "ｷ") ("ゃ" "ャ" "ｬ"))) -> "きゃ"
            (fold-right string-append ""
              (string-to-list
                (ja-make-kana-str output ja-type-hiragana))))))) rule)))

(define ja-rk-rule-table->rule (lambda (table)
  (map
    (lambda (item)
      ; ("ka" "" "か") -> ((("k" "a")) ("か" "カ" "ｶ"))
      ; ("kk" "k" "っ") -> ((("k" "k") "k") ("っ" "ッ" "ｯ"))
      ; ("kya" "" "きゃ") -> ((("k" "y" "a")) (("き" "キ" "ｷ") ("ゃ" "ャ" "ｬ")))
      (list
        (cons
          (let ((input (car item)))
            (or
              (and
                (string=? input "yen")
                ; ("yen" "" "￥") -> ("yen")
                '("yen"))
              ; ("ka" "" "か") -> ("k" "a")
              (reverse
                (string-to-list input))))
          (let ((next-input (cadr item)))
            (or
              (and
                ; ("ka" "" "か") -> none
                (string=? next-input "") '())
              ; ("kk" "k" "っ") -> "k"
              (cons next-input '()))))
        (let ((output (caddr item)))
          (or
            (and
              (=
                (length
                  (string-to-list output)) 1)
              ; ("ka" "" "か") ->  ("か" "カ" "ｶ")
              (ja-find-kana-list-from-rule ja-rk-rule output))
            ; ("kya" "" "きゃ") -> (("き" "キ" "ｷ") ("ゃ" "ャ" "ｬ"))
            (map
              (lambda (char)
                (ja-find-kana-list-from-rule ja-rk-rule char))
                  (reverse
                    (string-to-list output))))))) table)))

(define-custom 'ja-rk-rule-table (ja-rk-rule-rule->table ja-rk-rule)
               '(ja-rk-rule)
               '(table (N_ "Input") (N_ "Next Input") (N_ "Output"))
               (N_ "Japanese Romaji-Kana rule")
               (N_ "long description will be here."))

(custom-add-hook 'ja-rk-rule-table
                 'custom-set-hooks
                 (lambda ()
                   (set! ja-rk-rule
                     (ja-rk-rule-table->rule ja-rk-rule-table))
                   (ja-rk-rule-update)))

test-custom.scm

  ("test custom-table?"
   (assert-true  (uim-bool '(custom-table?
			     '())))
   (assert-true  (uim-bool '(custom-table?
			     '(("")))))
   (assert-true  (uim-bool '(custom-table?
			     '(("Alice")))))
   (assert-true  (uim-bool '(custom-table?
			     '(("Alice" "Bob")))))
   (assert-true  (uim-bool '(custom-table?
			     '(("Alice" "Bob") ("Carol" "Dave")))))
   (assert-true  (uim-bool '(custom-table?
			     '(("Alice" "Bob") ("Carol" "Dave" "Eve")))))

   (assert-false (uim-bool '(custom-table?
			     #t)))
   (assert-false (uim-bool '(custom-table?
			     "Alice")))
   (assert-false (uim-bool '(custom-table?
			     'Alice)))
   (assert-false (uim-bool '(custom-table?
			     1)))

   (assert-false (uim-bool '(custom-table?
			     '(("Alice" "Bob") #t))))
   (assert-false (uim-bool '(custom-table?
			     '(("Alice" "Bob") "Carol"))))
   (assert-false (uim-bool '(custom-table?
			     '(("Alice" "Bob") 'Carol))))
   (assert-false (uim-bool '(custom-table?
			     '(("Alice" "Bob") 1))))

   (assert-false (uim-bool '(custom-table?
			     '(("Alice" "Bob") ("Carol" "Dave" #t)))))
   (assert-false (uim-bool '(custom-table?
			     '(("Alice" "Bob") ("Carol" "Dave" 'Eve)))))
   (assert-false (uim-bool '(custom-table?
			     '(("Alice" "Bob") ("Carol" "Dave" 1))))))