concord-kanbun-dump.el

   1 (defun concord-kanbun-corpus-insert-morpheme (morpheme)
   2   (let ((entry (concord-object-get morpheme '->entry@morpheme))
   3         (word-class (concord-object-get morpheme '->word-class))
   4         (canonical-form (concord-object-get
   5                          morpheme '->entry@morpheme/canonical))
   6         (ja-form (concord-object-get morpheme 'ja-form))
   7         (ja-kana (concord-object-get morpheme 'ja-kana))
   8         (ja-conj-type (concord-object-get morpheme 'ja-conjugation-type))
   9         (name (concord-object-get morpheme '=name))
  10         comment)
  11     (when entry
  12       (setq entry (concord-object-get (car entry) '=name)))
  13     (when word-class
  14       (setq word-class
  15             (split-string
  16              (concord-object-get (car word-class) '=name)
  17              ",")))
  18     (setq canonical-form
  19           (if canonical-form
  20               (concord-object-get (car canonical-form) '=name)
  21             entry))
  22     (setq comment
  23           (and name
  24                (nth 1 (split-string name "\t;\\s "))))
  25     (insert
  26      (format "%s\t%s,%s,%s,%s,%s,*,%s,%s,%s,%s%s\n"
  27              (or entry "*")
  28              (or (car word-class) "*")
  29              (or (nth 1 word-class) "*")
  30              (or (nth 2 word-class) "*")
  31              (or (nth 3 word-class) "*")
  32              (or (nth 4 word-class) "*")
  33              (or canonical-form "*")
  34              ja-form ja-kana ja-conj-type
  35              (if comment
  36                  (format "\t; %s" comment)
  37                "")))))
  38
  39 (defun concord-kanbun-dump-file (source dest-dir)
  40   (with-temp-buffer
  41     (let ((coding-system-for-write 'utf-8-jp-er)
  42           (i 1)
  43           s-obj morphemes)
  44       (while (setq s-obj (concord-decode-object
  45                           '=id (intern (format "%s/%s" source i))
  46                           'sentence@zh-classical))
  47         (when (setq morphemes (concord-object-get s-obj '->morphemes))
  48           (dolist (morpheme morphemes)
  49             (concord-kanbun-corpus-insert-morpheme morpheme))
  50           (insert "EOS\n"))
  51         (setq i (1+ i)))
  52       (write-region (point-min)(point-max)
  53                     (expand-file-name source dest-dir)))))