Download
(require 'widget)
(eval-when-compile
(require 'wid-edit))
(defvar flashmaker-list nil
"The list of entries read while making a flashcard deck.")
(defun flashmaker-key (entry)
"Return the key of ENTRY.
This is a multi-byte string."
(nth 0 entry))
(defun flashmaker-meanings (entry)
"Return the meanings of ENTRY.
This is a list of strings."
(nth 1 entry))
(defun flashmaker-readings (entry)
"Return the readings of ENTRY.
This is a list of multi-byte strings or nil."
(nth 2 entry))
(defun flashmaker-index (entry)
"Return the index of ENTRY.
This is a number or nil."
(nth 3 entry))
(defun flashmaker-set-index (entry val)
"Set the index of ENTRY to VAL.
This must be a number or nil."
(setcar (nthcdr 3 entry) val))
(defun flashmaker-entry (key)
"Return the entry from `flashmaker-list' for KEY."
(assoc key flashmaker-list))
(defun flashmaker-parse (file parse-entry-func &optional args)
"Parse FILE and return the entries in a list.
You might want to bind `coding-system-for-read' before calling this function.
For every line, PARSE-ENTRY-FUNC is called with ARGS for arguments."
(let (result entry)
(with-temp-buffer
(insert-file-contents file)
(flashmaker-parse-entries file (buffer-size) parse-entry-func args))))
(defun flashmaker-parse-entries (file total parse-entry-func &optional args)
"Parse the lines of the current buffer.
FILE is the filename.
TOTAL indicates the buffer size.
For every line, PARSE-ENTRY-FUNC is called with ARGS for arguments."
(let (entry result)
(while (not (eobp))
(setq entry (apply 'funcall parse-entry-func args))
(when entry
(setq result (cons entry result)))
(forward-line)
(message "Parsing %s...%d%%" file (/ (* 100.0 (point)) total)))
(message "Parsing %s...done" file)
(nreverse result)))
(defun flashmaker-parse-kanjidic-entry (&optional index-regexp)
"Parse current line of kanjidic dictionaries.
With an optional INDEX-REGEXP, the index will be set to the first group
in the regexp, converted to a number, if matched."
(when (looking-at "\\sw+")
(let ((key (match-string 0))
(start (point))
(end (line-end-position))
meanings
readings
index)
(while (re-search-forward "{\\([^}]*\\)}" end t)
(setq meanings (cons (match-string 1) meanings)))
(when meanings
(goto-char start)
(while (re-search-forward " \\([^A-Z0-9{ ]+\\)" end t)
(setq readings (cons (match-string 1) readings)))
(when index-regexp
(goto-char start)
(when (re-search-forward index-regexp end t)
(setq index (string-to-number (match-string 1))))))
(when (and key meanings)
(list key
(nreverse meanings)
(nreverse readings)
index)))))
(defun flashmaker-parse-kanjidic-entry-string (str &optional regexp)
"Parse STR for testing."
(with-temp-buffer
(insert str)
(beginning-of-line)
(flashmaker-parse-kanjidic-entry regexp)))
(assert (and (equal (flashmaker-parse-kanjidic-entry-string
" $Bnl (B 6e6c U9264 N4841 B167 S13 I8a5.17 P1-8-5 O1939 Wgu Ygou1 XJ03343 V6250 Q8712.0 MN40319 MP11.0518 $B%3%& (B $B%/ (B $B$+$. (B {hook} {barb} {gaff} {[brackets]}")
'(" $Bnl (B" ("hook" "barb" "gaff" "[brackets]") (" $B%3%& (B" " $B%/ (B" " $B$+$. (B") nil))
(equal (flashmaker-parse-kanjidic-entry-string
" $BOS (B 4f53 U8155 N3786 B130 S12 G8 H1006 F1076 P1-4-8 L1418 K1114 I4b8.6 Wwan Ywan4 IN1299 V4837 DR3956 DK687 DO1180 Q7321.2 MN29631 MP9.0337 E1945 $B%o%s (B $B$&$G (B {arm} {ability} {talent} " " IN\\([0-9]+\\) ")
'(" $BOS (B" ("arm" "ability" "talent") (" $B%o%s (B" " $B$&$G (B") 1299))))
(when nil
(setq flashmaker-list (flashmaker-parse "kanjidic" 'flashmaker-parse-kanjidic-entry))
(flashmaker-key (car flashmaker-list))
(length flashmaker-list))
(defun flashmaker-parse-edict-entry ()
"Parse current line of edict dictionaries.
Extra meanings are ignored"
(when (looking-at "\\(\\w+\\) +\\(\\[\\(.*\\)\\] +\\)?/\\(.*\\)/")
(let* ((key (match-string 1))
(start (point))
(end (line-end-position))
(readings (and (match-string 3) (list (match-string 3))))
meanings)
(dolist (meaning (mapcar (lambda (s)
(mapconcat 'identity
(split-string s "_") " "))
(split-string (match-string 4) "/")))
(when (string-match "^\\(([^ \t]+)\\s-*\\)+\\(.*\\)" meaning)
(setq meaning (match-string 2 meaning)))
(when (not (string= "" meaning))
(setq meanings (cons meaning meanings))))
(when (and key meanings)
(list key
(nreverse meanings)
readings
nil)))))
(defun flashmaker-parse-edict-entry-string (str)
"Parse STR for testing."
(with-temp-buffer
(insert str)
(beginning-of-line)
(flashmaker-parse-edict-entry)))
(assert (and (equal (flashmaker-parse-edict-entry-string
" $B$$$1$$$1 (B /bitch/")
'(" $B$$$1$$$1 (B" ("bitch") nil nil))
(equal (flashmaker-parse-edict-entry-string
" $B$$$/$D$b$N (B /many/a (great) number of/")
'(" $B$$$/$D$b$N (B" ("many" "a (great) number of") nil nil))
(equal (flashmaker-parse-edict-entry-string
" $B$$$/ (B /(v5k-s) (X) (col) to come/to orgasm/")
'(" $B$$$/ (B" ("to come" "to orgasm") nil nil))
(equal (flashmaker-parse-edict-entry-string
" $B$$$8$$$8 (B /(adv,n) reserved/timid/servile/unable to be honest/")
'(" $B$$$8$$$8 (B" ("reserved" "timid" "servile" "unable to be honest") nil nil))
(equal (flashmaker-parse-edict-entry-string
" $B$"$l (B /(int,n) (1) that/that thing/(2) (X) (col) genitals/(3) menses/(P)/")
;; unumerated meanings, common use
'(" $B$"$l (B" ("that" "that thing" "genitals" "menses") nil nil))))
(when nil
(setq flashmaker-list (flashmaker-parse "/usr/share/edict/edict" 'flashmaker-parse-edict-entry))
(flashmaker-key (car flashmaker-list))
(length flashmaker-list))
(defun flashmaker-index-sort (a b)
"Predicate to sort two entries A and B by index as returned by `flashmaker-index'.
Return t if the first element is less than the second."
(let ((x (flashmaker-index a))
(y (flashmaker-index b)))
(or (and x (not y))
(and x y (< x y)))))
(defvar flashmaker-wizard-kanjidic nil)
(defvar flashmaker-wizard-edict nil)
(defvar flashmaker-wizard-index-regexp nil)
(defvar flashmaker-wizard-file nil)
(defvar flashmaker-wizard-limit nil)
(defun flashmaker-edict-filter ()
"Interactively filter a word list using a second dictionary.
Use this to sort a dictionary in EDICT format according to information
gleaned from a second dictionary in KANJIDIC format. One example is to
extract all kanji from the KANJIDIC with grade 1 and filter all words
from the EDICT with only grade 1 kanjis. The information required is
entered interactively in a separate buffer.
Note that due to the stripping away of information from the EDICT file,
entries that differ in reading but not in kanji and meanings will appear
as duplicates. No attempt is made to prevent these -- pass the result
through the uniq command-line utility to remove them. There are also
entries with the same kanji and slightly different meanings depending
on the reading. These are not merged."
(interactive)
(switch-to-buffer "*Flashmaker EDICT filter*")
(kill-all-local-variables)
(make-local-variable 'flashmaker-wizard-kanjidic)
(make-local-variable 'flashmaker-wizard-edict)
(make-local-variable 'flashmaker-wizard-index-regexp)
(make-local-variable 'flashmaker-wizard-limit)
(make-local-variable 'flashmaker-wizard-file)
(let ((inhibit-read-only t))
(erase-buffer)
(widget-insert
"Welcome to the EDICT Filter Wizard\n"
"\n"
"Use M-ESC to complete filenames.\n"
"\n"
"The KANJIDIC will be used to create a mapping table.\n"
"\n")
(setq flashmaker-wizard-kanjidic
(widget-create 'file :must-match t "/usr/share/edict/kandidoc"))
(widget-insert
"\n"
"Every kanji from the KANJIDIC will be mapped to an index. The index\n"
"Is determined from the KANJIDIC file. Please choose one of the\n"
"following indexes.\n"
"\n")
(setq flashmaker-wizard-index-regexp
(widget-create
'menu-choice
:value " G\\([0-9]+\\) "
:tag "Index to use"
'(const :tag "Jouyou grade level" " G\\([0-9]+\\) ")
'(const :tag "Frequency count" " F\\([0-9]+\\) ")
'(const :tag "Stroke count" " S\\([0-9]+\\) ")
'(const :tag "Radical number (Bushu)" " B\\([0-9]+\\) ")
'(const :tag "Spahn & Hadamitzky index" " IN\\([0-9]+\\) ")
'(const :tag "Henshall index" " E\\([0-9]+\\) ")
'(const :tag "Gakken Kanji Dictionary index" " K\\([0-9]+\\) ")
'(const :tag "Heisig index" " L\\([0-9]+\\) ")
'(const :tag "O'Neill index" " O\\([0-9]+\\) ")
'(const :tag "New Nelson index" " V\\([0-9]+\\) ")
'(const :tag "Nelson index" " N\\([0-9]+\\) ")
'(const :tag "Halpern index" " H\\([0-9]+\\) ")
'regexp))
(widget-insert
"\n"
"If you want, you can limit the entries used by providing a max.\n"
"index. A good value might be 50, 100, 200, or 500 -- depending on\n"
"how good you are. Note that some indexes are very special. The\n"
"Jouyou grade level, for example, only has levels 1 to 8, so if you\n"
"choose the Jouyou grade level above, you should provide a very small\n"
"limit here, eg. 1, 2, or 3.\n"
"\n")
(setq flashmaker-wizard-limit
(widget-create 'number 2))
(widget-insert
"\n"
"The EDICT file contains translations for a string. The table\n"
"derived from the KANJIDIC will be used to assign a score to every\n"
"entry in the EDICT file. In fact, every kanji in the entry will\n"
"be looked up in the table; the highest index found will be used for\n"
"the entire entry. This allows to sort the entries by the most\n"
"difficult or the least frequent kanji in the entry.\n"
"\n")
(setq flashmaker-wizard-edict
(widget-create 'file :must-match t "/usr/share/edict/edict"))
(widget-insert
"\n"
"The resulting flashcard deck will contain all the entries of the\n"
"EDICT file, sorted by the index given above. It will be very big.\n"
"Please give the name of the flashcard deck file to write.\n"
"\n")
(setq flashmaker-wizard-file
(widget-create 'file "~/sorted-edict-flashcard"))
(widget-insert
"\n"
"The entire process will take a long time. If you want to abort\n"
"now, just kill the buffer. Should Emacs ask you which coding system\n"
"to use when saving the file, and you have no preferences, then choose\n"
"iso-2022-jp.\n"
"\n")
(widget-create
'push-button
:notify (lambda (&rest ignore)
(flashmaker-edict-do-filter
(widget-value flashmaker-wizard-kanjidic)
(widget-value flashmaker-wizard-edict)
(widget-value flashmaker-wizard-index-regexp)
(widget-value flashmaker-wizard-limit)
(widget-value flashmaker-wizard-file)))
"Finish"))
(use-local-map widget-keymap)
(widget-setup))
(defvar flashmaker-edict-filter-table nil
"This is an alist of elements (KEY . VALUE).
KEY is is a character and VALUE the corresponding index.
Used by `flashmaker-edict-do-filter'.")
(defconst flashmaker-max-index 99999
"Max. index for `flashmaker-edict-filter-index'.")
(defun flashmaker-edict-filter-index (str)
"Return the highest index for STR according to `flashmaker-edict-filter-table'."
(let ((val (apply 'max
(mapcar
(lambda (c)
(or (cdr (assq c flashmaker-edict-filter-table))
flashmaker-max-index))
(string-to-list str)))))
val))
(defun flashmaker-edict-do-filter (kanjidoc edict index-regexp limit file)
"Does the work for `flashmaker-edict-filter'."
(when (string= kanjidoc edict)
(error "The KANJIDOC and the EDICT file are the same"))
(let ((list (flashmaker-parse kanjidoc
'flashmaker-parse-kanjidic-entry
(list index-regexp))))
(message "Limitting the kanjis used...")
(when limit
(let (result)
(dolist (entry list)
(when (and (flashmaker-index entry)
(<= (flashmaker-index entry) limit))
(setq result (cons entry result))))
(setq list result)))
(message "Creating mapping table...")
(setq flashmaker-edict-filter-table
(mapcar (lambda (entry)
(cons (string-to-char (flashmaker-key entry))
(flashmaker-index entry)))
list))
(setq list (flashmaker-parse edict
'flashmaker-parse-edict-entry))
(message "Replacing index...")
(let (result index)
(dolist (entry list)
(setq index (flashmaker-edict-filter-index (flashmaker-key entry)))
(when (< index flashmaker-max-index)
(flashmaker-set-index entry index)
(setq result (cons entry result))))
(setq list (nreverse result)))
(message "Sorting list...")
(setq list (sort list 'flashmaker-index-sort))
(message "Saving %s..." file)
(flashmaker-save file list))
(message "Creating filter flashcard deck...done"))
(defun flashmaker-kanjidic-filter ()
"Interactively filter a dictionary in the KANJIDIC format.
This creates a new flashcard deck with a subset of the entries in the
KANJIDIC file."
(interactive)
(switch-to-buffer "*Flashmaker KANJIDIC filter*")
(kill-all-local-variables)
(make-local-variable 'flashmaker-wizard-kanjidic)
(make-local-variable 'flashmaker-wizard-index-regexp)
(make-local-variable 'flashmaker-wizard-file)
(make-local-variable 'flashmaker-wizard-limit)
(let ((inhibit-read-only t))
(erase-buffer)
(widget-insert
"Welcome to the KANJIDIC Filter Wizard\n"
"\n"
"Use M-ESC to complete filenames.\n"
"\n"
"The KANJIDIC will be read and a subset of its entries will be used\n"
"for the flashcard deck.\n"
"\n")
(setq flashmaker-wizard-kanjidic
(widget-create 'file :must-match t "/usr/share/edict/kandidoc"))
(widget-insert
"\n"
"The entries in the KANJIDIC file can be sorted according to an index.\n"
"This is because the entries already contain the index positions for a\n"
"variety of dictionaries. Choose one of the indexes below, by which\n"
"the entries should be sorted.\n"
"\n")
(setq flashmaker-wizard-index-regexp
(widget-create
'menu-choice
:value " G\\([0-9]+\\) "
:tag "Index regexp"
'(const :tag "No index" nil)
'(const :tag "Jouyou grade level" " G\\([0-9]+\\) ")
'(const :tag "Frequency count" " F\\([0-9]+\\) ")
'(const :tag "Stroke count" " S\\([0-9]+\\) ")
'(const :tag "Radical number (Bushu)" " B\\([0-9]+\\) ")
'(const :tag "Spahn & Hadamitzky index" " IN\\([0-9]+\\) ")
'(const :tag "Henshall index" " E\\([0-9]+\\) ")
'(const :tag "Gakken Kanji Dictionary index" " K\\([0-9]+\\) ")
'(const :tag "Heisig index" " L\\([0-9]+\\) ")
'(const :tag "O'Neill index" " O\\([0-9]+\\) ")
'(const :tag "New Nelson index" " V\\([0-9]+\\) ")
'(const :tag "Nelson index" " N\\([0-9]+\\) ")
'(const :tag "Halpern index" " H\\([0-9]+\\) ")
'regexp))
(widget-insert
"\n"
"If you want, you can limit the entries written by providing a max.\n"
"index. A good value might be 50, 100, 200, or 500 -- depending on\n"
"how good you are. Note that some indexes are very special. The\n"
"Jouyou grade level, for example, only has levels 1 to 8, so if you\n"
"choose the Jouyou grade level above, you should provide a very small\n"
"limit here, eg. 1, 2, or 3.\n"
"\n")
(setq flashmaker-wizard-limit
(widget-create 'number 2))
(widget-insert
"\n"
"The resulting flashcard deck will contain all the entries of the\n"
"KANJIDIC file, sorted by the index given above. It will be big.\n"
"Please give the name of the flashcard deck file to write.\n"
"\n")
(setq flashmaker-wizard-file
(widget-create 'file "~/sorted-kanjidic-flashcard"))
(widget-insert
"\n"
"The entire process will take a a few seconds. If you want to abort\n"
"now, just kill the buffer. Should Emacs ask you which coding system\n"
"to use when saving the file, and you have no preferences, then choose\n"
"iso-2022-jp.\n"
"\n")
(widget-create
'push-button
:notify (lambda (&rest ignore)
(flashmaker-kanjidic-do-filter
(widget-value flashmaker-wizard-kanjidic)
(widget-value flashmaker-wizard-index-regexp)
(widget-value flashmaker-wizard-limit)
(widget-value flashmaker-wizard-file)))
"Finish"))
(use-local-map widget-keymap)
(widget-setup))
(defun flashmaker-kanjidic-do-filter (kanjidoc index-regexp limit file)
"Does the work for `flashmaker-edict-filter'."
(let ((list (flashmaker-parse kanjidoc
'flashmaker-parse-kanjidic-entry
(list index-regexp))))
(message "Sorting list...")
(when limit
(let (result)
(dolist (entry list)
(when (and (flashmaker-index entry)
(<= (flashmaker-index entry) limit))
(setq result (cons entry result))))
(setq list result)))
(setq list (sort list 'flashmaker-index-sort))
(message "Saving %s..." file)
(flashmaker-save file list))
(message "Creating filter flashcard deck...done"))
(defun flashmaker-save (file list &optional reverse)
"Export LIST to FILE.
When called with the optional argument REVERSE, or using
a prefix argument, the entries are written in reverse."
(setq reverse (or reverse current-prefix-arg))
(setq test list)
(with-temp-buffer
(let ((entries list)
entry)
(while entries
(setq entry (car entries)
entries (cdr entries))
(if reverse
(insert (format "%s : %s\n"
(mapconcat 'identity
(flashmaker-meanings entry)
", ")
(flashmaker-key entry)))
(insert (format "%s : %s\n"
(flashmaker-key entry)
(mapconcat 'identity
(flashmaker-meanings entry)
", "))))))
(write-file file)))
(provide 'flashmaker)