edict-el-1.06.orig/0040755000175000017500000000000006610567263013424 5ustar rolandrolandedict-el-1.06.orig/ChangeLog.0960100644000175000017500000004325606524336052015514 0ustar rolandrolandThu Apr 23 17:04:59 1992 Per Hammarlund (perham at perham.nada.kth.se) * Stepped up the version number, 0.9.6. * Added edict-add-word, which basically initiates a private dictionary session without starting with a word. Wed Apr 22 09:30:14 1992 Per Hammarlund (perham at perham.nada.kth.se) * Changed the declaration of the *edict-rmoaji-remaps* to be a defvar followed by a setq. * Rewrote and corrected some of the short getting started guide at the beginning of edict.el. Mon Apr 6 06:58:59 1992 Bob Kerns (rwk at taunton.crl.dec.com) * Add eval-when around defstruct. The compiler half of eval-when is in a patch that is loading into the compiler by edict.install. * Make the english-plural rule exclude ies. * Add edict-plural-ies. * Call edict-expand-string with the right arguments. Fri Apr 3 20:38:03 1992 Bob Kerns (rwk at taunton.crl.dec.com) * Add english-plurals rule. * Add syntax types. Thu Apr 2 02:18:27 1992 Bob Kerns (rwk at taunton.crl.dec.com) * Add rules for だ／です and their conjucations. * forgot to exclude newlines in edict-slash-internal. * forgot to exclude newlines in edict-char-bracket. * Forgot to exclude newlines in edict-line-has-english. * Forgot to exclude newlines in edict-parse-entry. * Forgot to exclude newlines in pattern for finding english defs in edict-insert-english. Wed Apr 1 13:28:18 1992 Bob Kerns (rwk at taunton.crl.dec.com) * Put the cursor at the right place when creating an entry and there's no english. * Sent to perham * A bunch of minor tuneups to various things... * Make the dictionary-editing commands go through a common wrapper to keep the electric stuff consistent. * Add similar command for /. * Add edict-open-bracket, edict-close-bracket, in dictionary editing mode. * Allow edict-new-entry to take an argument. <= 4 copies the kanji word into the new entry; >4 (i.e. c-U c-U) copies both the word and definition, allowing you to enter an alternate yomi. * Split out edict-insert-entry from edict-add-entry-to-file, and add an inverse: edict-parse-entry. * Allow a list of translations in edict-add-entry-to-file. * Allow windows to be as small as emacs will allow. This is important, because when we look for a suitably-sized window, this is all the bigger we look for. * Add some more comments, and convert and/or/one-armed-if expressions into when/unless, since those are now provided by the (require 'cl). This makes a number of things more readable. * Move edict-test-rule and edict-test-string to edict-test.el. * Merge in Per's changes below. * Add a bit more commentary. * Fix mising "w" and "W" in remap table. Tue Mar 31 06:16:26 1992 Bob Kerns (rwk at taunton.crl.dec.com) * edict-subst-affix's args can now be any function of one argument (the matched substring). * Optimize edict-ignore in edict-subst-modified-affix, and add it to edict-subst-affix. * Add 数なし rule to try looking up number expressions without the number. Mon Mar 30 10:16:21 1992 Per Hammarlund (perham at perham.nada.kth.se) * Made sure that edict-new-entry put a closing '/' at the end of the current row. This only works when the user does edict-new-entry, not for save. Sigh. * Up version number 0.9.5 * Added handling of SKK in edict-set-henkan. Crude implementation. Mon Mar 30 00:19:05 1992 Bob Kerns (rwk at taunton.crl.dec.com) * Don't insert [] after hiragana-only words, either! * Electric dictionary editing: When adding entries, Tab now moves between fields, and Return starts a new entry on the next line. It arranges to be in nihongo mode when appropriate. Also, it no longer inserts [] after katakana entries. Sun Mar 29 14:03:09 1992 Bob Kerns (rwk at taunton.crl.dec.com) * Replace (eval (cons 'and kludge with every. * filter out some て->てる in 一段のconjunctive * Optimize edict-identity in rule RHS's * Use regexp character categories where possible. * fix typo: window-next -> next-window. Fri Mar 27 02:02:58 1992 Bob Kerns (rwk at taunton.crl.dec.com) * Get around nemacs regexp bug that was still deleting the katakan long-sound dash even after I fixed the regexp. (Off-by-one error on the handling of the end of a range. Sigh.) Thu Mar 26 20:56:00 1992 Bob Kerns (rwk at taunton.crl.dec.com) * Whitespace list accidentally included the katakana long-sound dash. * The conjunctive rules patterns only allowed kanji, not kana-only spellings. Wed Mar 25 17:57:09 1992 Bob Kerns (rwk at taunton.crl.dec.com) * Merge in Per's change to edict-eigo-one-word. * Up the version to 0.9.4 * Make whitespace stuff include all the different funny chars. * Show the dictionary version number(s) after loading them. * Replace '(lambda ...) with (function (lambda ...)). * Make the default edict pathname be just "edictj", so it searches load path to find it. This should minimize installation headaches. You can still override this in your .emacs file. * Use load-path to search for edict files if they're relative. * Handle ー and punctuation in kanji insertion. Also, let a couple of rules work with katakana stems (i.e. する-derived stuff). Mon Mar 23 11:18:24 1992 Per Hammarlund (perham at perham.nada.kth.se) * Fixed a bug that caused it not to find a english word at the beginning of the buffer. It ran backward over (point-min). Change made in "edict-eigo-one-word", >= to >. Mon Mar 23 07:37:03 1992 Bob Kerns (rwk at taunton.crl.dec.com) * Convert to JIS * Increment version to 0.9.3 * Add edict-insert, edict-insert-english, edict-insert-日本語. The main one to use is edict-insert, which figures out what language to insert based on the last lookup. * Disallow the け -> く -> い path. * For the various ます rules, filter out cases derived from ませる. * Don't apply the potential-form rules if there's just the suffix. * 形容詞ーく -- Be a whole lot more careful about what we consider an adverb/adjective, based on the previous form. This should eliminate a lot of くー行 verbs from having spurious forms. * I decided that this filtering scheme isn't so bad after all, if the decision is made on just the preceding version. Having parts of speech would still be better, since it would localize the knowledge of what part of speech an ending could be. But I think this will do for now. * Separate out (く|て|んで)る case from 助動詞ー１ to 助動詞ー１ａ, because this case must not include く. くる should not become く. ーる is just a non-grammatical conversational case, anyway, and only occurs after て so far as I know. * Add more filtering to problematic conjunctive forms. * Add filtering to filter out rules which are locally plausible, but could not be applied if what was removed is taken into consideration. eg 行く -> 行い -> 行う is not legit, even though each individual step is, because the first step is based on the assumption that it's an adverb, and turns it into an adjective. The second assumes its the conjunctive form of a verb, and tries to find the dictionary form. This first pass is pretty bogus. What it does is try to deduce it from what endings it has had along the way. This can't really work, because there's no reasonable way to determine whether the ending in question is applying to this root, or or some further extention of this root. The right thing, is for rules to filter by/assert a part of speach. But first, I'm going to try this, just to get things going. * Remove redundant rule: 「せず」の特別ルール * Merge in Per's changes. Up the version to 0.9.2 * Provide error checking for unrooted patterns, so that last bug can't happen again. * Fix 「何何」の特別conjunctive rules to only match at the end. Sat Mar 21 10:53:51 1992 Bob Kerns (rwk at taunton.crl.dec.com) * Eliminate duplicates in the result when we have substring matches. * Potential form's rules were completely mangled; they were all clones of the same version, as if incomplete edited or something. I fixed them up, and added another test to the suit. The test suite happened to test the one case that the rest were cloned from, and 一段動詞, which worked. * Anti-infinite-recursion check didn't catch quite all the possible ways. Also, in similar circumstances, it could put duplicates into the result. * Add 屋 to other-suffixes, and 半 to other-prefixes. Fri Mar 20 11:14:00 1992 Bob Kerns (rwk at taunton.crl.dec.com) * Remove punctuation before lookup. * Make the windowing code more robust when editing in a tiny window. Thu Mar 19 15:03:52 1992 Bob Kerns (rwk at taunton.crl.dec.com) * Canonicalize number expressions. Tue Mar 17 10:35:45 1992 Per Hammarlund (perham at perham.nada.kth.se) * Added to a regexp in edict-display so that english verbs that have a dictionary entry like /to XXX/ shall be treated as exact matches in the match-list. * fixed a small index error in edict-remap-romaji. Tue Mar 17 10:06:48 1992 Bob Kerns (rwk at taunton.crl.dec.com) * Merged in my changes below into 0.9, and made it 0.9.1 Mon Mar 16 00:28:23 1992 Bob Kerns (rwk at taunton.crl.dec.com) * Prevent infinite recursion if rules have a loop. * Add conjunctive form. (りいしちりいきびみ), and する／ずる／じ る cases. Mon Mar 16 09:38:44 1992 Per Hammarlund (perham at perham.nada.kth.se) * Set the version to 0.9 and the date to current. * Added functions to clean up a eigo string that, for whatever reason has been written in both ASCII and JIS/EUC. For instance the string "strａｎｇｅ", will be tranformed to plain "strange". The remap relation can be done better, and it should probably be more complete. How about a complete new nemacs-string* function set!?! * Changed the function edict-find-word-at-point that finds an english word to take eigo written in Japanese [ａ-ｚＡ-Ｚ] into account too. * Rewrote the version code, more things to be able to keep the date and the version on different variables. * Added/rewrote the "Getting Started Guide" in the file edict.el. * Started on the documentation. edict.texinfo, Took out a number of lines from the edict.el file. * Changed the name of the variable *private-edict-file* to *edict-private-file*, just to keep variable names consistent. Mon Mar 16 00:28:23 1992 Bob Kerns (rwk at taunton.crl.dec.com) * Add さん、さま、様、頂く、ちゃん、君、くん * Add おる to 助動詞ー１。 * We have to add 1 to the window height because they include the mode line. This was hiding the last entry found when there were more than 3 of them! *「差し上げる」の仮名形と漢字形 * Add 形容詞ーからず. * 助動詞 から 助動詞ー１…助動詞ー４まで分けてさせた。「差し上げる」 をしました。 * Add the ーず verb endings as alternates to ーない, and add 「せず」の特別ルール Sun Mar 15 00:01:05 1992 Bob Kerns (rwk at taunton.crl.dec.com) * 「きて／して」の特別ルール: Fix bug introduced in fixing another bug. * Add く to the list of endings that 助動詞 apply to. This is actually confusing things a bit, but in a way that helps the user. Logically, if an adverb appears before a verb which is sometimes a 助動詞, it probably is modifying the verb, not the other way around. But the user was probably asking about the adverb, since the 助動詞 are all very basic words the user probably knows. I suppose I could start returning 助動詞 in addition to the main verb, so the user would see these as well. I suspect this would be more distraction than benefit. If the user doesn't know the part that was stripped off, he can just mark it, and inquire. * Add なる as 助動詞. Add 漢字形の「来る」と「行く」と「上げる」 と「成る」。 * Be more careful about ordering the results. * 「来て／して」の特別ルール * Remove debugging notify accidentally left inserted. * Allow modifiers rule after 形容動詞. * Correct an error in 「くる」の特別ルール. * Suppress single-kanji matches unless they're needed. * Didn't have anything for handling ーする!! * Forgot to drop the おー from humble form. * Fix up adjectives once more. * fix humble's regexp * 敬語の接頭辞 tried to be both prefix and suffix(!) * てしまう and でしまう cant be combined after all. * Fix incorrect kanji in other-prefixes. * Coallesce the てしまう family into a single rule, and make it properly preserve the て／んで distinction. No need for past-tense forms since they're regular; the past-tense rules will handle it. * Apply the prefixes only to 漢字 * Added ー員 to suffixes. * Add basic affixes used with 名詞。 * Explicit rules for ーなく、なくて * Get 形容詞 negative right, and include more formal varients. * 平仮名の「ご」 as honorific prefix, in addition to 御. * Remove いた from 助動詞; that gets covered elsewise anyway. * Minimum length on 助動詞. * Only do command if at least two chars long. * Tighten up a couple more rules wrt 一段 only after え行 or い行. * Tighten up various rules wrt legal verb endings. No づ、ず, etc. * Typo in 「しよう」の特別ルール, 「来よう」、「こよう」 * Forgot a few '$'s on the ends of patterns. * Add a complete set of volitionals. This pretty much completes the morphology. * Supply a few more 助動詞 and other endings. * Irregular 来たがる、きたがる、したがる * Avoid generating く or す as entire words. * Fix up いちだんの「たい」を削除する -> 一段の「たい」を削除する * Add an 一段動詞 version of the desiderative rule. * Added ーたがる to desideratives. * Tighten up います。 * Tightened up adjective rules so they don't go off on くる。 * Added Irregular 来ます、します。 * Irregular 来い, しろ * Add irregular info for しない, ない. * Correct mistaken rule for たない. Sat Mar 14 16:22:07 1992 Bob Kerns (rwk at taunton.crl.dec.com) * Add edict-test-string. * Add debugging feature to edict-expand-string to help track down what rules do what in the event of surprises. * Handle たら as part of the て／た rules. Faster, and doesn't generate spurious instance of plain past. * Include the zenkaku versions of the punctuation in *edict-(kanji|eigo)-whitespace*. * Clean up some lurking problems in edict-clean-up-(kanji|eigo) * Fix a problem with exact matches in the substitution routines. * Make edict-expand-string more aggressive in preventing possible infinite recursion. * Add される rule for its irregularity. * Add 来られる rule for its irregularity. * Add 行く special rule for its irregularity * Additions to improve window handling Add private dictionary, and commands to add to it. Add morphologic analysis so that the dictionary forms of words can be found from inflections/affixes/etc. Add rule for plain negative, plain imperitive. Add rule for desiderative. Make it require cl.el, since I got tired of using a crippled lisp. Use DEFSTRUCT for the rules, and give them names so that you can redefine a rule without having to reload the entire database of rules. Add '#' to the characters that get flushed from kanji words since that's a common inclusion character in fj newsgroups. Split the set out into a variable *edict-kanji-whitespace* to aid in user extensibility. Added rule for 一段動詞 て／た -> る conversion, which I accidentally deleted earlier. Added conditional form for adjectives. Added causitive, passive, 一段動詞 potential Added some more missing 一段動詞 rules, and tightened up a number of rules, especially 一段動詞 rules. Upgrade the sorting of exact matches to the top to handle exact matches of dictionary forms produced by the rule set. For example, 見なくて should have 見る sorted to the top of the list. Updated credits. Added *edict-eigo-whitespace* like *edict-kanji-whitespace*, and fixed a bug in the code. Added rules for ーちゃう、ーちゃった Fri Mar 13 17:45:27 1992 Per Hammarlund (perham at perham.nada.kth.se) * Merged Bob's extensions just below into the distribution version. (Some of the things mentioned right above here, shold be below.) Fri Mar 13 17:44:06 1992 Bob Kerns (rwk at crl.dec.com) * Added functionality to translate verbs and adjectives to a basic form. Wed Mar 11 09:41:23 1992 Per Hammarlund (perham at perham.nada.kth.se) * Added edict-version and a variable *edict-version* to keep track of the current version of the software. * Type checks on the variable *edict-files* in function edict-init. Tue Mar 10 10:22:21 1992 Bob Kerns (rwk at crl.dec.com) * I've fixed some lingering bugs in restoring the window sizes in multi-window mode. * I've made it canonicalize whitespace, so that you can select jukugo that wrap around lines, include whitespace, or whatever. Also, multi-word english phrases can include newlines, indentation, etc. Tue Mar 10 07:11:24 1992 Bob Kerns (rwk at crl.dec.com) * I fixed the displaying to not screw up if there's a window above (for example, when using it on fj.* gnus articles it used to gradually grow the Subject window and shrink the Article window). * I put giving a positive argument to the searching commands add a new entry. Locally, I put these commands on m-& and m-*; and if m-& doesn't find a compound, I do c-U m-& and add it. * m-- m-& (or whatever) will remove the window. I did this because c-X 1 is too much; if I was in 2 window mode, I don't want to go to 1 window mode. * I made the display show any exact matches before the inexact matches. So if I do it on 事, I get that line first, instead of buried in amongst all the compounds that sort earlier. Mon Mar 9 00:00:00 1992 Bob Kerns (rwk at crl.dec.com) * This gives you m-X edict-add-english and m-X edict-add-kanji, and automagically maintains a private dictionary in *edict-private-file*. 1991, 1992 Per Hammarlund (perham at perham.nada.kth.se) * Wrote the bare bones of edict.el. edict-el-1.06.orig/.cvsignore0100644000175000017500000000006606570006771015420 0ustar rolandroland_pkg.el auto-autoloads.el custom-load.el package-info edict-el-1.06.orig/COPYING0100644000175000017500000004307506524336052014457 0ustar rolandroland GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, Cambridge, MA 02139, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by he GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19yy name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. edict-el-1.06.orig/ChangeLog0100644000175000017500000000073306570006771015173 0ustar rolandroland1998-07-23 SL Baur * Makefile: Don't build if XEmacs/no-Mule. 1998-06-29 SL Baur * package-info.in: Update provides. 1998-06-01 SL Baur * Makefile (EXTRA_SOURCES): Remove obsoleted source files. 1998-03-13 SL Baur * Created an XEmacs package * edict.el: * edict-test.el: Minimal patches to bytecompile under XEmacs 21.0. Converted to ISO-2022-JP. edict-el-1.06.orig/Makefile0100644000175000017500000000256506610566501015063 0ustar rolandroland# Makefile for Edict # This file is part of XEmacs. # XEmacs is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by the # Free Software Foundation; either version 2, or (at your option) any # later version. # XEmacs is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License # for more details. # You should have received a copy of the GNU General Public License # along with XEmacs; see the file COPYING. If not, write to # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA. VERSION = 1.06 AUTHOR_VERSION = 0.9.8 MAINTAINER = Stephen J. Turnbull PACKAGE = edict PKG_TYPE = regular REQUIRES = mule-base xemacs-base CATEGORY = mule EXTRA_SOURCES = edictj.demo ts-mode.el ELCS = edict.elc dui.elc edict-morphology.elc edict-japanese.elc \ edict-english.elc edict-edit.elc edict-test.elc dui-registry.elc COMPATIBILITY_FLAGS = -eval "(setq byte-compile-print-gensym nil)" include ../../XEmacs.rules ifeq ($(BUILD_MULE),t) all:: $(ELCS) auto-autoloads.elc srckit: srckit-std binkit: binkit-common else all:: @echo Edict requires XEmacs/Mule to build # Two noops srckit: binkit: endif edict-el-1.06.orig/Makefile.perham0100644000175000017500000000245106532322630016324 0ustar rolandroland# # Copyright (c) 1992 Per Hammarlund (perham@nada.kth.se) # # This is a silly makefile to ease the handling of the edict software, # it can do silly things like building a distribution (taring), # cleaning and such. # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 1, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # EMACS-LISP-FILES = edict-test.el edict.el TEXT-FILES = COPYING README edict.ChangeLog edict.doc DEMO-DICT-FILE = edictj.demo INSTALL-FILES = Makefile install.edict DISTRIBUTION-FILES = $(EMACS-LISP-FILES) $(TEXT-FILES) $(DEMO-DICT-FILE) $(INSTALL-FILES) DIST-FILE-NAME = edict.tar distribution: $(DISTRIBUTION-FILES) tar -cvf $(DIST-FILE-NAME) $(DISTRIBUTION-FILES);\ compress $(DIST-FILE-NAME) edict-el-1.06.orig/README0100644000175000017500000002151606532043557014304 0ustar rolandroland***** edict.el optimized for XEmacs ***** Version 0.9.8 This file Copyright 1998 Stephen J. Turnbull . The edict.el package is Copyright 1991, 1992 Per Hammarlund and 1998 Stephen J. Turnbull . Individual files may have their own Copyrights differing from the above. This file is part of XEmacs. It is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. XEmacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with XEmacs; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. Original author: Per Hammarlund Other authors: Bob Kerns Stephen J. Turnbull Adapted-by: Stephen J. Turnbull for XEmacs Maintainer: Stephen J. Turnbull ***** Whatzit? ***** The original edict.el was written by Per Hammarlund. It is an interface to the EDICT Japanese-English dictionary compiled by Jim Breen at Monash University. Using the region and couple of keystrokes, edict.el will look up the Japanese key and return all the EDICT entries containing that key, in a pop-up buffer. English is even easier, you just put point anywhere in the word you want to look up. Bob Kerns added a morphology engine, which reduces a highly inflected Japanese word to a list of dictionary forms (eg, itta -> (iku, iu)), all of which are looked up. After several years of service, it became partially incompatible with recent FSF Emacsen, especially the keymaps and the byte compiler, and never was adapted for XEmacs (which only recently acquired Japanese capability). This BETA release adapts edict.el to XEmacs (because that's what the maintainer uses), packages it for ease of installation on XEmacs, and provides a unified interface to the functions via the Dictionary Lookup minor mode. Documentation from version 0.9.6 (the last version maintained by Per Hammarlund) is included in the appropriate .../etc directory, with the file extension .096. The sources for version 0.9.6 are available at the URL below in edict-0.9.6-src.tar.gz. (This numbering is unrelated to the numbering of XEmacs packages.) ***** Installation ***** For XEmacs >= 20.3, get edict--pkg.tar.gz from http://turnbull.sk.tsukuba.ac.jp/Tools/XEmacs/packages/edict/ and untar it in the the directory ~/.xemacs (or root directory of your package hierarchy, if you know what that is). If you are using XEmacs >= 20.5, you're done. If you're using XEmacs 20.3 or 20.4, then add (load-file "~/.xemacs/lisp/edict/auto-autoloads.el") to your ~/.emacs or ~/.xemacs/init.el. Get edict (the dictionary) from ftp://ftp.cc.monash.edu.au/pub/nihongo/, and install it in an appropriate etc/ or etc/edict/ in your package hierarchy (~/.xemacs/etc/ is fine). For trial purposes, there is a tiny edict.demo dictionary supplied with edict.el. For the FSF's distribution of Emacs >= 20.0, get edict--fsf.tar.gz from the URL above. Unpack it somewhere; .../emacs/site-lisp/edict/ is recommended. The dictionary should go in the same directory. (This is intended to be automatically found, but version 0.9.8 doesn't do that yet. You will have to set either the `edict-dictionary-path' or `edict-dictionaries'.) Users of other versions of Mule are welcome to play around; please tell me what you did, whether it works or not. Due to changes in keymap code, it is highly unlikely that the current version of edict.el will work with nemacs or Mule based on Emacs version 18. If you have special needs, the package sources are available in edict--src.tar.gz. Makefile is very XEmacs (>=20) specific; Makefile.FSF is provided for building for the FSF's distribution of Emacs. The FSF's Emacs and XEmacs are nearly byte-code compatible; unfortunately the incompatibilities are most likely to show up in Mule applications, so you should byte-compile the source with the Emacs you plan to use the package with. ***** User Setup ***** Users of recent XEmacsen should need little setup, unless you are using public dictionaries not named "edict" or user dictionaries not in your home directory or not named ".edict". In that case, set the variables `edict-dictionaries' and `edict-user-dictionary' as needed. Other users may need to set up autoloads and possibly their load-paths. A file auto-autoloads.el is provided; this file can only (at this time) be produced using XEmacs, but it should work with other Emacs. This file is automatically consulted by XEmacs; users of the FSF distribution of Emacs should be able to use it by adding (load-file "/site-lisp/edict/auto-autoloads.el") to .emacs. (`load-file', rather than `load-library', is suggested because every XEmacs package has a file named auto-autoloads.el.) The necessary autoloads may also be found by grep -A 1 '^;;;###autoload$' *.el You should also probably set the variable `edict-dictionary-path' to help edict find your public dictionaries. For some reason, Mule occasionally has trouble recognizing the file coding system of edict files. If so, the Monash distribution dictionary `edict', which is in EUC-JP format, should be correctly initialized by (setq edict-dictionaries '(("edict" . euc-jp))) in .emacs. The value of this variable is a LIST of CONS-or-STRING. If a CONS, it should have a STRING as car and a CODING-SYSTEM as cdr. Note that the name of this variable has changed. If your dictionary directory is not found at all, you can setq `edict-dictionary-path' to a LIST of strings, each of which should be a path to a directory which might contain edict dictionaries. ***** Usage ***** The interface to edict is now the Dictionary Lookup minor mode (dl-mode). It is invoked as usual by (eg) "M-x dl-mode", and its modeline indicator is "dl". dl-mode is autoloaded. The various functions are bound to keys in a mode-specific keymap, which is invoked by a prefix key. The default prefix is "C-c $" (by analogy with ispell's "M-$"). Unlike the former interface, dui is intended to be a general interface to various dictionary-like commands. Dictionary lookup is bound to "s" (for "search") in the sub-keymap; insertion and help are bound to "i" and "d" (for "describe method" respectively. The search mode is initialized to "EDICT search Japanese" by default. Using a prefix argument allows you to change modes. Eg, "C-u C-c $ s" generates a prompt for a "Method:". Currently valid search methods include "EDICT search Japanese", "EDICT search English", and "ispell word". Valid insert methods include "EDICT add English" and "EDICT add Japanese". edict.el provides a simple dictionary editing mode, automatically invoked by the "EDICT add ..." methods, with TAB switching between fields. An experimental `electric-henkan' mode is available, in which the mode recognizes whether a field is Japanese or English and invokes your preferred henkan method appropriately. To try this out (setq edict-use-electric-henkan t). Note that electric henkan uses the LEIM interface, so it cannot work if your preferred input method is XIM. Due to the indirect way in which the actual methods are called, a separate help function, `dui-describe-method', bound to "C-c $ d", is provided to access method documentation. Enjoy! ***** Bug reports, comments, and feature requests ***** Please send these to "Stephen Turnbull" . Bug reports are of course of high priority, but I am hoping that users will also report inflections and idioms that the morphology engine does not handle. Known bugs and problems are in the file TODO. (Documentation and organization are both known bugs....) With the reimplementation as a minor mode, it now makes sense to provide keystrokes for variations on the basic theme. One example (already implemented for ispell) is to use dl-mode to access other dictionary applications. Another possibility is that kanjidic can be loaded into the *edict* buffer as well; one could imagine restricted functions (not yet implemented) that only search kanjidic or only edict. Suggestions are welcome. ***** Historical notes ***** The files edict.el.096 and edict-test.el.096 in the source distribution are from the original version 0.9.6 distribution grabbed from ftp.cc.monash.edu.au. The ChangeLog for version 0.9.6 is in ChangeLog.096, which is included in all forms of the current distribution. The .el files in this package have been converted to ISO-2022-JP encoding. All hail Jim, Per, and Bob! edict-el-1.06.orig/TODO0100644000175000017500000000633106532040761014104 0ustar rolandrolandfile: TODO This file lists the known outstanding bugs and assorted desirable changes. The latter are divided into "prettification" (not requiring thinking on this maintainer's part), "to do" (actual work, but I have a pretty good idea how to do it), and "projects" (either I don't know how to do it in Emacs LISP or careful thought about user interface and the like is needed). Closed bugs, to do items, and projects are moved to ChangeLog but the remainder are not recycled. BUGS 1. Editing does not work when the dictionaries aren't loaded (edict-user-dictionary is unbound). Probably should also check for existence of edict-buffer. 2. Completion of search methods will find insert methods, eg, need to filter in the same way as history. 3. To conform with Makefile.FSF need to make default edict-dictionary-path point to .../emacs/site-lisp/edict. 4. edict-standin does (aref i global-map) PRETTIFICATION 1. Move customizable variables to separate file. 2. Give kanjidic entries precedence in list. 3. Give private dictionary entries precedence in list. 4. The nomenclature is non-standard (use of `*' in variable names). Change these to the `edict-...' style. 5. Fix style of docstrings and move comments into docstrings where appropriate. 6. Move the docstring for `edict-init' back into the function. It's currently not there because XEmacs gets confused about indentation if it is. TO DO 1. Maybe add a customize interface (the only thing that might want customized that I know of is the proposed edict-coding-system variable, but there it would be definitely useful since Custom can be set up to automatically reread EDICT, unlike setq). [SJT: also *edict-files*.] 2. FSF compatibility. 3. A "report private dictionary to Jim Breen" function. 4. A "parse-word-at-point" function. (I was wrong, it isn't in the current version. Hard; you can ask for it, but I don't know that I'll be able to produce a good one quickly :-) 5. Info documentation. PROJECTS 1. Generalization (eg for Korean/Chinese, or for Spanish/German for that matter). 2. Error handling on file I/O etc is rude. Especially fix the `with-output-to-temp-buffer' stuff. 3. Why are there so many `edict-add-*' and `edict-insert-*' commands? 4. Make the morphology rewrite system make sense, and be consistent with the docs. 5. kanjidic support 6. Figure out how to handle both FSF's functionality and XEmacs's functionality portably 7. Use VM's tapestry.el to track window configuration, or borrow from view-process-mode.el. 8. Bug report/feature request function. (Use reporter.el, see view-process-mode.el for how.) 9. Need to handle JIS X 0201 (and so on) in the dictionary as well as in the key. 10. The timing for missing/unreadable files and preregistered methods is bogus. Think and fix. 11. "Upstream" and "external" package tracking. Things like dictionaries should be tracked at their sources for updates. If you're going to have that capability, then why not the capability to do this for arbitrary packages? 12. If you're going to be automatically running off to do external package tracking, then automate sending the local dictionary to Jim Breen. edict-el-1.06.orig/dui-registry.el0100644000175000017500000000721406532040662016366 0ustar rolandroland;;; dui-registry.el --- Registry of dui dictionary methods ;; Copyright (C) 1998 by Stephen J. Turnbull ;; Author: Stephen J. Turnbull ;; Keywords: mule, dictionary ;; Version: 0.6 ;; This file is part of XEmacs. ;; XEmacs is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your ;; option) any later version. ;; XEmacs is distributed in the hope that it will be useful, but ;; WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with XEmacs; if not, write to the Free Software Foundation, ;; Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;;; To do: ;;; Changelog: ;; 1998-04-08 Stephen Turnbull ;; (created): broken out from edict.el ;;; Code: (require 'dui) (dui-register-method "ispell word" 'search 'ispell-word "Invokes ispell on the word at point. Heaven only knows what will happen if it's Japanese.") (defun edict-search-english-wrapper () "Interface `edict-search-english' to `dui-invoke-method'." (edict-search-english nil)) ;; Probably could do without the wrapper: ; (dui-register-method ; "EDICT search english" ; 'search ; 'edict-search-english ; "Attempts to translate the english word we are looking at. Picks the word ; in the same way as ispell, ie backs up from whitespace, and then expands. ; ; Result is presented in a window that is not selected." ; nil) (dui-register-method "EDICT search English" 'search 'edict-search-english-wrapper "Attempts to translate the english word we are looking at. Picks the word in the same way as ispell, ie backs up from whitespace, and then expands. Result is presented in a window that is not selected.") (defun edict-search-kanji-wrapper () "Interface `edict-search-kanji' to `dui-invoke-method'." (let ((m (mark)) (p (point))) (cond ((null m) (error "Please set the region around the Japanese phrase to look up.")) ((< m p) (edict-search-kanji nil m p)) (t (edict-search-kanji nil p m))))) (dui-register-method "EDICT search Japanese" 'search 'edict-search-kanji-wrapper "Attempts to translate the Japanese `word' between mark and point. Verbs and adjectives will be deinflected, common auxiliaries and suffixes removed, and all resulting candidates looked up. Result is presented in a window that is not selected.") ;; Make it default (or (featurep 'dui-registry) (setq dui-method-history (cons "EDICT search Japanese" dui-method-history))) (defun edict-add-kanji-wrapper () "Interface `edict-add-kanji' to `dui-invoke-method'." (let ((m (mark)) (p (point))) (cond ((null m) (error "Please mark the Japanese word to add to your private dictionary.")) ((< m p) (edict-add-kanji m p)) (t (edict-add-kanji p m))))) (dui-register-method "EDICT add Japanese to private dictionary" 'insert 'edict-add-kanji-wrapper "Adds the Japanese `word' between mark and point to the private dictionary. The entry is formatted for EDICT, and edict-edit-mode is entered.") (dui-register-method "EDICT add English to private dictionary" 'insert 'edict-add-kanji-wrapper "Adds the English word near point to the private dictionary. The entry is formatted for EDICT, and edict-edit-mode is entered.") ;(dui-princ-errors) (provide 'dui-registry) ;;; dui-registry.el ends here edict-el-1.06.orig/dui.el0100644000175000017500000004006106532040622014511 0ustar rolandroland;;; dui.el --- Dictionary user interface ;; Copyright (C) 1998 by Stephen J. Turnbull ;; Author: Stephen J. Turnbull ;; Keywords: mule, dictionary ;; Version: 0.6 ;; This file is part of XEmacs. ;; XEmacs is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your ;; option) any later version. ;; XEmacs is distributed in the hope that it will be useful, but ;; WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with XEmacs; if not, write to the Free Software Foundation, ;; Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Some code that provides support for dictionary lookup and manipulations ;; (such as inserting definitions and maintaining a private dictionary). ;; Originally written in support of edict.el, by Per Hammarlund ;; , but since generalized. ;;; To do: ;;; Changelog: ;; 1998-03-27 Stephen Turnbull ;; (created): broken out from monolithic edict.el ;;; Code: ;;; Dictionary lookup minor mode (dl-mode) ;; User customization variables (defvar dl-mode-prefix '[(control ?c) (?\$)] "Prefix key sequence for dl-mode command keys. After loading, change the mode's prefix by using dl-mode-set-prefix; setq'ing this variable can't work.") (defvar dl-indicator-string " dl" "String indicating activation of dl minor mode in the modeline. Set to nil to inhibit modeline display.") ;; A convention for modes; here honored by observance, not breach. ;; (defvar dl-mode-hook nil "A normal hook called at the end of the dl-mode activation process. If you can think of a use for this, you're more clever than I.") ;; Auxiliary customizations (defvar dl-conflict-warning "Binding conflict: %s -> %s." "Format string warning about key sequences with conflicting bindings. Must contain two `%s' descriptors. The first formats the key sequence, the second the description of the existing binding.") (defvar dl-warn-conflict-verbosity 3 "Controls verbosity of binding conflict warnings. 0 turns off warnings entirely. 1 issues a warning for each binding conflict (including sub-keymaps). 2 prints a summary message with a count of conflicts (not including sub-keymaps, only keys in those maps that have conflicts). 3 adds verbose detail about what is being done. Each positive level performs all actions of lower levels.") ;; The basic mode conventions. ;; Mode flag and keymaps ;; (defvar dl-mode nil "Activation flag for dl-mode.") (defvar dl-mode-submap nil "Sub-keymap for dl-mode. All key sequences are prefixed by the sequence defined in dl-mode-map.") (defvar dl-mode-map nil "Keymap for dl-mode. Holds the prefix key for dl-mode functions. Its value will be installed into minor-mode-map-alist. Prefix cannot be altered by setq'ing dl-mode-map. Use dl-mode-set-prefix instead.") ;; Mode toggle ;; ;; The side effect is arguably not a feature :-) ; ;;;###autoload (defun dl-mode (&optional arg) "Minor mode for dictionary lookup, with interfaces to dictionary utilities. Null ARG toggles the mode, positive ARG turns the mode on, negative ARG turns the mode off. When the mode is already off, (dl-mode -1) has the side effect of checking and reporting any conflicting bindings. \\{dl-mode-map}" (interactive "P") ;; dl-warn-binding-conflicts doesn't make sense when the mode is active (if (null dl-mode) (dl-warn-binding-conflicts dl-mode-map)) (setq dl-mode (if (null arg) (not dl-mode) (> (prefix-numeric-value arg) 0))) (run-hooks dl-mode-hook)) ;; Internal mode data ;; Main keymap ;; (or dl-mode-submap (progn (define-prefix-command 'dl-mode-submap) ; (define-key dl-mode-submap '[ ?s ] 'dui-invoke-search-method) (define-key dl-mode-submap '[ ?i ] 'dui-invoke-insert-method) ;; Hmm ... I don't think there are any of these :-P ;;(define-key dl-mode-submap '[ ?e ] 'dui-invoke-edit-method) (define-key dl-mode-submap '[ ?d ] 'dui-describe-method) )) ;; Helper functions ;; Set the mode prefix ;; ;; This can't be done simply by setq'ing dl-mode-map; minor-mode-map-alist ;; does not refer to that variable but contains a copy of its value. ;; (defun dl-mode-set-prefix (key &optional context) "Set the prefix key sequence for dl-mode to KEY. Return the new dl-mode-map. When called interactively read KEY from the minibuffer (as a string; keys not bound to `self-insert' must be quoted with C-q). If you need more flexibility than ASCII gives, you'll have to use the `eval-expression' interface. Example: `\\[dl-mode-set-prefix] C-q C-c $ RET' returns the prefix key to the default `C-c $'. Allowed values of CONTEXT: NIL substitute a map containing KEY in minor-mode-map-alist. adding-minor-mode manipulation of minor-mode-map-alist is done elsewhere." ;; Should read key events but I don't know how to make that work. (interactive "Key sequence (quote control characters with ^Q): ") (setq dl-mode-map (make-sparse-keymap)) (define-key dl-mode-map key 'dl-mode-submap) (cond ((null context) (let ((slot (assq 'dl-mode minor-mode-map-alist))) (setq minor-mode-map-alist (cons (cons 'dl-mode dl-mode-map) (if slot (delete slot minor-mode-map-alist) minor-mode-map-alist))))) ((equal context 'adding-minor-mode)) (t (error "Illegal context `%s' in dl-mode-set-prefix." context))) dl-mode-map) ;; Deal with binding conflicts ;; ;; Search keymaps for binding conflicts for each key in the mode's keymap. ;; Current implementation searches only active keymaps; it won't tell ;; about inactive keymaps, including those of minor modes that might be ;; invoked later or (worse) major modes already invoked in other buffers. ;; (defun dl-warn-binding-conflicts (map) "Warn about key bindings that will conflict with those in MAP. Results will be non-sensical if MAP is invoked via a prefix or is already active. The current implementation only looks in the active keymaps. Maps of inactive minor modes and local maps major modes of other buffers will not be searched (although the latter will be shadowed since dl-mode is a global variable)." (if (null (featurep 'xemacs)) ;; `map-keymap' doesn't exist in the FSF's Emacs (message "Keymap shadow checking not supported under\n%s" (emacs-version)) (let ((found 0)) (if (> dl-warn-conflict-verbosity 1) (progn (message "Checking for conflicting bindings...") (if (> dl-warn-conflict-verbosity 2) (message "Examining accessible maps of map:\n `%s'" map)))) ;; A map is accessible from itself (mapcar (lambda (slot) (let ((prefix (car slot)) (map (cdr slot))) (if (> dl-warn-conflict-verbosity 2) (message "Examining keys of map:\n `%s'" map)) (map-keymap (lambda (key binding) (let* ((key (vconcat prefix (vector key))) (binding (key-binding key))) (if (and binding (> dl-warn-conflict-verbosity 0)) (progn (if (not (keymapp binding)) (setq found (1+ found))) (message dl-conflict-warning key binding))))) map))) (accessible-keymaps map)) (if (> dl-warn-conflict-verbosity 1) (message "Checking for conflicting bindings...done%s" (if (> found 0) (format ". Found %d." found) ".")))))) ;; Register the mode with Emacs ;; `add-minor-mode' doesn't exist in Emacs 20.2 :-( (or (assq 'dl-mode minor-mode-alist) (setq minor-mode-alist (cons (list 'dl-mode dl-indicator-string) minor-mode-alist))) (dl-mode-set-prefix dl-mode-prefix) ;;; end of dictionary lookup minor mode (defvar dui-warn-previously-registered-methods-p t "Warn about previously registered methods.") ;; [SJT: OK, ispell uses M-$, and LEIM and Wnn both use C-\. I see ;; all three processes (spell-check, localized input methods, and ;; dictionary lookup) as being aspects of high-level dictionary- ;; based natural language input. I would like to overload the same ;; mode-toggle for all of them. I see IMs as being primary (analogous ;; to a minor mode), while the checking functions are secondary and/or ;; transient. Unfortunately, both ispell and LEIM use prefix args to ;; modify the toggle's behavior. But all of "C-$", "C-c $", "C-c \", ;; and "C-c \" are undefined. ;; I see the interface as follows. ;; The main-entry point is the the transient function (ispell-word, ;; edict-lookup-*), accessed via the un-prefixed key. ;; The prefixed key would give a short choice menu, in the echo area. ;; A short-list of defaults would be alternative transient functions, ;; plus the choices to add or delete from the menu, or to do more ;; complicated maintenance (eg, customize, once we have an interface.) ;; ;; #### Need to define the call interface for the functions. (defvar dui-method-history nil "List of recently used dictionary methods.") ;; Maybe would like to do something like the following? ;An alist containing elements of the form (METHOD &rest LISTS). ; ;METHOD is a unique string naming the dictionary method. Each element ;of LISTS is a list of the form (TYPE DESCRIPTION INVOCATION &rest ;ARGS), where TYPE is a symbol (one of 'search, 'insert, or 'edit) ;indicating the context where this invocation is used, DESCRIPTION is a ;string describing this method, INVOCATION is a function to call to ;invoke this method, and the function will be applied to (cons TYPE ;ARGS). (defvar dui-method-alist nil "Registry of dictionary methods and utilities. An alist containing elements of the form (METHOD TYPE DESCRIPTION INVOCATION &rest ARGS). METHOD is a unique string naming the dictionary method. TYPE is a symbol (one of 'search, 'insert, or 'edit) indicating the context where this invocation is used, DESCRIPTION is a string describing this method, INVOCATION is a function to call to invoke this method, and the function will be applied to (cons TYPE ARGS).") ;; Method component access functions (defun dui-get-method-name (slot) (nth 0 slot)) (defun dui-get-method-type (slot) (nth 1 slot)) (defun dui-get-method-description (slot) (nth 2 slot)) (defun dui-get-method-invocation (slot) (nth 3 slot)) (defun dui-get-method-args (slot) (nthcdr 4 slot)) (defvar dui-registration-errors nil "String containing description of method registration problems.") ;; Flush any old errors hanging around. (setq dui-registration-errors nil) (defun dui-register-method (method type invocation description &rest args) "Register a dictionary method. METHOD is a unique string naming the dictionary method. TYPE indicates the context in which the method is used (a symbol, one of 'search, 'insert, or 'edit). INVOCATION is a function to call to invoke this method, which is applied to ARGS. DESCRIPTION is a string describing this method. The same INVOCATION function may be registered in different contexts with different descriptions and argument lists, but must have a different METHOD name in each context. It may be useful to include METHOD as an element of ARGS to allow the INVOCATION function to be used by several slightly different methods." (if (assoc method dui-method-alist) (setq dui-registration-errors (concat dui-registration-errors (format "%s\n" method))) (setq dui-method-alist (cons (append (list method type description invocation) args) dui-method-alist)))) ;; #### should this filter on type? probably not. (defun dui-remove-method (method) "Remove a dictionary method from the registry." (interactive (completing-read "Remove method: " dui-method-alist nil t)) (setq dui-method-alist (delete (assoc method dui-method-alist) dui-method-alist))) (defun dui-filter (type list) "Return the sub-list of methods from LIST whose type is TYPE." (apply 'append (mapcar #'(lambda (method) (if (eq (dui-get-method-type (assoc method dui-method-alist)) type) (list method) nil)) list))) (defun dui-read-method (type prompt &optional default) "Read the name of a dictionary method from the minibuffer. If DEFAULT is non-nil, use that as the default, substituting it into PROMPT at the first `%s'. Signals an error on null input. The return value is a string." (if default (setq prompt (format prompt default))) (let* ((completion-ignore-case t) ;; This binding is necessary if dui-method-history ;; is buffer local. For the name of the variable, see comments ;; in lisp/minibuf.el on `read-from-minibuffer'; it's dynamic ;; scope lossage. (naming-this-symbol-simply-history-loses (dui-filter 'search dui-method-history)) ;; Ah, bogosity. Oberhasli croaks with wta listp, history. ;; For now leave it in anyway. (method (completing-read prompt dui-method-alist nil t nil 'naming-this-symbol-simply-history-loses))) ;;(method (completing-read prompt dui-method-alist nil t))) (if (and (> (length method) 0) (eq (dui-get-method-type (assoc method dui-method-alist)) type)) method (error "No valid method was specified")))) ;; #### Make a method for defining additional keymap entries for folks ;; who want secondary dictionaries available. (defun dui-invoke-method (type ask) "Invoke a dictionary method. With ASK non-nil, read a method of type TYPE from the minibuffer and invoke it. With ASK null, invoke the last selected method, if there is one, otherwise read from minibuffer and invoke." (let* ((default (car (dui-filter type dui-method-history))) (method (if (or ask (not default)) (dui-read-method type (if default "Method (default %s): " "Method: ") default) default)) (slot (assoc method dui-method-alist)) (invocation (dui-get-method-invocation slot)) (args (dui-get-method-args slot))) (setq dui-method-history (cons method (delete method dui-method-history))) (apply invocation args))) ;; #### `dui-invoke-insert-method' and `dui-invoke-edit-method' probably ;; don't need defaults or histories. Instead, they should be part ;; of the information associated with the search method and they ;; should be automatically invoked depending on the success or ;; failure of the search mehtod. (Insert methods should only be ;; invoked if the appropriate user variable is set.) ;;;###autoload (defun dui-invoke-search-method (ask) "Invokes a dictionary lookup method. If ASK is non-nil, reads a method from the minibuffer. Otherwise invokes the current default search method. \\[dui-describe-method] gives help for individual methods." (interactive "P") (dui-invoke-method 'search ask)) ;;;###autoload (defun dui-invoke-insert-method (ask) "Invokes a method to add a dictionary entry. If ASK is non-nil, reads a method from the minibuffer. Otherwise invokes the current default insert method. \\[dui-describe-method] gives help for individual methods." (interactive "P") (dui-invoke-method 'insert ask)) ;;;###autoload (defun dui-invoke-edit-method (ask) "Invokes a dictionary editing method. If ASK is non-nil, reads a method from the minibuffer. Otherwise invokes the current default edit method. \\[dui-describe-method] gives help for individual methods." (interactive "P") (dui-invoke-method 'edit ask)) ;;;###autoload (defun dui-describe-method (method) "Shows the docstring for METHOD (a string) in a temporary buffer." (interactive (completing-read "Describe method: " dui-method-alist nil t)) (with-output-to-temp-buffer (princ (dui-get-method-description method)))) (defun dui-princ-errors () (if (and dui-warn-previously-registered-methods-p dui-registration-errors) (progn (princ "Methods are already registered by the following names. If you wish to register a new method under one of these names, please use `dui-remove-method' first. ") (princ dui-registration-errors) (setq dui-registration-errors nil)))) (provide 'dui) ;; load up the default methods ;; must come after the provide call to dui (require 'dui-registry) ;;; dui.el ends here edict-el-1.06.orig/edict-edit.el0100644000175000017500000004564706532045757016000 0ustar rolandroland;;; edict-edit.el --- Edit an EDICT dictionary. ;; Copyright (C) 1991, 1992 Per Hammarlund (perham@nada.kth.se) ;; Author: Per Hammarlund ;; Keywords: mule, edict, dictionary ;; Version: 0.9.8 ;; Adapted-by: Stephen J. Turnbull for XEmacs ;; Maintainer: Stephen J. Turnbull ;; This file is part of XEmacs. ;; XEmacs is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your ;; option) any later version. ;; XEmacs is distributed in the hope that it will be useful, but ;; WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with XEmacs; if not, write to the Free Software Foundation, ;; Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Some code that looks for translations of english and japanese using the ;; EDICTJ Public Domain japanese/english dictionary. ;; Written by Per Hammarlund ;; Morphology and private dictionary handling/editing by Bob Kerns ;; ;; Helpful remarks from Ken-Ichi Handa . ;; The EDICTJ PD dictionary is maintained by Jim Breen ;; ;;; To do: ;;; Changelog: ;;; Code: (require 'cl) ;;; Customizable variables (defvar edict-use-electric-henkan nil "Determines whether to use electric henkan mode in edict buffers. If t, use it; if nil, don't use it. If 'ask, ask and (re)set the flag.") (defvar edict-verbose-electric-henkan t "If non-nil, warns the user of electric changes in henkan state.") ;;; Internal variables ;; The previous configuration before adding an entry to a private dictionary. (defvar edict-previous-window-configuration nil) ;; The previously-selected buffer before adding an entry. (defvar edict-previous-buffer nil) ;; The filename of the file read in to add an entry to. (defvar edict-filename nil) (defvar edict-edit-mode-map nil "Mode map used by edict-add-english/kanji.") ;; Initialize our mode map. (unless edict-edit-mode-map (setq edict-edit-mode-map (make-keymap)) (if (featurep 'xemacs) (map-keymap (lambda (key) (define-key edict-edit-mode-map key 'edict-standin)) edict-edit-mode-map) (dotimes (i 128) ;; #### I hope this is OK without the check below (define-key edict-edit-mode-map [ i ] 'edict-standin))) ; Emacs 18? ; ;; I don't know how to invoke multi-char commands, so don't hook ; ;; those. ; (unless (consp (aref edict-edit-mode-map i)) ; (setf (aref edict-edit-mode-map i) 'edict-standin)))) (if (featurep 'xemacs) (progn (define-key edict-edit-mode-map [(control c)] nil) (define-key edict-edit-mode-map [(control x)] nil) (define-key edict-edit-mode-map [(escape)] nil)) (define-key edict-edit-mode-map [ 3 ] nil) (define-key edict-edit-mode-map [ 24 ] nil) (define-key edict-edit-mode-map [ 27 ] nil)) ; Emacs 18? ; (setf (aref edict-edit-mode-map 3) nil ; (aref edict-edit-mode-map 24) nil ; (aref edict-edit-mode-map 27) nil)) (define-key edict-edit-mode-map "\C-c\C-c" 'edict-exit) (define-key edict-edit-mode-map "\C-x\C-s" 'edict-exit) (define-key edict-edit-mode-map "\t" 'edict-tab) (define-key edict-edit-mode-map "\r" 'edict-new-entry) (define-key edict-edit-mode-map "\C-A" 'edict-beginning-of-line) (define-key edict-edit-mode-map "\C-E" 'edict-end-of-line) (define-key edict-edit-mode-map "[" 'edict-open-bracket) (define-key edict-edit-mode-map "]" 'edict-close-bracket) (define-key edict-edit-mode-map "/" 'edict-slash)) ;;; Functions ;; Add an entry to a particular file, and update edict-buffer. ;; Any of kanji/yomi/eigo may be omitted. The user will be given ;; an oportunity to edit and then it will be saved. ;; #### This isn't interactive, but it's not an unreasonable entry point? (defun edict-add-entry-to-file (filename kanji yomi eigo) (edict-init) (setq filename (expand-file-name filename)) (let* ((previous-buffer (current-buffer)) (buffer (find-file-noselect filename)) (window (get-buffer-window buffer))) (set-buffer buffer) ;; If it's a new file, give it a version string to print on loadup. (when (equal (point-min) (point-max)) (insert (format "$B!)!)!)!)(B /%s's private dictionary/\n" (user-login-name)))) ;; Unless it's already in edict-edit mode, put it in that mode. ;; This gives us our fancy electric-dictionary editing. (unless (eq major-mode 'edict-edit-mode) (edict-edit-mode)) ;; Unless we already have a configuration to go back to, remember ;; this one. (unless edict-previous-window-configuration (setq edict-previous-window-configuration (current-window-configuration))) (unless edict-previous-buffer (setq edict-previous-buffer previous-buffer)) ;; Remember the filename, so we can update it in the *edict* buffer ;; when we finish. (setq edict-filename filename) (if window (select-window window) (split-window nil 4)) (goto-char (point-max)) (edict-insert-entry kanji yomi eigo) ;; Go into henkan mode if appropriate (switch-to-buffer buffer) (edict-set-henkan (or (null kanji) (null yomi))))) ;; Turn on or off henkan ;; Should work in any Mule environment, in particular, not require LEIM. ;; #### Probably fails pretty impolitely if no Japanese input methods are ;; registered with Mule. ;; The guts were copied from mule-commands.el (toggle-input-method). ;; (defun edict-set-henkan (henkan-flag) "Electrically turn on or off the current default Japanese text input method. If HENKAN-FLAG is nil, turn it off, otherwise turn it on. With arg, read an input method from minibuffer and turn it on." (if (eq 'ask edict-use-electric-henkan) (if (and (featurep 'xim) (y-or-n-p "XIM and electric-henkan don't mix. Disable electric-henkan")) (setq edict-use-electric-henkan nil) (setq edict-use-electric-henkan t)) (setq edict-use-electric-henkan t)) (if edict-use-electric-henkan (let* ((default (or (car input-method-history) default-input-method))) (if (and current-input-method (not henkan-flag)) (inactivate-input-method) ;; #### Need to ensure that the IM is Japanese. Could do ;; by looking up in registry, and requiring confirmation ;; if some heuristic isn't satisfied. (activate-input-method (if (or henkan-flag (not default)) (read-input-method-name (if default "Japanese input method (default %s): " "Japanese input method: " ) default t) default)) (or default-input-method (setq default-input-method current-input-method))) (and edict-verbose-electric-henkan (message "Henkan is electrically %s." (if henkan-flag "on" "off")))))) ;; Insert a dictionary entry at point. (defun edict-insert-entry (kanji yomi eigo) ;; Make sure this is on a line of its own. (let ((p (point))) (beginning-of-line) (unless (equal p (point)) (end-of-line) (newline))) ;; Now insert a standard entry. (let ((start (point)) (p nil)) ;; Insert a new entry, leaving out any items which are nil, ;; and also leaving out the yomi if the entry consists of only kana. ;; "$BF|K\8l(B" (if kanji (insert kanji) (setq p (point))) (when yomi (unless (string-match edict-yomi-regexp yomi) (error "yomi must be in kana: %s." yomi))) ;; "$BF|K\8l(B [$B$K$[$s$4(B]" (cond ((and kanji (string-match edict-yomi-regexp kanji))) (t (insert " [") (if yomi (insert yomi) (if (not p) (setq p (point)))) (insert "]"))) ;; "$BF|K\8l(B [$B$K$[$s$4(B] /Japanese language/" (cond ((null eigo) (insert " /") (unless p (setq p (point)))) ((stringp eigo) (insert " /" eigo)) ((consp eigo) (insert " ") (dolist (def eigo) (insert "/") (insert def))) (t (error "not a string or list of strings: %s" eigo))) (insert "/\n") ;; Go to the first un-filled-in field. (goto-char (or p start)))) ;; Inverse of edict-insert-entry. Parse an entry. ;; (multiple-value-bind (kanji yomi english) (edict-parse-entry) ;; (edict-insert-entry kanji yomi english)) ;; duplicates the current line's entry. (defun edict-parse-entry () (let ((kanji nil) (yomi nil) (english nil) (start nil) (p nil) (end nil)) (save-excursion (end-of-line) (setq end (point)) (beginning-of-line) (setq start (point)) (search-forward " " end) (setq p (1- (point))) (when (> p start) (setq kanji (buffer-substring start p))) ;; Pick up the [yomi] if there are any. (when (re-search-forward edict-yomi-part-regexp end t) (setq yomi (buffer-substring (match-beginning 1) (match-end 1))) (goto-char (match-end 0))) ;; Collect up all the definitions. (while (re-search-forward "/\\([^/\n]+\\)/" end t) (goto-char (match-end 1)) (push (buffer-substring (match-beginning 1) (match-end 1)) english))) (values kanji yomi english))) ;;;###autoload (defun edict-edit-mode () "Major mode for editing edict entries. TAB Tab to next field in this entry. RETURN Start a new entry on the next line. c-A Edit the kanji field, and start entering kanji. c-E Go to the end, and start editing english. C-c C-c Install the edited changes & save the file. C-x C-s Install the edited changes & save the file. " (interactive) (kill-all-local-variables) ;; Associate these with the buffer. (make-local-variable 'edict-previous-window-configuration) (make-local-variable 'edict-previous-bufffer) (make-local-variable 'edict-filename) (set-syntax-table text-mode-syntax-table) (use-local-map edict-edit-mode-map) (setq local-abbrev-table text-mode-abbrev-table) (setq major-mode 'edict-edit-mode) (setq mode-name "Edict") (setq paragraph-start "^\\|$") (setq paragraph-separate "^\\|$") (run-hooks 'text-mode-hook)) ;; Automagically pick the right mode, based on where we are in the string. ;; That's henkan mode when we're in the entry or yomi sections, and english ;; in the translation section. ;; #### Can this be better done with extents or overlays? (defun edict-auto-set-henkan () (save-excursion (let ((x (point)) (end nil)) (end-of-line) (setq end (point)) (beginning-of-line) (edict-set-henkan (or (looking-at "$") (when (re-search-forward "[]/]" end t) (<= x (match-beginning 0)))))))) (defun edict-standin () "Invoke the command we would otherwise have invoked, after being sure we're in the right mode." (interactive) ;; #### This is evil, I think. (setq this-command (aref global-map last-command-char)) (edict-execute-dictionary-command (function (lambda () (command-execute this-command))))) (defun edict-execute-dictionary-command (function) (edict-auto-set-henkan) (let ((buffer (current-buffer))) ;; Canonicalize the end to end in exactly one slash. (unless (<= (point) (point-min)) (save-excursion (backward-char 1) (when (looking-at "//\n") (forward-char 1) (delete-char 1)))) (funcall function) ;; Canonicalize the end of the line to end in exactly one slash. (save-excursion (end-of-line) (delete-horizontal-space) (unless (<= (point) (point-min)) (backward-char 2) (while (looking-at "//") ;; Two in a row; delete the second. (forward-char 1) (delete-char 1) (backward-char 2)) (forward-char 1) (unless (looking-at "\n") (unless (looking-at "[/\n]") (end-of-line) (unless (edict-line-has-english) (insert " /")) (insert ?/))))) ;; Then if we are at the end, make it end in two, for the sake of visual feedback. ;; Except if we're on a blank line, don't add anything. (unless (<= (point) (point-min)) (unless (save-excursion (end-of-line) (backward-char 1) (looking-at "\n")) (when (looking-at "\n") (insert "/") (backward-char 1)) (save-excursion (end-of-line) ;; Make sure there's a trailing newline. (when (>= (point) (point-max)) (newline) (backward-char 1)) (let ((end (point))) (beginning-of-line) (when (search-forward "/" end t) (when (looking-at "\n") (insert "/"))))))) ;; Only set the henkan if we're still in the same buffer. (when (eq buffer (current-buffer)) (edict-auto-set-henkan)))) (defun edict-line-has-english (&optional complete) (save-excursion (let ((p (point))) (end-of-line) (let ((end (point))) (goto-char p) (beginning-of-line) (if complete (re-search-forward "/[^/\n]+/" end t) (re-search-forward "/" end t)))))) (defvar *brackets-allowed-in-english* nil "*Allow brackets in the english section of dictionary entries, if non-null.") (defun edict-open-bracket () "Begin editing the yomi section of the entry, at the beginning of the entry. Self-inserts if in the english section." (interactive) (edict-execute-dictionary-command (function (lambda () (edict-char-bracket t))))) (defun edict-close-bracket () "Begin editing the yomi section of the entry, at the end of the entry. Self-inserts if in the english section.." (interactive) (edict-execute-dictionary-command (function (lambda () (if (looking-at "\\]") (edict-tab) (edict-char-bracket nil)))))) (defun edict-char-bracket (open-p) (let ((p (point))) (end-of-line) (let ((end (point))) (beginning-of-line) (cond ((and *brackets-allowed-in-english* (save-excursion (re-search-forward "/[^\n/]*/" end t)) (<= (match-beginning 0) p)) (goto-char p) (edict-standin)) ((re-search-forward edict-yomi-part-regexp end t) (goto-char (or (if open-p (match-beginning 1) (match-end 1)) ;; Empty (1+ (match-beginning 0))))) ((re-search-forward "[ \t]" end t) (goto-char (match-beginning 0)) (insert " []") (backward-char 1)) (t (goto-char p) (edict-standin)))))) (defun edict-slash () "Begin editing the english section of the entry, at the start of the entry. Self-inserts if in the english section." (interactive) (edict-execute-dictionary-command (function edict-slash-internal))) (defun edict-slash-internal () (if (looking-at "/\n") (forward-char) (let ((p (point))) (end-of-line) (let ((end (point))) (beginning-of-line) (cond ((and (save-excursion (re-search-forward "/[^/\n]*/" end t)) (<= (match-beginning 0) p)) (goto-char p) (edict-standin)) ((search-forward "/" end t)) ;; On an empty line, just insert a definition. ((looking-at "$") (insert " //") (backward-char 1)) ;; Otherwise, this line has no english, go to the end and add one. (t (end-of-line) (backward-char 1) (unless (looking-at " ") (insert " ")) (insert "//") (backward-char 1))))))) (defun edict-tab () "Tab to the next edict field in this entry. At the end, wraps back to the beginning.." (interactive) (edict-execute-dictionary-command (function edict-tab-internal))) (defun edict-tab-internal () (let ((p (point)) (end nil)) (end-of-line) (setq end (point)) (goto-char p) (cond ((re-search-forward "[ \t]\\(\\[\\)\\|\\(/\\)" end t) (let ((f-begin (or (match-beginning 1) (match-beginning 2))) (f-end (or (match-end 1) (match-end 2)))) (goto-char f-begin) (edict-set-henkan (looking-at "\\[")) (goto-char f-end))) (t (beginning-of-line) (edict-set-henkan t))))) (defun edict-beginning-of-line () "Go to the beginning of the edict entry." (interactive) (edict-execute-dictionary-command (function (lambda () (beginning-of-line) (edict-set-henkan t))))) (defun edict-end-of-line () "Go to the beginning of the edict entry." (interactive) (edict-execute-dictionary-command (function (lambda () (end-of-line) (edict-set-henkan nil))))) (defun edict-new-entry (arg) "Start a new edict entry on the next line. If given an argument, copies the word but not the yomi or english. If given an argument > 4 (i.e. c-U c-U), copies the word and definition, but not the yomi." (interactive "P") (edict-execute-dictionary-command (function (lambda () (edict-new-entry-internal arg))))) (defun edict-new-entry-internal (arg) (end-of-line) ;;clean up in the dictionary to save space. (delete-horizontal-space) ;;first check that the last thing on this line is a '/', otherwise add one. (unless (<= (point) (point-min)) (backward-char) (unless (looking-at "/") (end-of-line) (insert "/")) (multiple-value-bind (kanji yomi english) (edict-parse-entry) (end-of-line) (if (>= (point) (point-max)) (newline) (forward-char 1)) (cond ((null arg) (edict-insert-entry nil nil nil)) ((<= (prefix-numeric-value arg) 4) (edict-insert-entry kanji nil nil)) (t (edict-insert-entry kanji nil english)))))) (defun edict-exit () "Exit the editing of a private edict file, saving the buffer and updating the running copy of the dictionary, and restoring the window configuration." (interactive) (save-buffer) (let* ((buffer (current-buffer)) (edict-private-buffer (find-file-noselect (expand-file-name edict-user-dictionary))) (filename (or edict-filename (buffer-file-name edict-private-buffer))) (configuration edict-previous-window-configuration) (previous-buffer edict-previous-buffer)) (setq edict-previous-window-configuration nil edict-previous-buffer nil) (set-buffer edict-buffer) (goto-char (point-min)) (let ((begin-marker (format "%s %s" *edict-file-begin-marker* filename)) (end-marker (format "%s %s" *edict-file-end-marker* filename))) (if (search-forward begin-marker nil t) (progn (forward-line 1) (let ((loc (point))) (search-forward end-marker) (forward-line 0) (delete-region loc (point)) (goto-char loc))) ;; Handle new file (insert (format "%s\n%s\n" begin-marker end-marker)) (forward-line -1)) (insert-buffer buffer) (when configuration (set-window-configuration configuration)) (when previous-buffer (switch-to-buffer previous-buffer))))) ;;;###autoload (defun edict-add-word () "Add any word to the private dictionary." (interactive) (edict-add-entry-to-file edict-user-dictionary nil nil nil)) ;;;###autoload (defun edict-add-english () "Add the english word at point to the dictionary." (interactive) (let ((word (edict-get-english-word))) (when word (edict-add-entry-to-file edict-user-dictionary nil nil word)))) ;;;###autoload (defun edict-add-kanji (min max) "Add the region as a kanji entry in the dictionary." (interactive "r") (edict-add-entry-to-file edict-user-dictionary (edict-clean-up-kanji (buffer-substring min max)) nil nil)) (provide 'edict-edit) ;;; edict-edit.el ends here edict-el-1.06.orig/edict-english.el0100644000175000017500000000402306532041211016440 0ustar rolandroland;;; edict-english.el --- English morphology rules for edict.el ;; Copyright (C) 1991, 1992 Per Hammarlund (perham@nada.kth.se) ;; Author: Per Hammarlund ;; Keywords: mule, edict, dictionary ;; Version: 0.9.8 ;; Adapted-by: Stephen J. Turnbull for XEmacs ;; Maintainer: Stephen J. Turnbull ;; This file is part of XEmacs. ;; XEmacs is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your ;; option) any later version. ;; XEmacs is distributed in the hope that it will be useful, but ;; WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with XEmacs; if not, write to the Free Software Foundation, ;; Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Some code that looks for translations of english and japanese using the ;; EDICTJ Public Domain japanese/english dictionary. ;; Written by Per Hammarlund ;; Morphology and private dictionary handling/editing by Bob Kerns ;; ;; Helpful remarks from Ken-Ichi Handa . ;; The EDICTJ PD dictionary is maintained by Jim Breen ;; ;; English morphological rules ;;; To do: ;;; Changelog: ;; 1998-03-27 Stephen Turnbull ;; (created): broken out from monolithic edict.el ;;; Code: (provide 'edict-english) (require 'edict-morphology) (define-edict-rule english-plural "\\([^i][^e]\\|i[^e]\\|[^i]e\\)\\(s\\)$" (english english-noun) edict-subst-affix edict-identity edict-ignore) (define-edict-rule english-plural-ies "\\(ies\\)$" (english english-noun) edict-subst-affix "y") ;;; edict-english.el ends here edict-el-1.06.orig/edict-japanese.el0100644000175000017500000004502406532040575016617 0ustar rolandroland;;; edict-japanese.el --- Japanese morphology rules for edict.el ;; Copyright (C) 1991, 1992 Per Hammarlund (perham@nada.kth.se) ;; Author: Per Hammarlund ;; Keywords: mule, edict, dictionary ;; Version: 0.9.8 ;; Adapted-by: Stephen J. Turnbull for XEmacs ;; Maintainer: Stephen J. Turnbull ;; This file is part of XEmacs. ;; XEmacs is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your ;; option) any later version. ;; XEmacs is distributed in the hope that it will be useful, but ;; WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with XEmacs; if not, write to the Free Software Foundation, ;; Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Some code that looks for translations of english and japanese using the ;; EDICTJ Public Domain japanese/english dictionary. ;; Written by Per Hammarlund ;; Morphology and private dictionary handling/editing by Bob Kerns ;; ;; Helpful remarks from Ken-Ichi Handa . ;; The EDICTJ PD dictionary is maintained by Jim Breen ;; ;; Japanese morphological rules ;;; To do: ;;; Changelog: ;; 1998-03-27 Stephen Turnbull ;; (created): broken out from monolithic edict.el ;;; Code: (provide 'edict-japanese) (require 'edict-morphology) ;; Strip "$B$$$^$9(B" (define-edict-rule $B!V$$$^$9!W$r:o=|$9$k(B (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\([$B$$$-$.$7$A$K$S$_$j(B]\\)\\($B$^(B\\($B$9(B\\|$B$;$s(B\\)\\)$") "$B$^$;$k(B$" edict-subst-modified-affix edict-identity () edict-modify-verb (1 2) edict-ignore ()) (define-edict-rule $B!V$^$9!W$r:o=|$9$k(B (concat "\\(" edict-category-c "\\|[$B$$$-$.$7$A$K$S$_$j$($1$2$;$F$M$Y$a$l(B]\\)\\($B$^(B\\($B$9(B\\|$B$;$s(B\\)\\)$") "$B$^$;$k(B$" edict-subst-affix edict-identity "$B$k(B") (define-edict-rule $B!VMh$^$9!W$NFCJL%k!<%k(B "\\($BMh$^(B\\($B$9(B\\|$B$;$s(B\\)\\)$" () edict-subst-affix "$BMh$k(B") (define-edict-rule $B!V$-$^$9!W$NFCJL%k!<%k(B "\\(^\\|$B$F(B\\|$B$s$G(B\\)\\($B$-$^(B\\($B$9(B\\|$B$;$s(B\\)\\)$" "$B$^$;$k(B$" edict-subst-modified-affix edict-identity () edict-subst ("$B$/$k(B")) (define-edict-rule $B!V$7$^$9!W$NFCJL%k!<%k(B "\\($B$7$^(B\\($B$9(B\\|$B$;$s(B\\)\\)$" () edict-subst-affix "$B$9$k(B") ;; The several cases of $B$F!?$C$F(B. ;; Note either pattern may generate multiple possibilities. ;; Also, $B$?(B. (define-edict-rule $B!V$F!?$?!W$+$i!V$&!W$^$GJQ49$9$k(B "\\($B$C(B\\($B$F(B\\|$B$?(B[$B$i(B]?\\)\\)$" () edict-subst-affix "$B$&(B") (define-edict-rule $B!V$F!?$?!W$+$i!V$D!W$^$GJQ49$9$k(B "\\($B$C(B\\($B$F(B\\|$B$?(B[$B$i(B]?\\)\\)$" () edict-subst-affix "$B$D(B") (define-edict-rule $B!V$F!?$?!W$+$i!V$k!W$^$GJQ49$9$k(B "\\($B$C(B\\($B$F(B\\|$B$?(B[$B$i(B]?\\)\\)$" () edict-subst-affix "$B$k(B") (define-edict-rule $B0lCJ$N!V$F!?$?!W$+$i!V$k!W$^$GJQ49$9$k(B (concat "\\(" edict-category-c "\\|[$B$$$-$.$7$A$K$S$_$j$($1$2$;$F$M$Y$a$l(B]\\)\\(\\($B$F(B\\|$B$?(B[$B$i(B]?\\)\\)$") () edict-subst-affix edict-identity "$B$k(B") (define-edict-rule $B!V$F!?$?!W$+$i!V$9!W$^$GJQ49$9$k(B "\\($B$7(B\\($B$F(B\\|$B$?(B[$B$i(B]?\\)\\)$" () edict-subst-affix "$B$9(B") (define-edict-rule $B!V$F!?$?!W$+$i!V$/!W$^$GJQ49$9$k(B "\\($B$$(B\\($B$F(B\\|$B$?(B[$B$i(B]?\\)\\)$" () edict-subst-affix "$B$/(B") (define-edict-rule $B!V$F!?$?!W$+$i!V$0!W$^$GJQ49$9$k(B "\\($B$$(B[$B$G$@(B]\\)$" () edict-subst-affix "$B$0(B") (define-edict-rule $B!V$F!?$?!W$+$i!V$V!W$^$GJQ49$9$k(B "\\($B$s(B\\($B$G(B\\|$B$@(B[$B$i(B]?\\)\\)$" () edict-subst-affix "$B$V(B") (define-edict-rule $B!V$F!?$?!W$+$i!V$`!W$^$GJQ49$9$k(B "\\($B$s(B\\($B$G(B\\|$B$@(B[$B$i(B]?\\)\\)$" () edict-subst-affix "$B$`(B") (define-edict-rule $B!V$F!?$?!W$+$i!V$L!W$^$GJQ49$9$k(B "\\($B$s(B\\($B$G(B\\|$B$@(B[$B$i(B]?\\)\\)$" () edict-subst-affix "$B$L(B") ;; $B9T$/(B is an irregular verb. (define-edict-rule $B9T$/$NFCJL%k!<%k(B "$B9T(B\\($B$C(B\\($B$F(B\\|$B$?(B[$B$i(B]?\\)\\)$" () edict-subst-affix "$B$/(B") (define-edict-rule $B!VMh$F!W$NFCJL%k!<%k(B "$BMh(B\\($B$F(B\\|$B$?(B[$B$i(B]?\\)$" () edict-subst-affix "$BMh$k(B") (define-edict-rule $B!V$-$F!W$NFCJL%k!<%k(B "\\($B$-$F(B\\|$B$-$?(B[$B$i(B]?\\)$" () edict-subst-affix "$B$/$k(B") (define-edict-rule $B!V$7$F!W$NFCJL%k!<%k(B "\\($B$7$F(B\\|$B$7$?(B[$B$i(B]?\\)$" () edict-subst-affix "$B$9$k(B") ;; Potential form. ;; The filters here are due to $B!V0lCJ$N!V$F!?$?!W$+$i!V$k!W$^$GJQ49$9$k!W(B (define-edict-rule $B$l$k(B (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\($B$l$k(B\\)$") "$B$l$F(B$" edict-subst-affix edict-identity "$B$k(B") (define-edict-rule $B$1$k(B (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\($B$1$k(B\\)$") "$B$1$F(B$" edict-subst-affix edict-identity "$B$/(B") (define-edict-rule $B$;$k(B (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\($B$;$k(B\\)$") "$B$;$F(B$" edict-subst-affix edict-identity "$B$9(B") (define-edict-rule $B$F$k(B (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\($B$F$k(B\\)$") "\\($B$F(B\\|$B$F$i$l$k(B\\)$" edict-subst-affix edict-identity "$B$D(B") (define-edict-rule $B$M$k(B (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\($B$M$k(B\\)$") "$B$M$F(B" edict-subst-affix edict-identity "$B$L(B") (define-edict-rule $B$a$k(B (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\($B$a$k(B\\)$") "$B$a$F(B" edict-subst-affix edict-identity "$B$`(B") (define-edict-rule $B$((B (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\($B$($k(B\\)$") "$B$($F(B" edict-subst-affix edict-identity "$B$&(B") (define-edict-rule $B$2$k(B (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\($B$2$k(B\\)$") "$B$1$F(B" edict-subst-affix edict-identity "$B$0(B") (define-edict-rule $B$Y$k(B (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\($B$Y$k(B\\)$") "$B$Y$F(B" edict-subst-affix edict-identity "$B$V(B") ;; $B0lCJF0;l!#(B Also serves for the passive. (define-edict-rule $B$i$l$k(B (concat "\\(" edict-category-c "\\|[$B$$$-$.$7$A$K$S$_$j$($1$2$;$F$M$Y$a$l(B]\\)\\($B$i$l$k(B\\)$") () edict-subst-affix edict-identity "$B$k(B") ;; Passive (define-edict-rule $B8^CJF0;l$N!V$"$l$k!W$rJQ49$9$k(B "\\([$B$o$+$,$5$?$J$^$P$i(B]\\)\\($B$l$k(B\\)$" () edict-subst-modified-affix edict-modify-verb (0 2) edict-ignore ()) (define-edict-rule $BMh$i$l$k$N%k!<%k(B "$BMh(B\\($B$i$l$k(B\\)$" () edict-subst-affix "$B$k(B") (define-edict-rule $B$5$l$k$N%k!<%k(B "\\($B$5$l$k(B\\)$" () edict-subst-affix "$B$9$k(B") ;; Causative (define-edict-rule $B8^CJF0;l$N!V$"$;$k!W$rJQ49$9$k(B "\\([$B$o$+$,$5$?$J$^$P$i(B]\\)\\($B$;$k(B\\)$" () edict-subst-modified-affix edict-modify-verb (0 2) edict-ignore ()) (define-edict-rule $B0lCJF0;l$N!V$"$;$k!W$rJQ49$9$k(B (concat "\\(" edict-category-c "\\|[$B$$$-$.$7$A$K$S$_$j$($1$2$;$F$M$Y$a$l(B]\\)\\($B$5$;$k(B\\)$") () edict-subst-affix edict-identity "$B$k(B") (define-edict-rule $B$5$;$k$N%k!<%k(B "\\($B$5$;$k(B\\)$" () edict-subst-affix "$B$9$k(B") ;; eba conditional form. (define-edict-rule $B!V$($P!W$rJQ49$9$k(B "\\([$B$($1$2$;$F$M$Y$a$l(B]\\)\\($B$P(B\\)$" () edict-subst-modified-affix edict-modify-verb (3 2) edict-ignore ()) ;; tara conditional form is handled as part of the $B$F!?$?!?$?$i(B rules. ;; The informal negative form. (define-edict-rule $B!V$J$$!W$rJQ49$9$k(B "\\([$B$o$+$,$5$?$J$^$P$i(B]\\)\\($B$J$$(B\\|$B$:(B\\)$" () edict-subst-modified-affix edict-modify-verb (0 2) edict-ignore ()) (define-edict-rule $B0lCJ$N!V$J$$!W$rJQ49$9$k(B (concat "\\(" edict-category-c "\\|[$B$$$-$.$7$A$K$S$_$j$($1$2$;$F$M$Y$a$l(B]\\)\\($B$J$$(B\\|$B$:(B\\)$") () edict-subst-affix edict-identity "$B$k(B") (define-edict-rule $B!V$7$J$$!W$NFCJL%k!<%k(B "\\($B$7$J$$(B\\|$B$;$:(B\\)$" () edict-subst-affix "$B$9$k(B") (define-edict-rule $B!V$J$$!W$NFCJL%k!<%k(B "^\\($B$J$$(B\\)$" () edict-subst-affix "$B$"$k(B") ;; Conjunctive form (define-edict-rule $B0lCJ$N(Bconjunctive (concat "\\(" edict-category-c "\\|" edict-category-h "\\)[$B$$$-$.$7$A$K$S$_$j$($1$2$;$F$M$Y$a$l(B]\\(\\)$") "$B$/(B$\\|$B$+$C$?(B$\\|$B$/$k(B$\\|$B$/$l$k(B$\\|$B$/$@$5$$(B$\\|$B$"$2$k(B$\\|$B>e$2$k(B$\\|$B$7$^$&(B$\\|$B$/$F(B$\\|$B$/$J$$(B$\\|$B$1$l$P(B$\\|$B$$$k(B$\\|$B$+$i$:(B$\\|$B$$$^$9(B$\\|$B$"$k(B$\\|$B$_$k(B$\\|$B2<$5$$(B$\\|$B$J$5$$(B$\\|$B$d$k(B$\\|$B$b$i$&(B$" edict-subst-modified-affix edict-identity () edict-subst ("$B$k(B")) (define-edict-rule $B8^CJ$N(Bconjunctive (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\([$B$$$-$.$7$A$K$S$_$j(B]\\)$") "$B$/(B$\\|$B$+$C$?(B$\\|$B$/$k(B$\\|$B$/$l$k(B$\\|$B$/$@$5$$(B$\\|$B$"$2$k(B$\\|$B>e$2$k(B$\\|$B$7$^$&(B$\\|$B$/$F(B$\\|$B$/$J$$(B$\\|$B$1$l$P(B$\\|$B$$$k(B$\\|$B$+$i$:(B$\\|$B$$$^$9(B$\\|$B$"$k(B$\\|$B$_$k(B$\\|$B2<$5$$(B$\\|$B$J$5$$(B$\\|$B$d$k(B$\\|$B$b$i$&(B$" edict-subst-modified-affix edict-identity () edict-modify-verb (1 2)) (define-edict-rule $B!V$9$k!W$NFCJL(Bconjunctive (concat "\\(" edict-category-Japanese-word-constituent "\\)\\($B$7(B\\)$") "$B$9(B$" edict-subst-affix edict-identity "$B$9$k(B") (define-edict-rule $B!V$8$k!W$NFCJL(Bconjunctive (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\($B$8(B\\)$") () edict-subst-affix edict-identity "$B$8$k(B") (define-edict-rule $B!V$:$k!W$NFCJL(Bconjunctive (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\($B$8(B\\)$") () edict-subst-affix edict-identity "$B$:$k(B") ;; The informal imperative form, $B8^CJF0;l(B (define-edict-rule $B!V$l!W$N8^CJF0;l$rJQ49$9$k(B (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\([$B$($1$2$;$F$M$Y$a$l(B]\\)$") () edict-subst-modified-affix edict-identity () edict-modify-verb (3 2)) ;; The informal imperative form, $B0lCJF0;l(B (define-edict-rule $B!V$m!W$N0lCJF0;l$rJQ49$9$k(B (concat "\\(" edict-category-c "\\|[$B$$$-$.$7$A$K$S$_$j$($1$2$;$F$M$Y$a$l(B]\\)\\($B$m(B\\)$") () edict-subst-affix edict-identity "$B$k(B") ;; Irregulars (define-edict-rule $B!VMh$$!W$NFCJL%k!<%k(B "^\\($BMh$$(B\\)$" () edict-subst-affix "$BMh$k(B") (define-edict-rule $B!V$3$$!W$NFCJL%k!<%k(B "^\\($B$3$$(B\\)$" "$B$/(B$" edict-subst-affix "$B$/$k(B") (define-edict-rule $B!V$7$m!W$NFCJL%k!<%k(B "^\\($B$7$m(B\\)$" () edict-subst-affix "$B$9$k(B") ;; The plain desiderative (define-edict-rule $B!V$?$$!W$r:o=|$9$k(B (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\([$B$$$-$.$7$A$K$S$_$j(B]\\)\\($B$?$$(B\\|$B$?$,$k(B\\)$") () edict-subst-modified-affix edict-identity () edict-modify-verb (1 2) edict-ignore ()) (define-edict-rule $B0lCJ$N!V$?$$!W$r:o=|$9$k(B (concat "\\(" edict-category-c "\\|[$B$$$-$.$7$A$K$S$_$j$($1$2$;$F$M$Y$a$l(B]\\)\\($B$?$$(B\\|$B$?$,$k(B\\)$") () edict-subst-affix edict-identity "$B$k(B") (define-edict-rule $B!V$7$?$$!W$NFCJL%k!<%k(B "^\\($B$7$?$$(B\\|$B$7$?$,$k(B\\)$" () edict-subst-affix "$B$9$k(B") (define-edict-rule $B!VMh$?$$!W$NFCJL%k!<%k(B "^\\($BMh$?$$(B\\|$BMh$?$,$k(B\\)$" () edict-subst-affix "$BMh$k(B") (define-edict-rule $B!V$-$?$$!W$NFCJL%k!<%k(B "^\\($B$-$?$$(B\\|$B$-$?$,$k(B\\)$" () edict-subst-affix "$B$/$k(B") ;; Flush auxilliary verbs after te form. (define-edict-rule $B=uF0;l!<#1(B (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\($B$/(B\\|$B$F(B\\|$B$s$G(B\\)\\($B$$$k(B\\|$B$*$k(B\\|$B$$$^$9(B\\|$B$"$k(B\\|$B$*$/(B\\|$B$_$k(B\\)$") () edict-subst-modified-affix edict-identity () edict-identity () edict-ignore ()) (define-edict-rule $B=uF0;l!<#1#a(B (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\($B$F(B\\|$B$s$G(B\\)\\($B$k(B\\)$") () edict-subst-modified-affix edict-identity () edict-identity () edict-ignore ()) (define-edict-rule $B=uF0;l!<#2(B (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\($B$/(B\\|$B$F(B\\|$B$s$G(B\\)\\($B2<$5$$(B\\|$B$/$@$5$$(B\\|$B$J$5$$(B\\|$B$$$/(B\\|$B9T$/(B\\|$B$/$k(B\\|$BMh$k(B\\)$") () edict-subst-modified-affix edict-identity () edict-identity () edict-ignore ()) (define-edict-rule $B=uF0;l!<#3(B (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\($B$/(B\\|$B$F(B\\|$B$s$G(B\\)\\(\\([$B$5:9(B]$B$7(B\\)?[$B$">e(B]$B$2$k(B\\|$B$d$k(B\\|$B$b$i$&(B\\|$B$$$?$@$/(B\\|$BD:$/(B\\|$B$/$l$k(B\\|$B$/$@$5$k(B\\)$") () edict-subst-modified-affix edict-identity () edict-identity () edict-ignore ()) (define-edict-rule $B=uF0;l!<#4(B (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\($B$/(B\\|$B$F(B\\|$B$s$G(B\\)\\($B$9$k(B\\|$B@.$k(B\\|$B$J$k(B\\|$B$7$^$&(B\\)$") () edict-subst-modified-affix edict-identity () edict-identity () edict-ignore ()) (define-edict-rule modifiers (concat "\\(" edict-category-c "\\|" edict-category-h "\\)[$B$$$?$&$/$0$9$D$L$V$`$k(B]\\($B$i$7$$(B\\|$B$=$&(B\\|$B$h$&(B\\)$") () edict-subst-affix edict-identity "") (define-edict-rule humble (concat "\\($B$*(B\\)\\(" edict-category-c "\\|" edict-category-h "\\)+\\([$B$$$-$.$7$A$K$S$_$j(B]\\)\\($B$K@.$k(B\\|$B$K$J$k(B\\|$B$9$k(B\\|$B$$$?$9(B\\|$B?=$7>e$2$k(B\\|$B$b$&$7$"$2$k(B\\)$") () edict-subst-modified-affix edict-ignore () edict-identity () edict-modify-verb (1 2) edict-ignore ()) ;; Volitional (define-edict-rule $B8^CJ$N!V$*$&!W(B (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\([$B$*$3$4$=$H$N$\$b$m(B]\\)\\($B$&(B\\)$") () edict-subst-modified-affix edict-identity () edict-modify-verb (4 2) edict-ignore ()) (define-edict-rule $B0lCJ$N!V$h$&!W(B (concat "\\(" edict-category-c "\\|[$B$$$-$.$7$A$K$S$_$j$($1$2$;$F$M$Y$a$l(B]\\)\\($B$h$&(B\\)$") () edict-subst-affix edict-identity "$B$k(B") (define-edict-rule $B!VMh$h$&!W$NFCJL%k!<%k(B "\\($BMh$h$&(B\\)$" () edict-subst-affix "$BMh$k(B") (define-edict-rule $B!V$3$h$&!W$NFCJL%k!<%k(B "\\($B$3$h$&(B\\)$" () edict-subst-affix "$B$/$k(B") (define-edict-rule $B!V$7$h$&!W$NFCJL%k!<%k(B "\\($B$7$h$&(B\\)$" () edict-subst-affix "$B$9$k(B") (define-edict-rule $B$F$7$^$&(B "[^$B$s(B]\\($B$A$c$&(B\\)$" () edict-subst-affix "$B$F$7$^$&(B") (define-edict-rule $B$G$7$^$&(B "$B$s(B\\($B$A$c$&(B\\)$" () edict-subst-affix "$B$G$7$^$&(B") ;; Honorific prefixes (define-edict-rule $B7I8l$N@\F,<-(B "^\\($B$*(B\\|$B8f(B\\|$B$4(B\\)" () edict-subst-affix "") ;; Various forms of adjectives. (define-edict-rule $B7AMF;l!<$/(B (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\($B$/(B\\)$") "\\($B$+(B\\($B$l$k(B\\|$B$;$k(B\\|$B$J$$(B\\|$B$:(B\\)\\|$B$-(B\\($B$^$9(B\\|$B$^$;$s(B\\|$B$?$$(B\\|$B$J$+$i(B\\|$B$D$D(B\\|$B$d$5$$(B\\|$B$K$/$$(B\\|$B$=$&$J(B\\)\\|$B$1(B\\($B$P(B\\|\\|$B$k(B\\)\\|$B$3$&(B\\|$B$$(B\\($B$?(B\\|$B$?$i(B\\|$B$?$j(B\\|$B$?$m$&(B\\|$B$F(B\\|$B$F$$$k(B\\)\\)$" edict-subst-affix edict-identity "$B$$(B") (define-edict-rule $B7AMF;l!<$/$F(B (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\($B$/$F(B\\)$") () edict-subst-affix edict-identity "$B$$(B") (define-edict-rule $B7AMF;l!<$/$J$$(B (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\($B$/$J$$(B\\)$") () edict-subst-affix edict-identity "$B$$(B") (define-edict-rule $B7AMF;l!<$+$i$:(B (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\($B$+$i$:(B\\)$") () edict-subst-affix edict-identity "$B$$(B") (define-edict-rule $B7AMF;l!<$+$C$?(B (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\($B$+$C$?(B\\)$") () edict-subst-affix edict-identity "$B$$(B") (define-edict-rule $B7AMF;l!<$J$$(B (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\(\\($B$8$c(B\\|$B$G$O(B\\)\\($B$J$$(B\\|$B$"$j$^$;$s(B\\)\\)$") () edict-subst-affix edict-identity "") (define-edict-rule $B7AMF;l!<$1$l$P(B (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\($B$1$l$P(B\\)$") () edict-subst-affix edict-identity "$B$$(B") ;; Other affixes (define-edict-rule other-suffixes (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\($BE*(B\\|$B$F$-(B\\|$B$b$N(B\\|$BJ*(B\\|$B(B\\|$BKh(B\\)" edict-category-c) () edict-subst-affix "") ;; Canonicalize number expressions (define-edict-rule numbers (concat "^\\([0-9$B#0(B-$B#90lFs;0;M8^O;<7H,6e==I4@iK|2/(B]+\\)\\(" edict-category-c "\\|" edict-category-h "\\)") () edict-subst-affix "$B0l(B" edict-identity ) (define-edict-rule $B?t$J$7(B (concat "^\\([0-9$B#0(B-$B#90lFs;0;M8^O;<7H,6e==I4@iK|2/(B]+\\)\\(" edict-category-c "\\|" edict-category-h "\\)") () edict-subst-affix edict-ignore edict-identity ) (define-edict-rule $B$@(B "\\($B$8$c$J$$(B\\|$B$G$O$J$$(B\\|$B$@$C$?(B\\|$B$@$m$&(B\\)$" () edict-subst-affix "$B$@(B") (define-edict-rule $B$G$9(B "\\($B$8$c$"$j$^$;$s(B\\|$B$G$O$"$j$^$;$s(B\\|$B$G$7$g$&(B\\)$" () edict-subst-affix "$B$G$9(B") (define-edict-rule $B$G$9(B/$B$@(B "\\($B$G$9(B\\)$" () edict-subst-affix "$B$@(B") (define-edict-rule copula (concat "\\(" edict-category-c "\\|" edict-category-h "\\)\\($B$@(B\\|$B$G$9(B\\)$") () edict-subst-affix edict-identity edict-ignore) ;;; edict-japanese.el ends here edict-el-1.06.orig/edict-morphology.el0100644000175000017500000004367506532040555017240 0ustar rolandroland;;; edict-morphology.el --- morphology rewrite engine for edict.el ;; Copyright (C) 1991, 1992 Per Hammarlund (perham@nada.kth.se) ;; Author: Per Hammarlund ;; Keywords: mule, edict, dictionary ;; Version: 0.9.8 ;; Adapted-by: Stephen J. Turnbull for XEmacs ;; Maintainer: Stephen J. Turnbull ;; This file is part of XEmacs. ;; XEmacs is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your ;; option) any later version. ;; XEmacs is distributed in the hope that it will be useful, but ;; WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with XEmacs; if not, write to the Free Software Foundation, ;; Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Some code that looks for translations of english and japanese using the ;; EDICTJ Public Domain japanese/english dictionary. ;; Written by Per Hammarlund ;; Morphology and private dictionary handling/editing by Bob Kerns ;; ;; Helpful remarks from Ken-Ichi Handa . ;; The EDICTJ PD dictionary is maintained by Jim Breen ;; ;; Morphology rewrite engine ;;; To do: ;;; Changelog: ;; 1998-03-27 Stephen Turnbull ;; (created): broken out from monolithic edict.el ;;; Code: (require 'cl) ; for defstruct ;;; Constants: ;; The edict-category-* variables are used to emulate the character ;; categories for regexps that are (partially) documented, but not ;; implemented, in XEmacs/Mule (20.5). It should be possible to use ;; ranges for this, in the sense that defined legal characters in a ;; given range are guaranteed to be of the appropriate category. The ;; reason is that each Mule-defined character set will occupy such a ;; range by virtue of the leading-byte implementation (see `Info | ;; Internals | MULE Character Sets and Encodings | Internal Mule ;; Encodings | Internal Character Encoding' for the easily understood ;; character type representation; the Bufbyte representation is a ;; simple transformation format of varying width). Then JIS, at ;; least, carefully arranges the categories of characters into ;; non-overlapping ranges (ranges > 96 code points (94 for JIS) are ;; necessarily non-contiguous, see the info section cited above---this ;; is why undefined or illegal characters cannot be ruled out). Mule ;; itself is happy to insert undefined characters---try eval'ing ;; (insert (int-char (+ (char-int ?$Bt$(B) 3)))---but balks at illegal ;; ones---(insert (int-char (- (char-int ?$B0!(B) 1))). However, there ;; are two holes in JIS X 0208 (between the yomi-ordered Level 1 kanji ;; and the radical-ordered Level 2, and at the end of the character ;; set) and these undefined characters can be inserted, eg by the LISP ;; code above. ;; Regexp ranges cannot be depended on; they work for all JIS-derived ;; encodings (including EUC, ISO-2022-JP, and SJIS), but won't for ;; UCS/Unicode. Watch out for (eg) Big-5 in trying to generalize this ;; code. ;; The values for the ranges are taken from Ken Lunde, Understanding ;; Japanese Information Processing, (C) 1993 O'Reilly & Associates, ;; Sebastopol, CA, and from $B6S8+!&9b66!&8MBED!&7,M}!&8~@n!&5HED!"(B ;; $B%^%k%A%j%s%,%k4D6-$N ). ;; ;; is a regular expression, with the parts to be substituted ;; being denoted by \\(\\). ;; ;; is a funtion responsible for determining ;; the replacements. The current choices are ;; edict-subst-modified-affix and edict-subst-affix. These ;; functions are called just after doing match-string, so the regexp ;; variables are set up. They are applied to the string, and ;; . These functions are responsible for ;; determining and performing the substitutions to be made, and ;; returning a list of possiblities. ;; ;; edict-subst-affix is the simpler case. It takes as conversion ;; data one string for each subpattern in the pattern. This string ;; will be used in place of the original. ;; ;; edict-subst-modified-affix takes as conversion data, an ;; alternating list of functions and lists of additional arguments ;; for those functions. Each function is applied to the substring ;; being replaced and its additional arguments. Likely functions to ;; use include edict-modify-verb, edict-ignore, and edict-subst. ;; Table of morphological rules. (defvar *edict-syntax-types* nil) ;; defstruct's defsetfs should expand into this; sigh. ;; Maybe this is fixed, comment them out. ;(eval-when (eval load compile) (defstruct edict-syntax-type name rules) ;) (defun get-edict-syntax-type (name) (if (symbolp name) (catch 'found-it (dolist (s *edict-syntax-types*) (when (eq (edict-syntax-type-name s) name) (throw 'found-it s))) (let ((new (make-edict-syntax-type :name name :rules ()))) (push new *edict-syntax-types*) new)) name)) ;(eval-when (eval load compile) (defstruct edict-rule name pattern ;Pattern which it must match filter ;Syntactic filter on previous form function ;Function to transform the input additional-args ;Arguments to transform function from-syntax-types ;Syntaxes for which this is valid to-syntax-types) ;Syntaxes to consider after this rule. ;) ;; Delete all occurrances of a rule from the rule base. (defun edict-delete-rule (name) (dolist (s *edict-syntax-types*) (let ((old (edict-get-rule-from-syntax-type name s))) (when old (setf (edict-syntax-type-rules s) (delq old (edict-syntax-type-rules s))))))) ;(defun edict-decircularize-rules () ; (interactive) ; (dolist (s *edict-syntax-types*) ; (dolist (r (edict-syntax-type-rules s)) ; (setf (edict-rule-from-syntax-types r) ; (mapcar (function (lambda (type) ; (if (symbolp type) ; type ; (edict-syntax-type-name type)))) ; (edict-rule-from-syntax-types r))) ; (setf (edict-rule-to-syntax-types r) ; (mapcar (function (lambda (type) ; (if (symbolp type) ; type ; (edict-syntax-type-name type)))) ; (edict-rule-to-syntax-types r)))))) ; ;(defun edict-circularize-rules () ; (interactive) ; (dolist (s *edict-syntax-types*) ; (dolist (r (edict-syntax-type-rules s)) ; (setf (edict-rule-from-syntax-types r) ; (mapcar (function (lambda (type) ; (if (symbolp type) ; (get-edict-syntax-type type) ; type))) ; (edict-rule-from-syntax-types r))) ; (setf (edict-rule-to-syntax-types r) ; (mapcar (function (lambda (type) ; (if (symbolp type) ; (get-edict-syntax-type type) ; type))) ; (edict-rule-to-syntax-types r)))))) (defun edict-add-rule (name rule) (edict-delete-rule name) (dolist (s (edict-rule-from-syntax-types rule)) (push rule (edict-syntax-type-rules s)))) (defun edict-get-rule-from-syntax-type (name syntax-type) (catch 'edict-get-rule (dolist (rule (edict-syntax-type-rules syntax-type)) (if (eq name (edict-rule-name rule)) (throw 'edict-get-rule rule))))) (defmacro define-edict-rule (name pattern fromto function &rest additional-args) ;; First, some type-checking. (let ((filter nil) (from nil) (to nil) ;; SJT: this needs to be a string. If it already is, that's ok. (pattern (eval pattern))) (when (stringp fromto) (setq filter fromto fromto nil)) (when (null fromto) (setq fromto '($BF|K\8l(B $BF|K\8l(B))) (setq from (first fromto) to (second fromto)) (unless (listp from) (setq from (list from))) (unless (listp to) (setq to (list to))) (unless (string-match "^\\^\\|\\$$" pattern) (error "Rule %s: pattern must start with ^ or end with $: \"%s\"" name pattern)) (when filter (unless (stringp filter) (error "Rule %s: filter must be a regexp" name))) (` (define-edict-rule-internal '(, name) '(, pattern) '(, filter) '(, from) '(, to) (function (, function)) (quote ((,@ additional-args))))))) (defun define-edict-rule-internal (name pattern filter from-syntax-types to-syntax-types function additional-args) (unless (string-match "^\\^\\|\\$$" pattern) (error "Rule %s: pattern must start with ^ or end with $: \"%s\"" name pattern)) (when filter (unless (stringp filter) (error "Rule %s: filter must be a regexp" name))) (let ((from-types nil) (to-types nil)) (dolist (f from-syntax-types) (push (get-edict-syntax-type f) from-types)) (dolist (to to-syntax-types) (push (get-edict-syntax-type to) to-types)) (edict-add-rule name (make-edict-rule :name name :pattern pattern :filter filter :from-syntax-types from-types :to-syntax-types to-types :function function :additional-args additional-args)) name)) ;; #### This is bogus; the function does not match what the ;; #### description above the rules says it satisfies. In particular, ;; #### it is supposed to take only strings as arguments. (defun edict-subst-affix (string &rest affixes) (let ((i 1) (prev -1) (result "")) (dolist (x affixes) (let ((pos (match-beginning i))) ;; #### aren't the behaviors of edict-identity and ;; edict-ignore reversed? ;; #### Hmm ... maybe this code never triggers. (cond ((eq x 'edict-identity)) ((eq x 'edict-ignore) (setq result (concat result (substring string (max prev 0) (match-beginning i))) prev (match-end i))) ((and (symbolp x) (fboundp x)) (setq result (concat result (substring string (max prev 0) (match-beginning i)) (funcall x (substring string (match-beginning i) (match-end i)))))) ((not (stringp x)) (error "%s is not a string or function name in edict-subst-affix" x)) ((and pos (>= pos prev)) (setq result (concat result (substring string (max prev 0) (match-beginning i)) x)) (setq prev (match-end i)))) (incf i))) (concat result (substring string (max prev 0))))) ;; Takes a series of alternating pairs of substitution functions ;; and arguments for those substitution functions. This can be ;; used to algorithmically replace certain parts (typically involving ;; changing an $B$$9T(B to $B$&9T(B final character. (defun edict-subst-modified-affix (string &rest affixes) (let ((fun nil) (args nil) (i 1) (prev -1) (result "")) (while affixes (setq fun (car affixes) args (car (cdr affixes)) affixes (cdr (cdr affixes))) (let ((pos (match-beginning i))) ;; #### aren't the behaviors of edict-identity and ;; edict-ignore reversed? ;; #### Hmm ... maybe this code never triggers. (cond ((eq fun 'edict-identity)) ((eq fun 'edict-ignore) (setq result (concat result (substring string (max prev 0) (match-beginning i))) prev (match-end i))) ((not (or (stringp fun) (and (symbolp fun) (fboundp fun)))) (error "%s is not a string or function name in %s" fun 'edict-subst-modified-affix)) ((and pos (>= pos prev)) (setq result (concat result (substring string (max prev 0) pos) (apply fun (substring string (match-beginning i) (match-end i)) args))) (setq prev (max prev (match-end i))))) (incf i))) (concat result (substring string (max prev 0))))) ;; Ignore this piece (defun edict-ignore (affix) "") ;; Keep this piece (defun edict-identity (affix) affix) ;; Substitute for this piece (defun edict-subst (affix data) data) ;; More or less a guon table, for converting doshi suffixes. (defvar *edict-doshi-suffix* '(["$B$o(B" "$B$$(B" "$B$&(B" "$B$((B" "$B$*(B"];; u -> wa; kau->kawanai ["$B$+(B" "$B$-(B" "$B$/(B" "$B$1(B" "$B$3(B"] ["$B$,(B" "$B$.(B" "$B$0(B" "$B$2(B" "$B$4(B"] ["$B$5(B" "$B$7(B" "$B$9(B" "$B$;(B" "$B$=(B"] ["$B$6(B" "$B$8(B" "$B$:(B" "$B$<(B" "$B$>(B"] ["$B$?(B" "$B$A(B" "$B$D(B" "$B$F(B" "$B$H(B"] ["$B$@(B" "$B$B(B" "$B$E(B" "$B$G(B" "$B$I(B"] ["$B$J(B" "$B$K(B" "$B$L(B" "$B$M(B" "$B$N(B"] ["$B$O(B" "$B$R(B" "$B$U(B" "$B$X(B" "$B$[(B"] ["$B$P(B" "$B$S(B" "$B$V(B" "$B$Y(B" "$B$\(B"] ["$B$Q(B" "$B$T(B" "$B$W(B" "$B$Z(B" "$B$](B"] ["$B$^(B" "$B$_(B" "$B$`(B" "$B$a(B" "$B$b(B"] ["$B$i(B" "$B$j(B" "$B$k(B" "$B$l(B" "$B$m(B"])) (defun edict-modify-verb (suffix from to) (catch 'exit (dolist (b *edict-doshi-suffix*) (if (equal suffix (aref b from)) (throw 'exit (aref b to)))) (throw 'skip-rule nil))) ;; Set this to true for debugging. (defvar *edict-expand-string-trace* nil) ;; This returns a list of the results of applying all rules whose ;; patterns match, to all levels of recursion. (defun edict-expand-string (string &optional others previous syntax) (let* ((result nil) (syntax (or syntax '$BF|K\8l(B)) (stype (get-edict-syntax-type syntax))) (dolist (rule (edict-syntax-type-rules stype)) (when (string-match (edict-rule-pattern rule) string) (catch 'skip-rule (unless (and previous (edict-rule-filter rule) (edict-filter-rule rule previous)) (let ((temp (apply (edict-rule-function rule) string (edict-rule-additional-args rule)))) (unless (or (equal temp string) (member temp others) (member temp result)) (when *edict-expand-string-trace* (read-string (format "%s: %s -> %s -:" (edict-rule-name rule) string temp))) (setq result (union (edict-expand-string-recurse temp (cons string (append result others)) string rule) result)))))))) (if (member string result) result (cons string result)))) (defun edict-expand-string-recurse (string others previous rule) (edict-expand-string-syntaxes string others previous (edict-rule-to-syntax-types rule))) (defun edict-expand-string-syntaxes (string others previous syntaxes) (let ((result nil)) (dolist (syntax syntaxes) (setq result (union (edict-expand-string string (append result others) previous syntax) result))) result)) ;; Returns T if the rule should not be run, because of the past ;; history of expansions. I.e. if something started out with $B$/(Bon ;; the end, and we've made it into an adjective, we should disable ;; any expansions based on it being a the conjunctive/stem form of a ;; verb. This is done purely based on the most immediately preceding ;; expansion, because that is what determined the sense of the word. (defun edict-filter-rule (rule previous) (let ((filter (edict-rule-filter rule))) (cond ((null filter) nil) ((null previous) nil) ((stringp filter) (string-match filter previous)) ;; #### This code is not functional yet, let those cases signal errors. ; ((symbolp filter) ; (funcall filter frob)) ; ((consp filter) ; (apply (car filter) frob (cdr filter))) (t (error "Bogus filter in rule %s: %s" (edict-rule-name rule) filter))))) ;(defun edict-find (elt list) ; (catch 'edict-find ; (dolist (test list) ; (when (equal elt test) ; (throw 'edict-find test))))) ;(defun edict-union (set1 set2) ; (let ((result set2)) ; (dolist (frob set1) ; (unless (member frob set2) ; (setq result (cons frob result)))) ; result)) (provide 'edict-morphology) ;;; edict-morphology.el ends here edict-el-1.06.orig/edict-test.el0100644000175000017500000011116706524336052016011 0ustar rolandroland;;;;;; Copyright (C) 1992 Bob Kerns ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 1, or (at your option) ;;; any later version. ;;; ;;; This program is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with this program; if not, write to the Free Software ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; ;;; Test suite for morphology rules for edict.el. ;;; To run the tests, load this file, and do m-X edict-perform-tests. ;;; This will create an *EDICT-TESTS* buffer with the results. (require 'cl) ;;; This should exist, but doesn't. See edict.install for the ;;; compiler half of this. You should be sure to load the same ;;; hacks into your compiler if you compile this by hand, or you ;;; won't get it byte compiled. ;(defmacro eval-when (when &rest forms) ; (and (or (member 'eval when) ; (member ':execute when)) ; (mapcar (function eval) forms)) ; (and (or (member 'load when) ; (member ':load-toplevel when)) ; (cons 'progn forms))) ;;; first, a couple simple tests. (defun edict-test-string (flag string) "Show what strings will be searched for a test string. If given a prefix arg, traces step by step; type Return for each new step." (interactive "P sTest string: ") (let ((*edict-expand-string-trace* flag)) (message (format "%s" (edict-expand-string string))))) (defun edict-test-rule (rule-name string) (interactive "SRule name: sTest string: ") (let ((rule (edict-get-rule rule-name))) (unless rule (error "There is no rule named '%s'" rule-name)) (unless (string-match (edict-rule-pattern rule) string) (error "The rule %s does not match '%s'." rule-name string)) (apply (edict-rule-function rule) string (edict-rule-additional-args rule)))) (eval-when (eval load compile) (defstruct edict-test word ; Word to be tested. should-have ; Expansions that should be found should-not-have ; Expansions that should not be found. from-syntax-types to-syntax-types) ) (defvar *edict-tests* nil) (defun remove-edict-test (name) (let ((test (get-edict-test name))) (setq *edict-tests* (delq test *edict-tests*)))) (defun add-edict-test (test) ;; Preserve the order of the tests. (let* ((name (edict-test-word test)) (old (get-edict-test name))) (if old (setf (edict-test-should-have old) (edict-test-should-have test) (edict-test-should-not-have old) (edict-test-should-not-have test) (edict-test-from-syntax-types old) (edict-test-from-syntax-types test) (edict-test-to-syntax-types old) (edict-test-to-syntax-types test)) (setq *edict-tests* (append *edict-tests* (list test)))))) (defun get-edict-test (name) (if (symbolp name) (setq name (symbol-name name))) (catch 'found-it (dolist (test *edict-tests*) (if (equal (edict-test-word test) name) (throw 'found-it test))))) (defmacro deftest (case &optional fromto should-have should-not-have not-self) (` (define-edict-test '(, case) '(, (first fromto)) '(, (second fromto)) '(, should-have) '(, should-not-have) '(, not-self)))) (defun define-edict-test (name from to should-have should-not-have &optional not-self) (if (symbolp name) (setq name (symbol-name name))) (unless (listp from) (setq from (list from))) (unless (listp to) (setq to (list to))) (unless from (setq from '($BF|K\8l(B))) (let ((f (function (lambda (x) (if (symbolp x) (symbol-name x) x))))) (setq should-have (mapcar f should-have)) (setq should-not-have (mapcar f should-not-have)) (or not-self (member name should-have) (push name should-have)) (add-edict-test (make-edict-test :word name :should-have should-have :should-not-have should-not-have :from-syntax-types from :to-syntax-types to))) name) ;;; This should be in emacs, but it isn't. ;;; (Borrowed from ilisp.el, where I inherited it accidentally). (defun edict-del (item list &optional test) "Delete ITEM from LIST using TEST comparison and return the result. Default test is equal." (let ((test (or test (function equal))) (element list) (prev nil) (done nil)) (while (and element (not done)) (if (funcall test item (car element)) (progn (setq done t) (if prev (rplacd prev (cdr element)) (setq list (cdr list)))) (setq prev element element (cdr element)))) list)) (defun edict-test (test) (if (or (symbolp test) (stringp test)) (setq test (get-edict-test test))) ;; Cleaning up the kanji shouldn't break anything; ;; give it a chance to do so if it's buggy. (let* ((name (edict-test-word test)) (word (edict-clean-up-kanji name)) (from-syntax-types (edict-test-from-syntax-types test)) (to-syntax-types (edict-test-to-syntax-types test)) (should-have (edict-test-should-have test)) (should-not-have (edict-test-should-not-have test))) (let* ((expansion (edict-expand-string-syntaxes word () () from-syntax-types)) (save-expansion expansion) (failed nil)) (dolist (sh should-have) (if (member sh expansion) (setq expansion (edict-del sh expansion (function equal))) (progn (princ (format ";%s: did not produce %s - %S\n" name sh save-expansion)) (setq failed t)))) (dolist (case should-not-have) (and (member case expansion) (progn (princ (format ";%s: Should not have %s as expansion.\n" name case)) (setq failed t) (setq expansion (edict-del sh expansion (function equal)))))) (dolist (bad expansion) (princ (format ";%s: Unexpected expansion: %s\n" name bad)) (setq failed t)) (or failed (princ (format ";%s: OK\n" name))) (not failed)))) (defun edict-perform-tests () (interactive) (let ((test-buffer (get-buffer-create "*EDICT-TESTS*")) (failures 0) (first-failure nil)) (set-buffer test-buffer) (set-window-buffer (selected-window) test-buffer) (delete-region (point-min) (point-max)) (let ((standard-output test-buffer)) (dolist (test *edict-tests*) (let ((msg-point (point))) (cond ((not (edict-test test)) (incf failures) (or first-failure (setq first-failure msg-point)))) (sit-for 0)))) (cond ((= failures 0) (message "Done. All Tests OK.")) ((= failures 1) (message "1 test failed.")) (t (message (format "%d tests failed." failures)))) (goto-char (or first-failure (point-min))))) (defun edict-run-test (arg) "Execute the test that point is in or before. Print value in minibuffer. With argument, insert value in current buffer after the defun. With argument >= 16 (i.e. c-U c-U), single-step through the expansion process." (interactive "P") (save-excursion (end-of-defun) (let ((end (point)) (*edict-expand-string-trace* (and arg (> (prefix-numeric-value arg) 4)))) (beginning-of-defun) (let* ((test-form (read (current-buffer))) (test-name (second test-form)) (test)) (eval test-form) (setq test (get-edict-test test-name)) (forward-line 1) (while (looking-at (concat ";" (symbol-name test-name) ": \\(Unexpected expansion: \\|did not produce \\|OK$\\)")) (let ((start (point))) (forward-line 1) (delete-region start (point)))) (let ((standard-output (if arg (current-buffer) standard-output))) (edict-test test))))) t) ;(global-set-key "\e_" 'edict-run-test) ;;; **** NOTE WELL **** ;;; The proper test results here are not necessarily valid words. ;;; These are words which are MORPHOLOGICALLY correct. That is, ;;; this reverse-chains on the possible rules to produce a given ;;; word, generally only one or two of which would actually be ;;; correct. ;;; Also note that these are regression tests. No distinction is being ;;; made between results which are "correct" and results which are ;;; "acceptable". In general, we accept spurious expansions if they ;;; lead to including desirable results in other cases. Modifying the ;;; rule set may either result in eliminating spurious expansions (resulting ;;; in missing expansions from the tests) or adding new spurious expansions. ;;; In case of problems from these tests, the offending test should be single-stepped ;;; (with c-u c-u m-X edict-run-test), and the reasons for the expansion should be ;;; evaluated. If, after careful consideration, the modified result is regarded ;;; as correct, the test should be modified accordingly. Otherwise, the bug should ;;; be fixed. ;;; Be careful. Regression tests are good for considering all the effects of ;;; a change, but they do not themselves determine the correctness of a change. ;;; When the regression tests determine that something has changed, it is up ;;; to YOU to be careful and determine the correct result. (deftest "$BGc$&(B " () ($BGc$&(B) () :not-self) (deftest " $B!d!!Gc!t(B#>!$B!*!'(B:$B$&(B " () ($BGc$&(B) () :not-self) ;;; The basics: $B8^CJF0;l(B (deftest $BGc$&(B ()) (deftest $B9T$/(B () ($B9T$$(B)) ;Looks like it could be an adverb ;$B9T$/(B: OK (deftest $B1K$0(B ()) (deftest $BOC$9(B ()) (deftest $BBT$D(B ()) (deftest $B;`$L(B ()) (deftest $B8F$V(B ()) (deftest $BFI$`(B ()) (deftest $BJ,$+$k(B ()) (deftest $B@.$k(B ()) ;;; $B0lCJF0;l(B (deftest $B@8$-$k(B ()) (deftest $B8+$k(B ()) ;;; Distal style ;;; These all produce the improbable but possible result of removing only the ;;; masu and adding $B$k(B as if it were a $B0lCJF0;l(B, since the result of that situation ;;; would look the same. (deftest $BGc$$$^$9(B () ($BGc$&(B $BGc$$$k(B)) (deftest $BCV$-$^$9(B () ($BCV$/(B $BCV$-$k(B)) ;$BCV$-$^$9(B: OK (deftest $B1K$.$^$9(B () ($B1K$0(B $B1K$.$k(B)) (deftest $BOC$7$^$9(B () ($BOC$9(B $BOC$7$k(B $BOC$9$k(B $BOC(B)) (deftest $B;}$A$^$9(B () ($B;}$D(B $B;}$A$k(B)) (deftest $B;`$K$^$9(B () ($B;`$L(B $B;`$K$k(B)) (deftest $B8F$S$^$9(B () ($B8F$V(B $B8F$S$k(B)) (deftest $BFI$_$^$9(B () ($BFI$`(B $BFI$_$k(B)) (deftest $BJ,$+$j$^$9(B () ($BJ,$+$k(B $BJ,$+$j$k(B)) (deftest $B@.$j$^$9(B () ($B@.$k(B $B@.$j$k(B)) (deftest $B@8$-$^$9(B () ($B@8$-$k(B $B@8$/(B)) ;$B@8$-$^$9(B: OK (deftest $B8+$^$9(B () ($B8+$k(B)) ;;; Irregulars (deftest $BMh$^$9(B () ($BMh$k(B)) (deftest $B$-$^$9(B () ($B$/$k(B $B$-$k(B)) (deftest $B$7$^$9(B () ($B$9$k(B $B$7$k(B)) (deftest $BGc$$$^$;$s(B () ($BGc$&(B $BGc$$$k(B)) (deftest $BCV$-$^$;$s(B () ($BCV$/(B $BCV$-$k(B)) ;$BCV$-$^$;$s(B: OK (deftest $B1K$.$^$;$s(B () ($B1K$0(B $B1K$.$k(B)) (deftest $BOC$7$^$;$s(B () ($BOC$9(B $BOC$7$k(B $BOC$9$k(B $BOC(B)) (deftest $B;}$A$^$;$s(B () ($B;}$D(B $B;}$A$k(B)) (deftest $B;`$K$^$;$s(B () ($B;`$L(B $B;`$K$k(B)) (deftest $B8F$S$^$;$s(B () ($B8F$V(B $B8F$S$k(B)) (deftest $BFI$_$^$;$s(B () ($BFI$`(B $BFI$_$k(B)) (deftest $BJ,$+$j$^$;$s(B () ($BJ,$+$k(B $BJ,$+$j$k(B)) (deftest $B@.$j$^$;$s(B () ($B@.$k(B $B@.$j$k(B)) (deftest $B@8$-$^$;$s(B () ($B@8$-$k(B $B@8$/(B)) ;$B@8$-$^$;$s(B: OK (deftest $B8+$^$;$s(B () ($B8+$k(B)) ;;; Irregulars (deftest $BMh$^$;$s(B () ($BMh$k(B)) (deftest $B$-$^$;$s(B () ($B$/$k(B $B$-$k(B)) (deftest $B$7$^$;$s(B () ($B$9$k(B $B$7$k(B)) ;;; Past tense (deftest $BGc$C$?(B () ($BGc$&(B $BGc$D(B $BGc$k(B)) (deftest $BCV$$$?(B () ($BCV$/(B $BCV$$$k(B)) ;$BCV$$$?(B: OK (deftest $B9T$C$?(B ();iku is irregular It looks like a $B$k(B/$B$D(B/$B$&(B. ($B9T$/(B $B9T$$(B $B9T$&(B $B9T$D(B $B9T$k(B)) ;$B9T$C$?(B: OK (deftest $BOC$7$?(B () ($BOC$9(B $BOC$7$k(B $BOC$9$k(B $BOC(B)) ;$BOC$7$?(B: OK (deftest $B;}$C$?(B () ($B;}$D(B $B;}$&(B $B;}$k(B)) (deftest $B;`$s$?(B ();Don't mis-interpret () ($B;`$L(B)) (deftest $B;`$s$@(B () ($B;`$L(B $B;`$V(B $B;`$`(B $B;`$s(B)) ;$B;`$s$@(B: OK (deftest $B8F$s$@(B () ($B8F$V(B $B8F$`(B $B8F$L(B $B8F$s(B)) ;$B8F$s$@(B: OK (deftest $BFI$s$@(B () ($BFI$`(B $BFI$L(B $BFI$V(B $BFI$s(B)) ;$BFI$s$@(B: OK (deftest $BJ,$+$C$?(B () ($BJ,$+$k(B $BJ,$$(B $BJ,$+$&(B $BJ,$+$D(B)) ;$BJ,$+$C$?(B: OK (deftest $B@.$C$?(B () ($B@.$k(B $B@.$&(B $B@.$D(B)) ;;; $B0lCJF0;l(B (deftest $B@8$-$?(B () ($B@8$-$k(B $B@8$/$k(B)) ;$B@8$-$?(B: OK (deftest $B8+$?(B () ($B8+$k(B)) ;;; Gerund ;;; These all also map to $B$D(B, because of the plan imperative form. ;;; This seems surprising, if you're not thinking about it. (deftest $BGc$C$F(B () ($BGc$&(B $BGc$D(B $BGc$k(B $BGc$C$D(B $BGc$C$F$k(B)) ;$BGc$C$F(B: OK (deftest $BCV$$$F(B () ($BCV$/(B $BCV$$$k(B $BCV$$$D(B $BCV$$$F$k(B)) ;$BCV$$$F(B: OK (deftest $B9T$C$F(B ();iku is irregular It looks like a $B$k(B/$B$D(B/$B$&(B. ($B9T$/(B $B9T$$(B $B9T$&(B $B9T$D(B $B9T$k(B $B9T$C$D(B $B9T$C$F$k(B)) ;$B9T$C$F(B: OK (deftest $BOC$7$F(B () ($BOC$9(B $BOC$7$k(B $BOC$7$D(B $BOC$9$k(B $BOC(B $BOC$7$F$k(B)) ;$BOC$7$F(B: OK (deftest $B;}$C$F(B () ($B;}$D(B $B;}$&(B $B;}$k(B $B;}$C$D(B $B;}$C$F$k(B)) ;$B;}$C$F(B: OK (deftest $B;`$s$F(B ();Don't mis-interpret ($B;`$s$D(B $B;`$s$F$k(B) ($B;`$L(B)) ;$B;`$s$F(B: OK (deftest $B;`$s$G(B () ($B;`$L(B $B;`$V(B $B;`$`(B)) ;$B;`$s$G(B: OK (deftest $B8F$s$G(B () ($B8F$V(B $B8F$`(B $B8F$L(B)) ;$B8F$s$G(B: OK (deftest $BFI$s$G(B () ($BFI$`(B $BFI$L(B $BFI$V(B)) (deftest $BJ,$+$C$F(B () ($BJ,$+$k(B $BJ,$+$&(B $BJ,$+$D(B $BJ,$+$C$D(B $BJ,$+$C$F$k(B)) ;$BJ,$+$C$F(B: OK (deftest $B@.$C$F(B () ($B@.$k(B $B@.$&(B $B@.$D(B $B@.$C$D(B $B@.$C$F$k(B)) ;$B@.$C$F(B: OK ;;; $B0lCJF0;l(B (deftest $B@8$-$F(B () ($B@8$-$k(B $B@8$-$D(B $B@8$/$k(B $B@8$-$F$k(B)) ;$B@8$-$F(B: OK (deftest $B8+$F(B () ($B8+$k(B $B8+$D(B $B8+$F$k(B)) ;$B8+$F(B: OK ;;; Potential (deftest $BGc$($k(B () ($BGc$&(B)) ;$BGc$($k(B: OK (deftest $B?)$Y$i$l$k(B () ($B?)$Y$k(B $B?)$Y$i$k(B $B?)$V(B)) ;$B?)$Y$i$l$k(B: OK (deftest $B8F$Y$k(B () ($B8F$V(B)) ;$B8F$Y$k(B: OK ;;; Passive ;;; These also look like they could be $B0lCJ$I$&$7(B potentials. (deftest $BGc$o$l$k(B () ($BGc$&(B $BGc$o$k(B)) ;$BGc$o$l$k(B: OK (deftest $BCV$+$l$k(B () ($BCV$/(B $BCV$+$k(B)) ;$BCV$+$l$k(B: OK (deftest $B1K$,$l$k(B () ($B1K$0(B $B1K$,$k(B)) (deftest $BOC$5$l$k(B () ($BOC$9(B $BOC$9$k(B $BOC$5$k(B $BOC(B)) ;Because of irregular $B$9$k(B (deftest $BBT$?$l$k(B () ($BBT$D(B $BBT$?$k(B)) (deftest $B;`$J$l$k(B () ($B;`$L(B $B;`$J$k(B)) (deftest $BFI$^$l$k(B () ($BFI$`(B $BFI$^$k(B)) ;$BFI$^$l$k(B: OK (deftest $B8F$P$l$k(B () ($B8F$V(B $B8F$P$k(B)) (deftest $B8+$i$l$k(B () ($B8+$k(B $B8+$i$k(B)) ;;; Irregulars (deftest $BMh$i$l$k(B () ($BMh$k(B $BMh$i$k(B)) (deftest $B$5$l$k(B () ($B$9$k(B $B$5$k(B $B$9(B)) ;$B$9(B because of the regular rule. ;;; Causitive (deftest $BGc$o$;$k(B () ($BGc$&(B $BGc$o$9(B)) ;$BGc$o$;$k(B: OK (deftest $BCV$+$;$k(B () ($BCV$/(B $BCV$+$9(B)) ;$BCV$+$;$k(B: OK (deftest $B1K$,$;$k(B () ($B1K$0(B $B1K$,$9(B)) ;$B1K$,$;$k(B: OK (deftest $BOC$5$;$k(B () ($BOC$k(B $BOC$9(B $BOC$9$k(B $BOC$5$9(B $BOC(B)) ;Because of irregular $B$9$k(B ;$BOC$5$;$k(B: OK (deftest $BBT$?$;$k(B () ($BBT$D(B $BBT$?$9(B)) ;$BBT$?$;$k(B: OK (deftest $B;`$J$;$k(B () ($B;`$L(B $B;`$J$9(B)) ;$B;`$J$;$k(B: OK (deftest $BFI$^$;$k(B () ($BFI$`(B $BFI$^$9(B)) ;$BFI$^$;$k(B: OK (deftest $B8F$P$;$k(B () ($B8F$V(B $B8F$P$9(B)) ;$B8F$P$;$k(B: OK (deftest $B8+$5$;$k(B () ($B8+$k(B $B8+$9(B $B8+$9$k(B $B8+$5$9(B $B8+(B)) ;Because of regular & irregular rules ;$B8+$5$;$k(B: OK ;;; Irregulars (deftest $BMh$5$;$k(B () ($BMh$k(B $BMh$9(B $BMh$9$k(B $BMh$5$9(B $BMh(B)) ;because of regular & irregular rules. ;$BMh$5$;$k(B: OK (deftest $B$5$;$k(B () ($B$9$k(B $B$5$9(B $B$9(B)) ;$B$9(B because of the regular rule. ;$B$5$;$k(B: OK ;;; Conditional (deftest $BGc$($P(B () ($BGc$&(B)) (deftest $BCV$1$P(B () ($BCV$/(B)) (deftest $B1K$2$P(B () ($B1K$0(B)) (deftest $BOC$;$P(B () ($BOC$9(B)) (deftest $BBT$F$P(B () ($BBT$D(B)) (deftest $B;`$M$P(B () ($B;`$L(B)) (deftest $BFI$a$P(B () ($BFI$`(B)) (deftest $B8F$Y$P(B () ($B8F$V(B)) (deftest $B8+$l$P(B () ($B8+$k(B)) ;;; $B$?$i(B conditional form (deftest $BGc$C$?$i(B () ($BGc$&(B $BGc$D(B $BGc$k(B)) (deftest $BCV$$$?$i(B () ($BCV$/(B $BCV$$$k(B)) (deftest $B9T$C$?$i(B ();iku is irregular It looks like a $B$k(B/$B$D(B/$B$&(B. ($B9T$/(B $B9T$$(B $B9T$&(B $B9T$D(B $B9T$k(B)) (deftest $BOC$7$?$i(B () ($BOC$9(B $BOC$7$k(B $BOC$9$k(B $BOC(B)) ;$BOC$7$?$i(B: OK (deftest $B;}$C$?$i(B () ($B;}$D(B $B;}$&(B $B;}$k(B)) (deftest $B;`$s$?$i(B ();Don't mis-interpret () ($B;`$L(B)) (deftest $B;`$s$@$i(B () ($B;`$L(B $B;`$V(B $B;`$`(B)) (deftest $B8F$s$@$i(B () ($B8F$V(B $B8F$`(B $B8F$L(B)) (deftest $BFI$s$@$i(B () ($BFI$`(B $BFI$L(B $BFI$V(B)) (deftest $BJ,$+$C$?$i(B () ($BJ,$+$k(B $BJ,$+$&(B $BJ,$+$D(B)) (deftest $B@.$C$?$i(B () ($B@.$k(B $B@.$&(B $B@.$D(B)) ;;; $B0lCJF0;l(B (deftest $B@8$-$?$i(B () ($B@8$-$k(B $B@8$/$k(B)) ;$B@8$-$?$i(B: OK (deftest $B8+$?$i(B () ($B8+$k(B)) ;;; Plain negative (deftest $BGc$o$J$$(B () ($BGc$&(B $BGc$o$J$$(B $BGc$o$J$&(B $BGc$o$J$$$k(B)) ;$BGc$o$J$$(B: OK (deftest $BCV$+$J$$(B () ($BCV$/(B $BCV$+$J$$(B $BCV$+$J$&(B $BCV$+$J$$$k(B)) ;$BCV$+$J$$(B: OK (deftest $B1K$,$J$$(B () ($B1K$0(B $B1K$,$J$$$k(B $B1K$,$J$&(B)) ;$B1K$,$J$$(B: OK (deftest $BOC$5$J$$(B () ($BOC$9(B $BOC$5$J$$$k(B $BOC$5$J$&(B)) ;$BOC$5$J$$(B: OK (deftest $BBT$?$J$$(B () ($BBT$D(B $BBT$?$J$$$k(B $BBT$?$J$&(B)) ;$BBT$?$J$$(B: OK (deftest $B;`$J$J$$(B () ($B;`$L(B $B;`$J$J$$$k(B $B;`$J$J$&(B)) ;$B;`$J$J$$(B: OK (deftest $BFI$^$J$$(B () ($BFI$`(B $BFI$^$J$$$k(B $BFI$^$J$&(B)) ;$BFI$^$J$$(B: OK (deftest $B8F$P$J$$(B () ($B8F$V(B $B8F$P$J$$$k(B $B8F$P$J$&(B)) ;$B8F$P$J$$(B: OK (deftest $B8+$J$$(B () ($B8+$k(B $B8+$J$$$k(B $B8+$J$&(B)) ;$B8+$J$$(B: OK ;;; Irregulars (deftest $BMh$J$$(B () ($BMh$k(B $BMh$J$$$k(B $BMh$J$&(B)) ;$BMh$J$$(B: OK (deftest $B$7$J$$(B () ($B$9$k(B $B$7$k(B $B$7$J$$$k(B $B$7$J$&(B)) ;$B$7$k(B because of regular rules. ;$B$7$J$$(B: OK (deftest $B$J$$(B () ($B$"$k(B $B$J$$$k(B $B$J$&(B)) ;$B$J$$(B: OK ;;; $B$:(B negatives (deftest $BGc$o$:(B () ($BGc$&(B)) ;$BGc$o$:(B: OK (deftest $BCV$+$:(B () ($BCV$/(B)) ;$BCV$+$:(B: OK (deftest $B1K$,$:(B () ($B1K$0(B)) ;$B1K$,$:(B: OK (deftest $BOC$5$:(B () ($BOC$9(B)) ;$BOC$5$:(B: OK (deftest $BBT$?$:(B () ($BBT$D(B)) ;$BBT$?$:(B: OK (deftest $B;`$J$:(B () ($B;`$L(B)) ;$B;`$J$:(B: OK (deftest $BFI$^$:(B () ($BFI$`(B)) ;$BFI$^$:(B: OK (deftest $B8F$P$:(B () ($B8F$V(B)) ;$B8F$P$:(B: OK (deftest $B8+$:(B () ($B8+$k(B)) ;$B8+$:(B: OK ;;; Irregulars (deftest $BMh$:(B () ($BMh$k(B)) ;$BMh$:(B: OK (deftest $B$;$:(B () ($B$9$k(B $B$;$k(B)) ;$B$;$k(B because of regular rules. ;$B$;$:(B: OK ;;; Plain command form (deftest $BGc$((B () ($BGc$&(B $BGc$($k(B)) (deftest $BCV$1(B () ($BCV$/(B $BCV$1$k(B)) ;$BCV$1(B: OK (deftest $B1K$2(B () ($B1K$0(B $B1K$2$k(B)) (deftest $BOC$;(B () ($BOC$9(B $BOC$;$k(B)) (deftest $BBT$F(B () ($BBT$D(B $BBT$F(B $BBT$k(B $BBT$F$k(B)) ;$BBT$F(B: OK (deftest $B;`$M(B () ($B;`$L(B $B;`$M$k(B)) (deftest $BFI$a(B () ($BFI$`(B $BFI$a$k(B)) (deftest $B8F$Y(B () ($B8F$V(B $B8F$Y$k(B)) (deftest $B8+$m(B () ($B8+$k(B)) ;;; Irregulars (deftest $BMh$$(B () ($BMh$k(B $BMh$$$k(B $BMh$&(B)) ;$BMh$$(B: OK (deftest $B$3$$(B () ($B$/$k(B $B$3$$$k(B $B$3$&(B)) ;$B$3$$(B: OK (deftest $B$7$m(B () ($B$9$k(B $B$7$k(B)) ;$B$7$k(B because of regular rules. ;;; The plain desideratives (deftest $BGc$$$?$$(B () ($BGc$&(B $BGc$$$k(B $BGc$$$?$$$k(B $BGc$$$?$&(B)) ;$BGc$$$?$$(B: OK (deftest $BCV$-$?$$(B () ($BCV$/(B $BCV$-$k(B $BCV$-$?$$$k(B $BCV$-$?$&(B)) ;$BCV$-$?$$(B: OK (deftest $B1K$.$?$$(B () ($B1K$0(B $B1K$.$k(B $B1K$.$?$$$k(B $B1K$.$?$&(B)) ;$B1K$.$?$$(B: OK (deftest $BOC$7$?$$(B () ($BOC$9(B $BOC$7$k(B $BOC$7$?$$$k(B $BOC$7$?$&(B)) ;$BOC$7$?$$(B: OK (deftest $B;}$A$?$$(B () ($B;}$D(B $B;}$A$k(B $B;}$A$?$$$k(B $B;}$A$?$&(B)) ;$B;}$A$?$$(B: OK (deftest $B;`$K$?$$(B () ($B;`$L(B $B;`$K$k(B $B;`$K$?$$$k(B $B;`$K$?$&(B)) ;$B;`$K$?$$(B: OK (deftest $B8F$S$?$$(B () ($B8F$V(B $B8F$S$k(B $B8F$S$?$$$k(B $B8F$S$?$&(B)) ;$B8F$S$?$$(B: OK (deftest $BFI$_$?$$(B () ($BFI$`(B $BFI$_$k(B $BFI$_$?$$$k(B $BFI$_$?$&(B)) ;$BFI$_$?$$(B: OK (deftest $BJ,$+$j$?$$(B () ($BJ,$+$k(B $BJ,$+$j$k(B $BJ,$+$j$?$$$k(B $BJ,$+$j$?$&(B)) ;$BJ,$+$j$?$$(B: OK (deftest $B@.$j$?$$(B () ($B@.$k(B $B@.$j$k(B $B@.$j$?$$$k(B $B@.$j$?$&(B)) ;$B@.$j$?$$(B: OK (deftest $B@8$-$?$$(B () ($B@8$-$k(B $B@8$/(B $B@8$-$?$$$k(B $B@8$-$?$&(B)) ;$B@8$-$?$$(B: OK (deftest $B8+$?$$(B () ($B8+$k(B $B8+$?$$$k(B $B8+$?$&(B)) ;$B8+$?$$(B: OK ;;; Irregulars (deftest $BMh$?$$(B () ($BMh$k(B $BMh$?$$$k(B $BMh$?$&(B)) ;$BMh$?$$(B: OK (deftest $B$-$?$$(B () ($B$/$k(B $B$-$k(B $B$-$?$$$k(B $B$-$?$&(B)) ;$B$-$?$$(B: OK (deftest $B$7$?$$(B () ($B$9$k(B $B$7$k(B $B$7$?$$$k(B $B$7$?$&(B)) ;$B$7$?$$(B: OK (deftest $BGc$$$?$,$k(B () ($BGc$&(B $BGc$$$k(B)) (deftest $BCV$-$?$,$k(B () ($BCV$/(B $BCV$$(B $BCV$-$k(B)) (deftest $B1K$.$?$,$k(B () ($B1K$0(B $B1K$.$k(B)) (deftest $BOC$7$?$,$k(B () ($BOC$9(B $BOC$7$k(B)) (deftest $B;}$A$?$,$k(B () ($B;}$D(B $B;}$A$k(B)) (deftest $B;`$K$?$,$k(B () ($B;`$L(B $B;`$K$k(B)) (deftest $B8F$S$?$,$k(B () ($B8F$V(B $B8F$S$k(B)) (deftest $BFI$_$?$,$k(B () ($BFI$`(B $BFI$_$k(B)) (deftest $BJ,$+$j$?$,$k(B () ($BJ,$+$k(B $BJ,$+$j$k(B)) (deftest $B@.$j$?$,$k(B () ($B@.$k(B $B@.$j$k(B)) (deftest $B@8$-$?$,$k(B () ($B@8$-$k(B $B@8$/(B $B@8$$(B)) ; Could be an adverb or adjective. (deftest $B8+$?$,$k(B () ($B8+$k(B)) ;;; Irregulars (deftest $BMh$?$,$k(B () ($BMh$k(B)) (deftest $B$-$?$,$k(B () ($B$/$k(B $B$-$k(B)) (deftest $B$7$?$,$k(B () ($B$9$k(B $B$7$k(B)) ;;; Here's a compound test. (deftest $B9T$-$?$,$C$F$$$^$9(B () ($B9T$/(B $B9T$-$?$,$C$F(B $B9T$-$?$,$k(B $B9T$-$?$,$&(B $B9T$-$?$,$D(B $B9T$-$?$,$C$D(B $B9T$-$?$,$C$F$$$k(B $B9T$-$?$,$C$F$&(B $B9T$$(B $B9T$-$k(B)) ;$B9T$-$?$,$C$F$$$^$9(B: OK (deftest $BFI$s$G$$$k(B () ($BFI$s$G(B $BFI$`(B $BFI$L(B $BFI$V(B)) ;$BFI$s$G$$$k(B: OK (deftest $BGc$C$F$$$k(B () ($BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B)) ;$BGc$C$F$$$k(B: OK (deftest $BFI$s$G$$$?(B () ($BFI$s$G(B $BFI$`(B $BFI$L(B $BFI$V(B $BFI$s$G$$$k(B $BFI$s$G$/(B)) ;$BFI$s$G$$$?(B: OK (deftest $BGc$C$F$$$?(B () ($BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B $BGc$C$F$$$k(B $BGc$C$F$/(B)) ;$BGc$C$F$$$?(B: OK (deftest $BFI$s$G$$$^$9(B () ($BFI$s$G(B $BFI$`(B $BFI$L(B $BFI$V(B $BFI$s$G$$$k(B $BFI$s$G$&(B)) ;$BFI$s$G$$$^$9(B: OK (deftest $BGc$C$F$$$^$9(B () ($BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B $BGc$C$F$$$k(B $BGc$C$F$&(B)) ;$BGc$C$F$$$^$9(B: OK (deftest $BFI$s$G$"$k(B () ($BFI$s$G(B $BFI$`(B $BFI$L(B $BFI$V(B)) ;$BFI$s$G$"$k(B: OK (deftest $BGc$C$F$"$k(B () ($BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B)) ;$BGc$C$F$"$k(B: OK (deftest $BFI$s$G$*$/(B () ($BFI$s$G(B $BFI$`(B $BFI$L(B $BFI$V(B $BFI$s$G$*$$(B)) ;$BFI$s$G$*$/(B: OK (deftest $BGc$C$F$*$/(B () ($BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B $BGc$C$F$*$$(B)) ;$BGc$C$F$*$/(B: OK (deftest $BFI$s$G$_$k(B () ($BFI$s$G(B $BFI$`(B $BFI$L(B $BFI$V(B)) ;$BFI$s$G$_$k(B: OK (deftest $BGc$C$F$_$k(B () ($BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B)) ;$BGc$C$F$_$k(B: OK (deftest $BFI$s$G$7$^$&(B () ($BFI$s$G(B $BFI$`(B $BFI$L(B $BFI$V(B)) ;$BFI$s$G$7$^$&(B: OK (deftest $BGc$C$F$7$^$&(B () ($BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B)) ;$BGc$C$F$7$^$&(B: OK (deftest $BFI$s$G$/$@$5$$(B () ($BFI$s$G(B $BFI$`(B $BFI$L(B $BFI$V(B $BFI$s$G$/$@$5$$$k(B $BFI$s$G$/$@$5$&(B)) ;$BFI$s$G$/$@$5$$(B: OK (deftest $BGc$C$F$/$@$5$$(B () ($BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B $BGc$C$F$/$@$5$$$k(B $BGc$C$F$/$@$5$&(B)) ;$BGc$C$F$/$@$5$$(B: OK (deftest $BFI$s$G2<$5$$(B () ($BFI$s$G(B $BFI$`(B $BFI$L(B $BFI$V(B $BFI$s$G2<$5$$$k(B $BFI$s$G2<$5$&(B)) ;$BFI$s$G2<$5$$(B: OK (deftest $BGc$C$F2<$5$$(B () ($BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B $BGc$C$F2<$5$$$k(B $BGc$C$F2<$5$&(B)) ;$BGc$C$F2<$5$$(B: OK (deftest $BFI$s$G$J$5$$(B () ($BFI$s$G(B $BFI$`(B $BFI$L(B $BFI$V(B $BFI$s$G$J$5$$$k(B $BFI$s$G$J$5$&(B)) ;$BFI$s$G$J$5$$(B: OK (deftest $BGc$C$F$J$5$$(B () ($BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B $BGc$C$F$J$5$$$k(B $BGc$C$F$J$5$&(B)) ;$BGc$C$F$J$5$$(B: OK (deftest $BFI$s$G$$$/(B () ($BFI$s$G(B $BFI$`(B $BFI$L(B $BFI$V(B $BFI$s$G$$$$(B)) ;$BFI$s$G$$$/(B: OK (deftest $BGc$C$F$$$/(B () ($BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B $BGc$C$F$$$$(B)) ;$BGc$C$F$$$/(B: OK (deftest $BFI$s$G$/$k(B () ($BFI$s$G(B $BFI$`(B $BFI$L(B $BFI$V(B)) ;$BFI$s$G$/$k(B: OK (deftest $BGc$C$F$/$k(B () ($BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B)) ;$BGc$C$F$/$k(B: OK (deftest $BFI$s$G$"$2$k(B () ($BFI$s$G(B $BFI$`(B $BFI$L(B $BFI$V(B $BFI$s$G$"$0(B)) ;$BFI$s$G$"$2$k(B: OK (deftest $BGc$C$F$"$2$k(B () ($BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B $BGc$C$F$"$0(B)) ;$BGc$C$F$"$2$k(B: OK (deftest $BFI$s$G$d$k(B () ($BFI$s$G(B $BFI$`(B $BFI$L(B $BFI$V(B)) ;$BFI$s$G$d$k(B: OK (deftest $BGc$C$F$d$k(B () ($BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B)) ;$BGc$C$F$d$k(B: OK (deftest $BFI$s$G$b$i$&(B () ($BFI$s$G(B $BFI$`(B $BFI$L(B $BFI$V(B)) ;$BFI$s$G$b$i$&(B: OK (deftest $BGc$C$F$b$i$&(B () ($BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B)) ;$BGc$C$F$b$i$&(B: OK (deftest $BFI$s$G$$$?$@$/(B () ($BFI$s$G(B $BFI$`(B $BFI$L(B $BFI$V(B $BFI$s$G$$$?$@$$(B)) ;$BFI$s$G$$$?$@$/(B: OK (deftest $BGc$C$F$$$?$@$/(B () ($BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B $BGc$C$F$$$?$@$$(B)) ;$BGc$C$F$$$?$@$/(B: OK (deftest $BFI$s$G$/$l$k(B () ($BFI$s$G(B $BFI$`(B $BFI$L(B $BFI$V(B $BFI$s$G$/$k(B)) ;$BFI$s$G$/$l$k(B: OK (deftest $BGc$C$F$/$l$k(B () ($BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B $BGc$C$F$/$k(B)) ;$BGc$C$F$/$l$k(B: OK (deftest $BFI$s$G$$$?$@$-$^$9(B () ($BFI$s$G(B $BFI$`(B $BFI$L(B $BFI$V(B $BFI$s$G$$$?$@$/(B $BFI$s$G$$$?$@$-$k(B)) ;$BFI$s$G$$$?$@$-$^$9(B: OK (deftest $BGc$C$F$$$?$@$-$^$9(B () ($BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B $BGc$C$F$$$?$@$/(B $BGc$C$F$$$?$@$-$k(B)) ;$BGc$C$F$$$?$@$-$^$9(B: OK (deftest $BGc$C$FD:$-$^$9(B () ($BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B $BGc$C$FD:$/(B $BGc$C$FD:$-$k(B)) ;$BGc$C$FD:$-$^$9(B: OK (deftest $BFI$s$G$/$@$5$$(B () ($BFI$s$G(B $BFI$`(B $BFI$L(B $BFI$V(B $BFI$s$G$/$@$5$&(B $BFI$s$G$/$@$5$$$k(B)) ;$BFI$s$G$/$@$5$$(B: OK (deftest $BGc$C$F$/$@$5$$(B () ($BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B $BGc$C$F$/$@$5$&(B $BGc$C$F$/$@$5$$$k(B)) ;$BGc$C$F$/$@$5$$(B: OK (deftest $BFI$s$G>e$2$k(B () ($BFI$s$G(B $BFI$`(B $BFI$L(B $BFI$V(B $BFI$s$G>e$0(B)) ;$BFI$s$G>e$2$k(B: OK (deftest $BGc$C$F$"$2$k(B () ($BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B $BGc$C$F$"$0(B)) ;$BGc$C$F$"$2$k(B: OK (deftest $BFI$s$G:9$7>e$2$k(B () ($BFI$s$G(B $BFI$`(B $BFI$L(B $BFI$V(B $BFI$s$G:9$7>e$0(B)) ;$BFI$s$G:9$7>e$2$k(B: OK (deftest $BGc$C$F:9$7>e$2$k(B () ($BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B $BGc$C$F:9$7>e$0(B)) ;$BGc$C$F:9$7>e$2$k(B: OK (deftest $BGc$C$F:9$7$"$2$k(B () ($BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B $BGc$C$F:9$7$"$0(B)) ;$BGc$C$F:9$7$"$2$k(B: OK (deftest $BGc$C$F$5$7$"$2$k(B () ($BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B $BGc$C$F$5$7$"$0(B)) ;$BGc$C$F$5$7$"$2$k(B: OK (deftest $BGc$C$F$5$7>e$2$k(B () ($BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B $BGc$C$F$5$7>e$0(B)) ;$BGc$C$F$5$7>e$2$k(B: OK (deftest $BFI$`$i$7$$(B () ($BFI$`(B $BFI$`$i$7$&(B $BFI$`$i$7$$$k(B)) ;$BFI$`$i$7$$(B: OK (deftest $BFI$`$=$&(B () ($BFI$`(B $BFI$`$9(B)) ;$BFI$`$=$&(B: OK (deftest $BFI$`$h$&(B () ($BFI$`(B)) ;$BFI$`$h$&(B: OK (deftest $BFI$`$h$&$@(B () ($BFI$`(B $BFI$`$h$&(B)) ;$BFI$`$h$&$@(B: OK (deftest $BGc$*$&(B () ($BGc$&(B)) ;$BGc$*$&(B: OK (deftest $BCV$3$&(B () ($BCV$/(B)) ;$BCV$3$&(B: OK (deftest $B1K$4$&(B () ($B1K$0(B)) ;$B1K$4$&(B: OK (deftest $BOC$=$&(B () ($BOC$9(B)) ;$BOC$=$&(B: OK (deftest $BBT$H$&(B () ($BBT$D(B)) ;$BBT$H$&(B: OK (deftest $B;`$N$&(B () ($B;`$L(B)) ;$B;`$N$&(B: OK (deftest $BFI$b$&(B () ($BFI$`(B)) ;$BFI$b$&(B: OK (deftest $B8F$\$&(B () ($B8F$V(B)) ;$B8F$\$&(B: OK (deftest $B8+$h$&(B () ($B8+$k(B)) ;$B8+$h$&(B: OK ;;; Irregulars (deftest $BMh$h$&(B () ($BMh$k(B)) ;$BMh$h$&(B: OK (deftest $B$3$h$&(B () ($B$/$k(B)) ;$B$3$h$&(B: OK (deftest $B$7$h$&(B () ($B$9$k(B $B$7$k(B)) ;$B$7$k(B due to the regular rules. ;$B$7$h$&(B: OK (deftest $BFI$s$A$c$&(B () ($BFI$s$G$7$^$&(B $BFI$s$G(B $BFI$`(B $BFI$L(B $BFI$V(B)) ;$BFI$s$A$c$&(B: OK (deftest $BGc$C$A$c$&(B () ($BGc$C$F$7$^$&(B $BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B)) ;$BGc$C$A$c$&(B: OK (deftest $BFI$s$A$c$C$?(B () ($BFI$s$G$7$^$&(B $BFI$s$G(B $BFI$`(B $BFI$L(B $BFI$V(B $BFI$s$A$c$&(B $BFI$s$A$c$k(B $BFI$s$A$c$D(B)) ;$BFI$s$A$c$C$?(B: OK (deftest $BGc$C$A$c$C$?(B () ($BGc$C$F$7$^$&(B $BGc$C$F(B $BGc$&(B $BGc$C$D(B $BGc$D(B $BGc$k(B $BGc$C$A$c$&(B $BGc$C$A$c$k(B $BGc$C$A$c$D(B)) ;$BGc$C$A$c$C$?(B: OK (deftest $B:o=|$9$k(B () ($B:o=|(B)) ;$B:o=|$9$k(B: OK ;;; Honorific prefixes (deftest $B$*?e(B () ($B?e(B)) ;$B$*?e(B: OK (deftest $B$4HS(B () ($BHS(B)) ;$B$4HS(B: OK (deftest $B8fHS(B () ($BHS(B)) ;$B8fHS(B: OK ;;; Adjectives (deftest $B?7$7$/(B () ($B?7$7$$(B)) ;$B?7$7$/(B: OK (deftest $B?7$7$/$F(B () ($B?7$7$$(B $B?7$7$/$D(B $B?7$7$/$F$k(B)) ;$B?7$7$/$F(B: OK (deftest $B?7$7$+$C$?(B () ($B?7$7$$(B $B?7$7$+$&(B $B?7$7$+$D(B $B?7$7$+$k(B)) ;$B?7$7$+$C$?(B: OK (deftest $B855$$G$O$"$j$^$;$s(B () ($B855$(B $B855$$G$O$"$k(B $B855$$G$O$"$j$k(B $B855$$@(B $B855$$G$9(B)) ;$B855$$G$O$"$j$^$;$s(B: OK (deftest $B855$$G$O$J$$(B () ($B855$(B $B855$$G$O$J$$$k(B $B855$$G$O$J$&(B $B855$$@(B)) ;$B855$$G$O$J$$(B: OK (deftest $B855$$8$c$"$j$^$;$s(B () ($B855$(B $B855$$8$c$"$k(B $B855$$8$c$"$j$k(B $B855$$@(B $B855$$G$9(B)) ;$B855$$8$c$"$j$^$;$s(B: OK (deftest $B855$$8$c$J$$(B () ($B855$(B $B855$$8$c$J$$$k(B $B855$$8$c$J$&(B $B855$$@(B)) ;$B855$$8$c$J$$(B: OK (deftest $B?7$7$/$J$/$F(B () ($B?7$7$$(B $B?7$7$/$J$$(B $B?7$7$/$J$/$D(B $B?7$7$/$J$/$F$k(B)) ;$B?7$7$/$J$/$F(B: OK (deftest $B?7$7$1$l$P(B () ($B?7$7$$(B $B?7$7$/(B $B?7$7$1$k(B)) ;$B?7$7$1$l$P(B: OK (deftest $B?7$7$/$J$$(B () ($B?7$7$$(B $B?7$7$/$J$&(B $B?7$7$/$J$$$k(B)) ;$B?7$7$/$J$$(B: OK (deftest $BJY6/Cf(B () ($BJY6/(B)) ;$BJY6/Cf(B: OK (deftest $B7k:'<0(B () ($B7k:'(B)) ;$B7k:'<0(B: OK (deftest $BK:$l$b$N(B () ($BK:$l(B $BK:$l$k(B $BK:$k(B)) ;$BK:$l$b$N(B: OK (deftest $BK:$lJ*(B () ($BK:$l(B $BK:$l$k(B $BK:$k(B)) ;$BK:$lJ*(B: OK (deftest $BN99T |$B$3$l$G(Bxinfo$B$GF|K\8l$,I=<($G$-$^$9!%(BEmacs$B$N(Binfo$B$O;H$$$:$i$+$C$?$N$G!$(B ;; > |xinfo$B$NB8:_$O$H$F$b$"$j$,$?$$$H;W$$$^$9!%(B ;; ;; $B!V;H$$$:$i$+$C$?!W$H$O2?$G$9$+!#(B ;; $B"*!V;H$$$:!W$O!"!V;H$o$:!W$G$9$+!#(B ;; $B"*!V;H$o$J$+$C$?$i!W$G$9$+!#(B ;; $B$G$O!"!V;H$$$:!W$H!V$i$+$C$?!W$H!V$:$i!W$r(Bedict $B$,$o$+$i$J$C$?!#(B ;; $B;d$N@h@8$K?R$M$h$&!#(B (deftest $B>/$J$+$i$:(B () ($B>/$J$$(B $B>/$J$+$k(B $B>/$k(B)) ;$B>/$J$+$i$:(B: OK ;;; Test the various titles. (deftest $Ba15H.Bt$/$s(B () ($B>.Bt(B)) ;$B>.Bt$/$s(B: OK (deftest $B@1LnMM(B () ($B@1Ln(B)) ;$B@1LnMM(B: OK (deftest $B8E:d$5$^(B () ($B8E:d(B)) ;$B8E:d$5$^(B: OK ;;; Test the various number cases. (deftest $BFs?M(B () ($B0l?M(B $B?M(B)) ;$BFs?M(B: OK (deftest 17$B?M(B () ($B0l?M(B $B?M(B)) ;17$B?M(B: OK (deftest $B#1#7?M(B () ($B0l?M(B $B?M(B)) ;$B#1#7?M(B: OK ;;; This one caused infinite recursion, due to a hole in the ;;; redundant-expansion checking (things didn't get checked for redundancy ;;; quite soon enough, so short cycles weren't detected). (deftest $B=P$F(B () ($B=P$k(B $B=P$F$k(B $B=P$D(B)) ;$B=P$F(B: OK ;;; This one caused infinite recursion, due to failure to root certain ;;; patterns. I've since added checks on the patterns to enforce rootedness. (deftest $BDL$8$k(B () ()) ;$BDL$8$k(B: OK (deftest $B#2 ;; Keywords: mule, edict, dictionary ;; Version: 0.9.8 ;; Adapted-by: Stephen J. Turnbull for XEmacs ;; Maintainer: Stephen J. Turnbull ;; This file is part of XEmacs. ;; XEmacs is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your ;; option) any later version. ;; XEmacs is distributed in the hope that it will be useful, but ;; WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with XEmacs; if not, write to the Free Software Foundation, ;; Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Some code that looks for translations of english and japanese using the ;; EDICTJ Public Domain japanese/english dictionary. ;; Written by Per Hammarlund ;; Morphology and private dictionary handling/editing by Bob Kerns ;; ;; Helpful remarks from Ken-Ichi Handa . ;; The EDICTJ PD dictionary is maintained by Jim Breen ;; ;; Short getting started guide, this assumes that you have not used ;; the install script and that you understand the "technical" words ;; used, if you don't, please read the documentation in edict.doc: ;; 1. Make sure that you have placed edict.el in a directory that is ;; included in the nemacs's search path, look at the variable ;; "load-path" to make sure that the directory is in that list. ;; 2. Add something like this to your .emacs (or .nemacs) file: ;; (autoload 'edict-search-english "edict" ;; "Search for a translation of an English word") ;; (global-set-key "\e*" 'edict-search-english) ;; (autoload 'edict-search-kanji "edict" ;; "Search for a translation of a Kanji sequence") ;; (global-set-key "\e_" 'edict-search-kanji) ;; (autoload 'edict-insert "edict" "Insert the last translation") ;; (global-set-key "\e+" 'edict-insert) ;; Note that you can change the key binding to whatever you like, ;; these are only "examples". ;; 3. The variable *edict-files* should be a list of filenames of ;; edict dictionary files that you want edict to load and search ;; in. The real dictionary EDICTJ should be one of these files, ;; you may also have have some local file(s) there. Something ;; like this *may* be appropriate to: ;; (setq *edict-files* '("edictj" ;; "~my-friend-the-user/.edict" ;; "~my-other-friend-the-user/.edict")) ;; By default, it searches the load path (the same directories that ;; are searched when you do m-X load-fileedict), ;; for a file named "edictj". ;; 4. Set the name of your *own* local edictj file. (Note that this ;; file should not be included in the list above!) Edict will ;; include the additions that you do in this file. The variable ;; *edict-private-file* defaults to "~/.edict", if you want ;; something else do a: ;; (setq *edict-private-file* "~/somewhere/somethingelse/") ;; (Don't forget to submit your useful words to Jim Breen once in a ;; while! His address is jwb@monu6.cc.monash.edu.au) ;; You are done. Report errors and comments to perham@nada.kth.se. ;;; To do: ;; See the file TODO ;; Testing ;; edict.el commands ;; global-map ; dui-invoke-search-method "\C-c $ s" ;; via "\C-u\C-c$" ; ispell-word (external) ; edict-search-english ; edict-search-kanji ; edict-insert ; ;; edict-edit-mode-map ; edict-standin default ; edict-exit "\C-c \C-c", "\C-x \C-s" ; edict-tab "\t" ; edict-new-entry "\r" ; edict-beginning-of-line "\C-a" ; edict-end-of-line "\C-e" ; edict-open-bracket "[" ; edict-close-bracket "]" ; edict-slash "/" ;; not bound ; edict-version ; edict-force-init ; edict-insert ; edict-insert-english ; edict-insert-$BF|K\8l(B ; edict-delete-matches-window ; edict-edit-mode ; edict-add-word ; edict-add-english ; edict-add-kanji ;; not fully implemented ; edict-decircularize-rules ; edict-circularize-rules ;;; History: ;; ;; A full ChangeLog is provided as a separate file. ;; ;; 0.9.8 FSF and XEmacs-21 compatibility release ;; 0.9.7 XEmacs-beta beta release ;; 0.9.6-sjt-0.1 Modifications provided by Steven Baur and Olivier ;; Galibert to get it to compile; the character ;; categories for Japanese are not implemented in XEmacs ;; so they are emulated via ranges in variables. ;; Some lisp-mnt.el compatiblity. ;; Changes in spacing, typos, etc, but not major ;; formatting. ;; Change format to comply with lisp-mnt.el ;; 0.9.6 See ChangeLog.096 for history to this point. ;;; Code: ;; Require standard XEmacs packages. (require 'cl) ;; Require edict support files (require 'dui) ; method registry and history (require 'edict-edit) ; edict-add-$language functions (require 'edict-morphology) ;;; Variables: (defvar edict-version-date "980524 [$BJ?@.(B10$BG/(B5$B7n(B24$BF|(B($BLZ(B)]" "The variable edict-version-date contains a string with the date when this version was released. In both Swedish and Japanese standards.") (defvar edict-version "0.9.8" "The variable edict-version contains a string that describes what version of the edict software that you are running.") (defvar edict-default-coding-system 'euc-jp "Default coding system for reading dictionary files. On Unix systems, EDICT is distributed as an EUC file. For Windows systems 'shift_jis is may be preferable.") (defvar edict-user-dictionary "~/.edict" "*This is the edict dictionary where the user's entries will be added. May be a string (filename), or a cons of a filename and a symbol (coding system). Will be searched first in dictionary lookup.") ;; Search paths and how to create them vary by Emacs version. ;; This is really ugly. (defvar edict-dictionary-path (let (path) (cond ;; XEmacs 21 ((and (fboundp 'locate-data-directory) (setq path (cond ((locate-data-directory "edict")) ((locate-data-directory "")))))) ;; the FSF's Emacs and XEmacs 20 (t (dolist (dir ;; Use data-directory and package-path (cons data-directory ;; early betas of XEmacs 21 and betas of XEmacs 20.3 ;; and 20.4 used package-path; "undocumented ;; feature" in 20.3 and 20.4 releases (mapcar ;; nil components of package-path stay nil (lambda (dir) (if dir ;; don't add package roots (concat dir "etc/"))) (reverse (if (boundp 'package-path) package-path)))) path) (if (and dir ; drop nil components of package-path (eq (car (file-attributes dir)) t)) (progn (setq path (cons dir path)) (let ((file (expand-file-name "edict" dir))) (if (eq (car (file-attributes file)) t) (setq path (cons file path))))))))) (cond ((stringp path) (list path)) ((null path) (message "Couldn't compute default for `edict-dictionary-path'!") nil) ((listp path) path) (t (message "Error in computing default for `edict-dictionary-path'!")))) "Search path for edict dictionaries. The default value is the edict subdirectory of the package data-directory, or if that is missing the package data-directory. Computed using `locate-data-directory' if available, or `package-path' (if available) and `data-directory'. Will not find `//etc'-style data directories.") (defvar edict-dictionaries '("edict") "*List of edict dictionary specifications. A dictionary specification is either a string (file name), or a cons of a file name and a symbol (coding system). Relative paths are searched for in each directory in edict-dictionary-path. All dictionaries found are loaded into edict-buffer for searching. Usually at least one of them should be the main edict file. Use `edict-user-dictionary' to specify your private dictionary, not this variable. The auxiliary dictionaries enamdict (proper names) and kanjidic (kanji database) may be used. The up-to-date versions of these dictionaries are all available from ftp://ftp.monash.edu.au/pub/nihongo. A very small sample dictionary, edictj.demo, is provided with this package.") (defvar edict-buffer nil "The buffer containing the concatenated dictionaries.") (defvar edict-buffer-name "*edict*" "The name of `edict-buffer'.") ;;The edict matches buffer and the name of it (defvar edict-match-buffer-name "*edict matches*") (defvar edict-match-buffer nil) ;; #### is this appropriate? ;;;###autoload (defun edict-version () "The function edict-version simply displays (as a message in the mini-buffer) the version of the edict software that you are running at the moment. The same string is also returned from the function." (interactive) (message (concat "Edict version " edict-version " of " edict-version-date))) ;; Marker so we can find the individual files in the buffer. (defvar *edict-file-begin-marker* "<<<<<<<<<<<<<<<<") (defvar *edict-file-end-marker* ">>>>>>>>>>>>>>>>") ;; This is the set of characters to be ignored in the middle of kanji ;; words being looked up. ;; The $B!:(B below should be $B!{(B, but there seems to be an off-by-one error ;; in the regexp code. ;; #### The comment above about "off-by-one" may be bogus as there are ;; no less than three large circles in ku 1 and 2 of JIS X 0208. ;; #### The logic seems incorrect. It is certainly an error to ignore the ;; kanji and kana repetition marks (ku 1, ten 19-22,25; ## check if ;; these are all!), probably wrong to ignore most punctuation, ;; possibly wrong to ignore parentheses and quotation marks (these ;; should mark word boundaries. ;; #### Probably this should be made conditional on a prefix arg, ;; possibly with a customizable option to reverse the sense of ;; the arg. (defvar *edict-kanji-whitespace* "$B!!(B-$B!:!=(B-$B"`(B \n\t>;!:#?,.\"/@$B(!(B-$B(@(B") ;; This is the set of characters to be ignored in the middle of english ;; words being looked up. ;; #### That comment is misleading, since spaces should indicate word breaks. ;; The $B!:(B below should be $B!{(B, but there seems to be an off-by-one error ;; in the regexp code. ;; #### Maybe it's better to filter for `not-eigo'? Check the code. (defvar *edict-eigo-whitespace* "$B!!(B-$B!:!=(B-$B"`(B \n\t>;!:#?,.\"/@$B(!(B-$B(@(B") ;; #### This possibly is not correct as it will miss hyphenated words. ;; #### Can we just steal from ispell? (defvar *edict-eigo-characters* "[A-Za-z$B#A(B-$B#Z#a(B-$B#z(B]" "These are the characters that eigo is made up of.") ;; #### These errors should be warnings. (defvar *edict-unreadable-error* "Edict file \"%s\": doesn't exist or isn't readable!") ;(defvar *edict-non-existent-error* ; "While loading edict files: \"%s\" doesn't exist!") (defconst edict-bad-dict-spec-cons "In edict-dictionaries: %s - car not string or cdr not coding-system.") (defconst edict-bad-dict-spec "In edict-dictionaries: %s - not string or cons.") (defvar edict-warn-missing-dictionaries-p t "Warn about dictionaries specified in edict-dictionaries but not found.") (defvar edict-missing-dictionaries nil "List of dictionaries not found at initialization.") (defvar edict-unreadable-files nil "List of dictionaries found at initialization but unreadable.") (defun edict-regularize-file-argument (dict-spec) "Return dictionary specification in the form (FILE . CODING-SYSTEM). Argument can be a file name (string) or a cons of a string and a coding system. Check for existence and readability of the file specified by the string component of DICT-SPEC. Return 'nil if not found and readable." (let (filename coding-system) (cond ((stringp dict-spec) (setq filename dict-spec coding-system edict-default-coding-system)) ((consp dict-spec) (if (not (and (stringp (setq filename (car dict-spec))) (coding-system-p (setq coding-system ;; #### no `find-coding-system' in FSF's Emacs (if (fboundp 'find-coding-system) (find-coding-system (cdr dict-spec)) (cdr dict-spec)))))) ;; Just because one spec is in error doesn't mean they ;; all are. Tough. ;; I'm too lazy to be user-friendly here. (error edict-bad-dict-spec-cons dict-spec))) (t (error edict-bad-dict-spec dict-spec))) (catch 'found (dolist (dir edict-dictionary-path nil) (let ((file (expand-file-name filename dir))) (if (file-exists-p file) (if (file-readable-p file) (throw 'found (cons file coding-system)) (setq edict-unreadable-files (concat edict-unreadable-files filename "\n")))))) (setq edict-missing-dictionaries (concat edict-missing-dictionaries filename "\n")) nil))) (defvar edict-dictionaries-loaded nil "List of dictionaries loaded into the edict-buffer.") ;;Reads the edict files (the ones in the list edict-dictionaries) into a buffer ;; called what the string edict-buffer-name is set to. ;; #### I don't understand this function. ; "Read the edict file into a buffer. ;The buffer's name is the value of *edict*. The buffer itself is the ;value of edict-buffer." ;Normally initialization is done lazily, and only once. Use the ;command edict-force-init to reread the edict files. It is possible ;that Mule will incorrectly recognize the coding system in one or more ;dictionary files. Customize the variable `file-coding-system-alist' ;(q.v.). An entry of the form (FILE-REGEXP . CODING-SYS) is needed for ;each troublesome file. For the main dictionary `edict' in EUC-JP ;format fresh from the Monash repository: `(\"^edict$\" . euc-jp)'." (defun edict-init () ;;create a match buffer. (if (not (get-buffer edict-match-buffer-name)) (setq edict-match-buffer (get-buffer-create edict-match-buffer-name))) ;;Check that we have a list, we will check that they are readable below. (if (not (listp edict-dictionaries)) (error "The variable edict-dictionaries should be a list!")) ;;Create and read the edict files. (if (not (get-buffer edict-buffer-name)) (progn (save-window-excursion ;;First create the buffer and make it the current one (setq edict-buffer (get-buffer-create edict-buffer-name)) (set-buffer edict-buffer) ;;Read in the files from the list. (message "Reading the dictionaries. This may take a while...") (mapcar (function (lambda (arg) (let* ((arg (edict-regularize-file-argument arg)) (filename (car arg)) (coding-system (cdr arg))) (edict-add-file filename coding-system)))) (if edict-user-dictionary (cons edict-user-dictionary edict-dictionaries) edict-dictionaries)) ;;If none of the files were readable, puke. (if (null edict-dictionaries-loaded) (progn (kill-buffer edict-buffer) (error "No edict files found! Check value of edict-dictionaries."))) (message "Reading the dictionaries...done.")))) t) ;; ;; ;; ;;;###autoload (defun edict-force-init () "Reread the edict files even if edict-buffer exists. Useful when you have updated the edict-dictionaries variable or corrupted the edict buffer." (interactive) (setq edict-dictionaries-loaded nil) (kill-buffer edict-buffer) (edict-init)) ;; ;; Add file filename to the current buffer with the begin end markers around that file... ;; (defun edict-add-file (filename coding-system) "Add FILENAME to the current buffer using CODING-SYSTEM. *edict-file-begin-marker* and *edict-file-end-marker* are placed around the file contents. If FILENAME is nil, do nothing (cf. edict-regularize-file-argument)." (if (not filename) nil (goto-char (point-max)) (insert (format "%s %s\n" *edict-file-begin-marker* filename)) (let ((pos (point))) (let ((coding-system-for-read coding-system)) (insert-file-contents filename)) (goto-char (point-max)) (insert (format "%s %s\n" *edict-file-end-marker* filename)) (goto-char pos) ;; #### Huh? Unprintable characters in dictionary names? and ;; why not allow Japanese? Ask Jim Breen. (when (looking-at "$B!)!)!)!)(B /\\([ -.0-\177]+\\)/") (message "Loaded dictionary %s." (buffer-substring (match-beginning 1) (match-end 1)))) (goto-char (point-max)) (setq edict-dictionaries-loaded (append edict-dictionaries-loaded (list filename)))))) ;; Remove any leading, trailing, or embedded whitespace or other noise ;; characters (such as the inserted ">" etc. used to denote inserted ;; quotations in mail and news) ;; #### Supercite will hose that last! Can we borrow from filladapt? (defun edict-clean-up-kanji (key) (let ((start 0) (loc 0) (end (length key)) (result "") (pattern (concat "[" *edict-kanji-whitespace* "]+"))) (while (and (< start end) (setq start (string-match pattern key start))) (setq result (concat result (substring key loc start))) (setq loc (setq start (match-end 0)))) (concat result (substring key loc)))) ;; #### Why isn't this a defconst? Why strings and not characters? (defvar *edict-romaji-remaps* nil) (setq *edict-romaji-remaps* '(("$B#a(B" . "a") ("$B#b(B" . "b") ("$B#c(B" . "c") ("$B#d(B" . "d") ("$B#e(B" . "e") ("$B#f(B" . "f") ("$B#g(B" . "g") ("$B#h(B" . "h") ("$B#i(B" . "i") ("$B#j(B" . "j") ("$B#k(B" . "k") ("$B#l(B" . "l") ("$B#m(B" . "m") ("$B#n(B" . "n") ("$B#o(B" . "o") ("$B#p(B" . "p") ("$B#q(B" . "q") ("$B#r(B" . "r") ("$B#s(B" . "s") ("$B#t(B" . "t") ("$B#u(B" . "u") ("$B#v(B" . "v") ("$B#w(B" . "w") ("$B#x(B" . "x") ("$B#y(B" . "y") ("$B#z(B" . "z") ("$B#A(B" . "A") ("$B#B(B" . "B") ("$B#C(B" . "C") ("$B#D(B" . "D") ("$B#E(B" . "E") ("$B#F(B" . "F") ("$B#G(B" . "G") ("$B#H(B" . "H") ("$B#I(B" . "I") ("$B#J(B" . "J") ("$B#K(B" . "K") ("$B#L(B" . "L") ("$B#M(B" . "M") ("$B#N(B" . "N") ("$B#O(B" . "O") ("$B#P(B" . "P") ("$B#Q(B" . "Q") ("$B#R(B" . "R") ("$B#S(B" . "S") ("$B#T(B" . "T") ("$B#U(B" . "U") ("$B#V(B" . "V") ("$B#W(B" . "W") ("$B#X(B" . "X") ("$B#Y(B" . "Y") ("$B#Z(B" . "Z"))) ;; ;; Lookup a mapping for zenkaku roman characters to ASCII. ;; #### Wouldn't this be better done with assoc, if necessary with some ;; type-checking on the args? ;; (defun edict-in-remap-list (item list) "Return first link in LIST whose car is `equal' to ITEM." (let ((ptr list) (done nil) (result '())) (while (not (or done (endp ptr))) (cond ((string= item (car (car ptr))) (setq done t) (setq result ptr))) (setq ptr (cdr ptr))) result)) ;; ;; Remap zenkaku roman characters to ASCII. ;; (defun edict-remap-romaji (eigo-string) (let ((stop (length eigo-string)) (current 0) (match nil) (result "")) (while (< current stop) (if (< (+ 1 current) stop) (setq match (edict-in-remap-list (substring eigo-string current (+ 2 current)) *edict-romaji-remaps*)) (setq match nil)) (if match (progn (setq result (concat result (cdr (car match)))) (setq current (+ 2 current))) (progn (setq result (concat result (substring eigo-string current (1+ current)))) (setq current (1+ current))))) result)) ;; ;; Eliminate extra whitespace, newlines, punctuation, etc. which would ;; interfere with our dictionary lookup. ;; (defun edict-clean-up-eigo (key) (let ((start 0) (loc 0) (end (length key)) (result "") (pattern (concat "[" *edict-eigo-whitespace* "]+"))) (while (and (< start end) (setq start (string-match pattern key start))) (setq result (concat result (substring key loc start) " ")) (setq loc (setq start (match-end 0)))) (setf result (concat result (substring key loc))) (edict-remap-romaji result))) ;; ;; slightly specialized function to be changed when the real backward ;; word things are included. ;; (defun edict-eigo-one-word (direction) "The function edict-eigo-one-word goes one word forward (direction > 0) or backward (direction <= 0). It assumes that it is looking at a word when invoked. It returns the point either at the beginning of a word or at the whitespace after a word." (let ((stop-point (point)) (stop nil)) (if (> direction 0) ;;forward (progn (while (not stop) (setq stop-point (point)) (if (< (point) (point-max)) (if (looking-at *edict-eigo-characters*) (forward-char 1) (setq stop t)) (setq stop t)))) ;;backward (progn (while (not stop) (setq stop-point (point)) (if (> (point) (point-min)) (if (looking-at *edict-eigo-characters*) (backward-char 1) (progn (setq stop t) (forward-char 1) (setq stop-point (point)))) (setq stop t ))))) stop-point)) ;; ;; perham ;; (defun edict-find-word-at-point () "Find an English word close to or behind point. If it does not find any word it reports an error." (let (start end) ;; Move backward for word if not already on one. (if (not (looking-at *edict-eigo-characters*)) (re-search-backward *edict-eigo-characters* (point-min) 'stay)) (if (looking-at *edict-eigo-characters*) (progn (setq start (edict-eigo-one-word -1)) (setq end (edict-eigo-one-word 1)) (edict-clean-up-eigo (buffer-substring start end))) (error "Can't find English word!") ))) ;; ;; ;; ;;;###autoload (defun edict-search-english (arg) "Attempts to translate the english word we are looking at. Picks the word in the same way as ispell, ie backs up from whitespace, and then expands. Result is presented in a window that is not selected. Clear the window by using a negative prefix argument. If given an argument, adds an english word to the private dictionary." (interactive "P") (if arg (if (< (prefix-numeric-value arg) 0) (edict-restore-display) (edict-add-english)) (let ((word (edict-get-english-word))) ;;Search if there is a word. (when word (edict-search-and-display word 'english))))) ;; Return the english word, or nil (defun edict-get-english-word () (let (word real-word) ;;Find the word (setq word (edict-find-word-at-point)) ;;ask the user if this is really the word that is interesting. (setq real-word (read-string (format "Translate word (default \"%s\"): " word))) (setq real-word (edict-clean-up-eigo real-word)) (if (equal real-word "") (if (equal word "") nil word) real-word))) ;; ;; ;; ;;;###autoload (defun edict-search-kanji (arg min max) "Attempts to translate the Kanji sequence between mark and point. Result is presented in a window that is not selected. Clear the window with for instance C-X 1 Given a numeric argument, this adds the Kanji sequence to the user's private dictionary. If all searches fail, initialization may be bogus. See the documentation for `edict-init'." ;;Interactive, with a region as argument (interactive "P r") ;;make sure that the dictionary is read (edict-init) (if arg (if (< (prefix-numeric-value arg) 0) (edict-restore-display) (edict-add-kanji min max)) (let ((word (edict-clean-up-kanji (buffer-substring min max)))) (if (equal word "") (error "No word to search for!") (edict-search-and-display word '$BF|K\8l(B)))) t) ;; ;; ;; (defun edict-copy-of-current-line () "Copy-of-current-line creates and returns a copy of the line where point is. It does not affect the buffer it is working on, except for moving the point around. It leaves the point at the end of the line, which is fine for this application." ;;Find the start and end of the current line (let ((line-start (progn (beginning-of-line) (point))) (line-end (progn (end-of-line) (point)))) ;;return a copy of his line, perham, is there something that ;; should be tested here? (buffer-substring line-start line-end))) ;; ;; ;; (defun edict-search (key buffer) "Searches the edict-buffer and returns a list of strings that are the matches. If there are no matches this string will be nil." ;;perham, should this really go here? Or what should we have? Look ;;at ispell.el... (save-window-excursion (message (format "Searching for word \"%s\"..." key)) (let ((match-list nil)) ;;select the database and goto to the first char (set-buffer buffer) (goto-char (point-min)) ;;Search for lines that match the key and copy the over to the ;; match buffer. (while (edict-search-key key) (setq match-list (union match-list (list (edict-copy-of-current-line))))) match-list))) (defun edict-search-key (key) (search-forward ;Ken-ichi says that one cannot ;use the re-search-forward ;function with actually having ;some reg exp in the target string. ;(concat "[\[/ ;]" key "[\]/ ]") key nil t)) ;; ;; ;; (defvar *edict-previous-configuration* nil) (defun edict-note-windows () (or *edict-previous-configuration* (setq *edict-previous-configuration* (current-window-configuration)))) ;; This doesn't work yet; leave it set to 'top! (defvar *edict-window-location* 'top "*Location to place edict matches window. top or bottom. Doesn't work yet.") (defun edict-display (key-list match-list) "Edict-display displayes the strings in a separate window that is not selected." (let* ((text-window (get-buffer-window (current-buffer))) (edict-window (get-buffer-window edict-match-buffer)) ;; We have available some of this window's height plus any we've already ;; already gotten. (avail-height (+ (window-height text-window) (if edict-window (window-height edict-window) 0))) ;; We limit the height to half of what's available, but no more than we need, ;; and no less than window-min-height. We must remember to include 1 line for ;; the mode-line in our minimum figure. (height (min (max window-min-height (+ (length match-list) 1)) (/ avail-height 2)))) (if (not edict-window) (progn ;; We don't have a window, so remember our existing configuration, ;; and either find an acceptable window to split, or use the current ;; window. (edict-note-windows) (let ((use-window (edict-find-acceptable-window text-window))) (if use-window (setq edict-window use-window text-window (split-window text-window height)) (setq edict-window text-window)))) ;; We have a window already. Just adjust its size appropriately. (unless (equal height (window-height edict-window)) (let ((selected (selected-window))) (select-window edict-window) (enlarge-window (- height (window-height edict-window))) (select-window selected)))) (set-buffer edict-match-buffer) (let ((min (point-min))) ;; Replace everything. (erase-buffer) (mapcar (function (lambda (string-item) (insert string-item) (newline))) match-list) (when (eq *edict-window-location* 'bottom) (let ((w text-window)) (setq text-window edict-window edict-window w))) ;; OK, now let's move the exact matches to the top. (goto-char min) ;; Be careful to preserve the order. ;; An exact match is any of "^key ", "[key]", "/key/", or "/to key/". (dolist (key (reverse key-list)) (let* ((pattern (concat "^" key " \\|\\[" key "\\]\\|\\/" key "\\/\\|\\/to " key "\\/" )) (top-lines nil)) ;; First pull them out of the buffer into a list (top-lines). ;; Then re-insert them at the top. (while (re-search-forward pattern nil t) (forward-line 0) (let ((p (point))) (forward-line 1) (push (buffer-substring p (point)) top-lines) (delete-region p (point)))) (goto-char min) (mapcar 'insert top-lines))) ;; OK, display it all. (select-window text-window) (set-window-buffer edict-window edict-match-buffer) (set-window-start edict-window min))) t) ;; Find a window which is of acceptable size to split. ;; It must be at least twice window-min-height. (defun edict-find-acceptable-window (window) (catch 'no-window (let ((new-window window)) (while (< (window-height new-window) (* 2 window-min-height)) (setq new-window (next-window new-window)) (when (eq new-window window) (throw 'no-window nil))) new-window))) ;; Try to put the display back the way it was before showing matches. (defun edict-restore-display () "Remove the edict windows." (when *edict-previous-configuration* (set-window-configuration *edict-previous-configuration*)) (setq *edict-previous-configuration* nil) t) ;; Variables to remember the last insertion of a match into our ;; buffer, for later replacement. (defvar edict-last-language nil) (defvar edict-insert-last-start) (defvar edict-insert-last-end) ;; ;; ;; (defun edict-search-and-display (key &optional from-language) "Edict-search-and-display searches for matches to the argument key. If there are any matches these are displayed in a window that is not selected. This window can be removed with C-X 1." (edict-init) ;; Remember the last language looked up, so edict-insert can pick the ;; right one. (setq edict-last-language from-language) (save-excursion (let ((match-list nil) (one-char-keys nil) (key-list (edict-expand-string key () () (or from-language '$BF|K\8l(B)))) ;; Sort them into the order we'd like exact matches to appear. (setq key-list (sort key-list (function (lambda (x y) (let ((lx (length x)) (ly (length y))) (if (= lx ly) (string-lessp x y) (> lx ly))))))) ;; For all the possibilities (dolist (key key-list) ;; Search for matches. We exlude any one-character keys on ;; the theory that they're likely to be uninteresting ;; fragments. ;; #### This is a strange way to do this test. What ;; are we thinking? (if (string-match "^[$B!"(B-$Bt$(B]$" key) ;1 char (push key one-char-keys) (setq match-list (union match-list (edict-search key edict-buffer))))) ;; If we didn't get anything, we can try including the one-char keys. (or match-list (dolist (key one-char-keys) (setq match-list (union match-list (edict-search key edict-buffer))))) ;; #### I don't understand the logic of this whole function. (if (not match-list) (progn (edict-delete-matches-window) ;; This probably didn't need to be an error.... (message "No matches for key \"%s\"." key)) (edict-display key-list match-list) (message "Found it!"))))) (defun edict-insert (arg) "Insert the last value looked up at the current position. If repeated, replace with the next possibility. If given an argument N, use the Nth possibility. Inserts in the opposite language from what was looked up, unless the argument is negative." (interactive "P") ;; If we were given a negative argument, we need to switch languages. (cond ((null arg)) ((> (prefix-numeric-value arg) 0)) (t (case arg (- (setq arg nil)) (otherwise (setq arg (list (- (prefix-numeric-value arg)))))) (setq edict-last-language (ecase edict-last-language (english '$BF|K\8l(B) ($BF|K\8l(B 'english))))) (ecase edict-last-language (english (edict-insert-$BF|K\8l(B arg)) ($BF|K\8l(B (edict-insert-english arg)))) (defun edict-insert-english (arg) "Insert the last english word looked up at the current position. If repeated, replace with the next possibility. If given an argument N, use the Nth possibility." (interactive "P") (or edict-match-buffer (error "You must first look up a word.")) (let ((value nil)) (save-excursion (set-buffer edict-match-buffer) ;; If we're going to a specific one, always count from the beginning. (when arg (goto-char (point-min))) ;; If the last command was this, then we're going on to the next possibility. ;; Otherwise, start at the beginning. (case last-command (edict-insert-english) (t (goto-char (point-min)))) ;; Seach forward for // If we don't find one, start over from the ;; beginning. (unless (re-search-forward "/\\([^/\n]+\\)/" (point-max) t (prefix-numeric-value arg)) (goto-char (point-min)) (unless (or arg (re-search-forward "/\\([^/\n]+\\)/" (point-max) t)) (error "No match numbered %d found." (prefix-numeric-value arg)))) ;; Extract the match. Leave ourselves just before the final /, ;; so if it starts a new definition, we'll find it. (goto-char (match-end 1)) (setq value (buffer-substring (match-beginning 1) (match-end 1)))) ;; If we inserted one of our languages, then we should delete the old ;; one first. (case last-command ((edict-insert-english edict-insert-$BF|K\8l(B) (delete-region edict-insert-last-start edict-insert-last-end))) ;; Insert, remembering where we did it, so it can be replaced if we ;; repeat the command. (setq edict-insert-last-start (point-marker)) (insert value) (setq edict-insert-last-end (point-marker))) ;; Remember this as the last command, not edict-insert. (setq this-command 'edict-insert-english) t) (defun edict-insert-$BF|K\8l(B (arg) "Insert the last $BF|K\8l(B word looked up at the current position. If repeated, replace with the next possibility. If given an argument N, use the Nth possibility." (interactive "P") (or edict-match-buffer (error "You must first look up a word.")) (let ((value nil)) (save-excursion (set-buffer edict-match-buffer) ;; If we're going to a specific one, always count from the beginning. (when arg (goto-char (point-min))) ;; If the last command was this, then we're going on to the next possibility. ;; Otherwise, start at the beginning. (case last-command (edict-insert-$BF|K\8l(B) (t (goto-char (point-min)))) ;; Seach forward for a word at the start of a line. If we don't find one, ;; start over from the beginning. (unless (re-search-forward edict-dictionary-entry-start-regexp (point-max) t (prefix-numeric-value arg)) (goto-char (point-min)) (unless (or arg (re-search-forward edict-dictionary-entry-start-regexp (point-max) t)) (error "No match numbered %d found." (prefix-numeric-value arg)))) (goto-char (match-end 1)) (setq value (buffer-substring (match-beginning 1) (match-end 1)))) ;; If we inserted one of our languages, then we should delete the old ;; one first. (case last-command ((edict-insert-$BF|K\8l(B edict-insert-english) (delete-region edict-insert-last-start edict-insert-last-end))) ;; Insert, remembering where we did it, so it can be replaced if we ;; repeat the command. (setq edict-insert-last-start (point-marker)) (insert value) (setq edict-insert-last-end (point-marker))) ;; Remember this as the last command, not edict-insert. (setq this-command 'edict-insert-$BF|K\8l(B) t) ;; Remove the matches window from the screen. ;; This is harder than you'd think. ;; (SJT - if you try to be overly intelligent about it....) (defun edict-delete-matches-window () (interactive) (let ((window (get-buffer-window edict-match-buffer))) (when window ;; SJT: `window-edges' doesn't seem to exist under XEmacs. In ;; any case, I don't particularly see why it makes sense to ;; split the space among several windows. (if (featurep 'xemacs) (delete-window window) ;; #### The following code is _not_ known to work in recent FSF Emacs :-( (let* ((selected (selected-window)) (next (previous-window window)) (height (window-height window)) (nedges (window-edges next)) (tedges (window-edges window))) (delete-window window) ;; The following is sheer magic. Deleting a window is not ;; an inverse to splitting a window. The space is returned ;; not to the window below, OR to the window above, but ;; rather is divided between them. (when (and (equal (car nedges) (car tedges)) (< (car (cdr nedges)) (car (cdr tedges)))) (select-window next) (shrink-window (/ (- height 1) 2)) (select-window selected))))))) ;; #### This can't possibly work, since dictionary loading does not ;; take place at library load time. Move the relevant clauses to ;; `edict-init'. (if (or edict-unreadable-files edict-missing-dictionaries) (with-output-to-temp-buffer "*edict load warnings*" (if edict-unreadable-files (progn (princ "The following files were found but are unreadable. This is probably an error. ") (princ edict-unreadable-files) (setq edict-unreadable-files nil))) (if (and edict-warn-missing-dictionaries-p edict-missing-dictionaries) (progn (princ "The following dictionaries were not found on the search path. ") (princ edict-missing-dictionaries) (setq edict-missing-dictionaries nil))))) ;; Load morphology rewrite engine and grammar rules ;; This can be done a lot more lazily (require 'edict-english) (require 'edict-japanese) (provide 'edict) ;;; edict.el ends here edict-el-1.06.orig/edictj.demo0100644000175000017500000000422006524336052015521 0ustar rolandroland$@!)!)!)!)(J /EDICT DEMO/ $@%0%j!<%s8(J [$@$7$c$7$g$&(J] /conductor/ $@(J [$@$7$c$j$g$&(J] /rolling stock/vehicles/ $@.7?<+F0hhl(J [$@$A$e$&$7$c$8$g$&(J] /parking lot/parking place/ $@Dd ;; Keywords: minor mode ;; Version: 1.0 ;; Created: Sun Apr 5 19:49:36 1998 ;; This file is part of XEmacs. ;; XEmacs is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your ;; option) any later version. ;; XEmacs is distributed in the hope that it will be useful, but ;; WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with XEmacs; if not, write to the Free Software Foundation, ;; Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Insert a timestamp in a buffer, implemented as a minor mode. ;; Written to try out some techniques in the implementation of minor ;; modes, in particular courteous key-binding. ;;; To do: ;; 1. Support Custom. ;;; Changelog: ;; 1998-04-05 Stephen Turnbull ;; tm-mode.el: created ;;; Code (provide 'ts-mode) ;;; User customization variables (defvar ts-mode-prefix '[(control ?c) (?\$)] "Prefix key sequence for ts-mode command keys. After loading, change the mode's prefix by using ts-mode-set-prefix; setq'ing this variable can't work.") ;; A convention for modes; here honored by observance, not breach. (defvar ts-mode-hook nil "If you can think of a use for this, you're more clever than I.") ;; Auxiliary customizations (defvar ts-conflict-warning "Binding conflict: %s -> %s." "Format string warning about key sequences with conflicting bindings. Must contain two `%s' descriptors. The first formats the key sequence, the second the description of the existing binding.") (defvar ts-warn-conflict-verbosity 3 "Controls verbosity of binding conflict warnings. 0 turns off warnings entirely. 1 issues a warning for each binding conflict (including sub-keymaps). 2 prints a summary message with a count of conflicts (not including sub-keymaps, only keys in those maps that have conflicts). 3 adds verbose detail about what is being done. Each positive level performs all actions of lower levels.") ;;; The basic mode conventions. ;; Mode flag and keymaps ;; (defvar ts-mode nil "Activation flag for ts-mode.") (defvar ts-mode-submap nil "Sub-keymap for ts-mode. All key sequences are prefixed by the sequence defined in ts-mode-map.") (defvar ts-mode-map nil "Keymap for ts-mode. Holds the prefix key for ts-mode functions. Its value will be installed into minor-mode-map-alist. Prefix cannot be altered by setq'ing ts-mode-map. Use ts-mode-set-prefix instead.") ;; Mode toggle ;; (defun ts-mode (&optional arg) "Minor mode for inserting time stamps in buffers. An example minor mode. \\{ts-mode-map}" (interactive "P") ;; ts-warn-binding-conflicts doesn't make sense in the mode (if (null ts-mode) (ts-warn-binding-conflicts ts-mode-map)) (setq ts-mode (if (null arg) (not ts-mode) (> (prefix-numeric-value arg) 0))) (run-hooks ts-mode-hook)) ;;; Internal mode data (or ts-mode-submap (progn (setq ts-mode-submap (make-sparse-keymap)) (define-prefix-command 'ts-mode-submap 'ts-mode-submap) (define-key ts-mode-submap ?T 'ts-timestamp) (define-key ts-mode-submap ?s 'ts-timestamp) )) ;;; Helper functions ;; Set the mode prefix ;; ;; This can't be done simply by setq'ing ts-mode-map; minor-mode-map-alist ;; does not refer to that variable but contains a copy of its value. ;; (defun ts-mode-set-prefix (key &optional context) "Set the prefix key sequence for ts-mode to KEY. Return the new ts-mode-map. When called interactively read KEY from the minibuffer (as a string; keys not bound to `self-insert' must be quoted with ^Q). If you need more flexibility than ASCII gives, you'll have to use the `eval-expression' interface. Allowed values of CONTEXT: NIL substitute a map containing KEY in minor-mode-map-alist. adding-minor-mode manipulation of minor-mode-map-alist is done elsewhere." ;; Should read key events but I don't know how to make that work. (interactive "Key sequence (quote control characters with ^Q): ") (setq ts-mode-map (make-sparse-keymap)) (define-key ts-mode-map key 'ts-mode-submap) (cond ((null context) (let ((slot (assq 'ts-mode minor-mode-map-alist))) (setq minor-mode-map-alist (cons (cons 'ts-mode ts-mode-map) (if slot (delete slot minor-mode-map-alist) minor-mode-map-alist))))) ((equal context 'adding-minor-mode)) (t (error "Illegal context `%s' in ts-mode-set-prefix." context))) ts-mode-map) ;; Deal with binding conflicts ;; ;; Search keymaps for binding conflicts for each key in the mode's keymap. ;; Current implementation searches only active keymaps; it won't tell ;; about inactive keymaps, including those of minor modes that might be ;; invoked later or (worse) major modes already invoked in other buffers. ;; (defun ts-warn-binding-conflicts (map) "Warn about key bindings that will conflict with those in MAP. Results will be non-sensical if MAP is invoked via a prefix or is already active. The current implementation only looks in the active keymaps. Maps of inactive minor modes and local maps major modes of other buffers will not be searched (although the latter will be shadowed since ts-mode is a global variable)." (let ((found 0)) (if (> ts-warn-conflict-verbosity 1) (progn (message "Checking for conflicting bindings...") (if (> ts-warn-conflict-verbosity 2) (message "Examining accessible maps of map:\n `%s'" map)))) ;; A map is accessible from itself (mapcar (lambda (slot) (let ((prefix (car slot)) (map (cdr slot))) (if (> ts-warn-conflict-verbosity 2) (message "Examining keys of map:\n `%s'" map)) (map-keymap (lambda (key binding) (let* ((key (vconcat prefix (vector key))) (binding (key-binding key))) (if (and binding (> ts-warn-conflict-verbosity 0)) (progn (if (not (keymapp binding)) (setq found (1+ found))) (message ts-conflict-warning key binding))))) map))) (accessible-keymaps map)) (if (> ts-warn-conflict-verbosity 1) (message "Checking for conflicting bindings...done%s" (if (> found 0) (format ". Found %d." found) "."))))) ;;; Define a trivial command for a trivial example mode. (defun ts-timestamp () "Insert the current time string in the current buffer at point." (interactive) (insert (current-time-string))) ;;; Register the mode with XEmacs (add-minor-mode 'ts-mode " ts" (ts-mode-set-prefix ts-mode-prefix 'adding-minor-mode)) ;;; end of ts-mode.el edict-el-1.06.orig/Makefile.0960100644000175000017500000000245106524336052015372 0ustar rolandroland# # Copyright (c) 1992 Per Hammarlund (perham@nada.kth.se) # # This is a silly makefile to ease the handling of the edict software, # it can do silly things like building a distribution (taring), # cleaning and such. # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 1, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # EMACS-LISP-FILES = edict-test.el edict.el TEXT-FILES = COPYING README edict.ChangeLog edict.doc DEMO-DICT-FILE = edictj.demo INSTALL-FILES = Makefile install.edict DISTRIBUTION-FILES = $(EMACS-LISP-FILES) $(TEXT-FILES) $(DEMO-DICT-FILE) $(INSTALL-FILES) DIST-FILE-NAME = edict.tar distribution: $(DISTRIBUTION-FILES) tar -cvf $(DIST-FILE-NAME) $(DISTRIBUTION-FILES);\ compress $(DIST-FILE-NAME) edict-el-1.06.orig/Makefile.FSF0100644000175000017500000000442406532044453015474 0ustar rolandroland# Makefile.FSF # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by the # Free Software Foundation; either version 2, or (at your option) any # later version. # It is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License # for more details. # You should have received a copy of the GNU General Public License # along with it; see the file COPYING. If not, write to # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA. # Makefile to bytecompile edict.el sources under FSF Emacs and build a # tarball that can be untarred somewhere on the load-path. # The recommended location is .../emacs/site-lisp/edict, and the # default location for the dictionary is there also. AUTHOR_VERSION = 0.9.8 MAINTAINER = Stephen J. Turnbull # edict-autoloads.el is automatically generated using XEmacs. It is # therefore not guaranteed to be 100% up-to-date, but probably is. # It can be loaded from your .emacs. ETC = edict-test.el.096 edict.el.096 edict.doc.096 README.096 \ Makefile.096 install.edict.096 README ChangeLog TODO COPYING EXTRA_SOURCES = edictj.demo ts-mode.el auto-autoloads.el Makefile ELCS = edict.elc dui.elc edict-morphology.elc edict-japanese.elc \ edict-english.elc edict-edit.elc edict-test.elc dui-registry.elc # path to Emacs EMACS = emacs # Emacs without any site or user customizations VANILLA = --no-init-file --no-site-file # path to utilities TAR = tar # nothing below this line should be changed .phony: tar %.elc: %.el $(EMACS) $(VANILLA) -batch \ --eval "(setq load-path (cons \".\" load-path))" \ -f batch-byte-compile $< all:: $(ELCS) clean:: rm -f $(ELCS) mostlyclean: clean extraclean: clean distclean: extraclean rm -f core *~ tar: if [ -e Makefile.FSF ]; then \ mv Makefile Makefile.XEmacs; \ cp Makefile.FSF Makefile; \ fi $(TAR) cvf edict-$(AUTHOR_VERSION)-fsf.tar \ $(ELCS:.elc=.el) $(ETC) $(EXTRA_SOURCES) gzip -9 edict-$(AUTHOR_VERSION)-fsf.tar if [ -e Makefile.XEmacs ]; then mv Makefile.XEmacs Makefile; fi edict-el-1.06.orig/README.0960100644000175000017500000000366306524336052014620 0ustar rolandroland Copyright (C) 1992 Bob Kerns Package contents Copyright (c) 1991, 1992 Per Hammarlund and Copyright (c) 1992 Bob Kerns Some code that looks for translations of english and japanese using the EDICTJ Public Domain japanese/english dictionary. edict.el written by Per Hammarlund Morphology and private dictionary handling/editing by Bob Kerns International installation script by Bob Kerns Helpful remarks from Ken-Ichi Handa . The EDICTJ PD dictionary is maintained by Jim Breen Your credits here if you contribute! This distribution includes the following files. README You should read this file first! (OK, you are...) COPYING The GNU public license. edict.ChangeLog History of changes. edict.el The actual code for the dictionary lookup program. edict-test.el The test suite for the dictionary lookup program. edict.doc The documentation. Read this for usage instructions. install.edict The installation script, internationalized. (Please contribute a language, currently only Japanese, English, and Swedish.) Makefile You won't need this, this is to build distributions. edictj.demo A demo version of the edictj public-domain dictionary. You may use this to try out the software; I suggest using the words 'car' and '車' as a test cases. You should obtain the real dictionary via anonymous ftp from the /pub/Nihongo directory at monu6.cc.monash.edu.au. The installation process, ie running the install script, creates the following additional files: edict.elc Compiled version of edict.el; the actual compiled library code to load. edict.emacs Sample code to include in your .emacs file. To run the installation script, cd to the directory containing this software, and do ./install.edict, and answer the questions. cd /usr/local/src/edict ./install.edict edict-el-1.06.orig/edict-test.el.0960100644000175000017500000011076606524336052016332 0ustar rolandroland;;;;;; Copyright (C) 1992 Bob Kerns ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 1, or (at your option) ;;; any later version. ;;; ;;; This program is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with this program; if not, write to the Free Software ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; ;;; Test suite for morphology rules for edict.el. ;;; To run the tests, load this file, and do m-X edict-perform-tests. ;;; This will create an *EDICT-TESTS* buffer with the results. (require 'cl) ;;; This should exist, but doesn't. See edict.install for the ;;; compiler half of this. You should be sure to load the same ;;; hacks into your compiler if you compile this by hand, or you ;;; won't get it byte compiled. (defmacro eval-when (when &rest forms) (and (or (member 'eval when) (member ':execute when)) (mapcar (function eval) forms)) (and (or (member 'load when) (member ':load-toplevel when)) (cons 'progn forms))) ;;; first, a couple simple tests. (defun edict-test-string (flag string) "Show what strings will be searched for a test string. If given a prefix arg, traces step by step; type Return for each new step." (interactive "P sTest string: ") (let ((*edict-expand-string-trace* flag)) (message (format "%s" (edict-expand-string string))))) (defun edict-test-rule (rule-name string) (interactive "SRule name: sTest string: ") (let ((rule (edict-get-rule rule-name))) (unless rule (error "There is no rule named '%s'" rule-name)) (unless (string-match (edict-rule-pattern rule) string) (error "The rule %s does not match '%s'." rule-name string)) (apply (edict-rule-function rule) string (edict-rule-additional-args rule)))) (eval-when (eval load compile) (defstruct edict-test word ; Word to be tested. should-have ; Expansions that should be found should-not-have ; Expansions that should not be found. from-syntax-types to-syntax-types) ) (defvar *edict-tests* nil) (defun remove-edict-test (name) (let ((test (get-edict-test name))) (setq *edict-tests* (delq test *edict-tests*)))) (defun add-edict-test (test) ;; Preserve the order of the tests. (let* ((name (edict-test-word test)) (old (get-edict-test name))) (if old (setf (edict-test-should-have old) (edict-test-should-have test) (edict-test-should-not-have old) (edict-test-should-not-have test) (edict-test-from-syntax-types old) (edict-test-from-syntax-types test) (edict-test-to-syntax-types old) (edict-test-to-syntax-types test)) (setq *edict-tests* (append *edict-tests* (list test)))))) (defun get-edict-test (name) (if (symbolp name) (setq name (symbol-name name))) (catch 'found-it (dolist (test *edict-tests*) (if (equal (edict-test-word test) name) (throw 'found-it test))))) (defmacro deftest (case &optional fromto should-have should-not-have not-self) (` (define-edict-test '(, case) '(, (first fromto)) '(, (second fromto)) '(, should-have) '(, should-not-have) '(, not-self)))) (defun define-edict-test (name from to should-have should-not-have &optional not-self) (if (symbolp name) (setq name (symbol-name name))) (unless (listp from) (setq from (list from))) (unless (listp to) (setq to (list to))) (unless from (setq from '($@F|K\8l(J))) (let ((f (function (lambda (x) (if (symbolp x) (symbol-name x) x))))) (setq should-have (mapcar f should-have)) (setq should-not-have (mapcar f should-not-have)) (or not-self (edict-find name should-have) (push name should-have)) (add-edict-test (make-edict-test :word name :should-have should-have :should-not-have should-not-have :from-syntax-types from :to-syntax-types to))) name) ;;; This should be in emacs, but it isn't. ;;; (Borrowed from ilisp.el, where I inherited it accidentally). (defun edict-del (item list &optional test) "Delete ITEM from LIST using TEST comparison and return the result. Default test is equal." (let ((test (or test (function equal))) (element list) (prev nil) (done nil)) (while (and element (not done)) (if (funcall test item (car element)) (progn (setq done t) (if prev (rplacd prev (cdr element)) (setq list (cdr list)))) (setq prev element element (cdr element)))) list)) (defun edict-test (test) (if (or (symbolp test) (stringp test)) (setq test (get-edict-test test))) ;; Cleaning up the kanji shouldn't break anything; ;; give it a chance to do so if it's buggy. (let* ((name (edict-test-word test)) (word (edict-clean-up-kanji name)) (from-syntax-types (edict-test-from-syntax-types test)) (to-syntax-types (edict-test-to-syntax-types test)) (should-have (edict-test-should-have test)) (should-not-have (edict-test-should-not-have test))) (let ((expansion (edict-expand-string-syntaxes word () () from-syntax-types)) (failed nil)) (dolist (sh should-have) (if (edict-find sh expansion) (setq expansion (edict-del sh expansion (function equal))) (progn (princ (format ";%s: did not produce %s\n" name sh)) (setq failed t)))) (dolist (case should-not-have) (and (edict-find case expansion) (progn (princ (format ";%s: Should not have %s as expansion.\n" name case)) (setq failed t) (setq expansion (edict-del sh expansion (function equal)))))) (dolist (bad expansion) (princ (format ";%s: Unexpected expansion: %s\n" name bad)) (setq failed t)) (or failed (princ (format ";%s: OK\n" name))) (not failed)))) (defun edict-perform-tests () (interactive) (let ((test-buffer (get-buffer-create "*EDICT-TESTS*")) (failures 0) (first-failure nil)) (set-buffer test-buffer) (set-window-buffer (selected-window) test-buffer) (delete-region (point-min) (point-max)) (let ((standard-output test-buffer)) (dolist (test *edict-tests*) (let ((msg-point (point))) (cond ((not (edict-test test)) (incf failures) (or first-failure (setq first-failure msg-point)))) (sit-for 0)))) (cond ((= failures 0) (message "Done. All Tests OK.")) ((= failures 1) (message "1 test failed.")) (t (message (format "%d tests failed." failures)))) (goto-char (or first-failure (point-min))))) (defun edict-run-test (arg) "Execute the test that point is in or before. Print value in minibuffer. With argument, insert value in current buffer after the defun. With argument >= 16 (i.e. c-U c-U), single-step through the expansion process." (interactive "P") (save-excursion (end-of-defun) (let ((end (point)) (*edict-expand-string-trace* (and arg (> (prefix-numeric-value arg) 4)))) (beginning-of-defun) (let* ((test-form (read (current-buffer))) (test-name (second test-form)) (test)) (eval test-form) (setq test (get-edict-test test-name)) (forward-line 1) (while (looking-at (concat ";" (symbol-name test-name) ": \\(Unexpected expansion: \\|did not produce \\|OK$\\)")) (let ((start (point))) (forward-line 1) (delete-region start (point)))) (let ((standard-output (if arg (current-buffer) standard-output))) (edict-test test))))) t) ;(global-set-key "\e_" 'edict-run-test) ;;; **** NOTE WELL **** ;;; The proper test results here are not necessarily valid words. ;;; These are words which are MORPHOLOGICALLY correct. That is, ;;; this reverse-chains on the possible rules to produce a given ;;; word, generally only one or two of which would actually be ;;; correct. ;;; Also note that these are regression tests. No distinction is being ;;; made between results which are "correct" and results which are ;;; "acceptable". In general, we accept spurious expansions if they ;;; lead to including desirable results in other cases. Modifying the ;;; rule set may either result in eliminating spurious expansions (resulting ;;; in missing expansions from the tests) or adding new spurious expansions. ;;; In case of problems from these tests, the offending test should be single-stepped ;;; (with c-u c-u m-X edict-run-test), and the reasons for the expansion should be ;;; evaluated. If, after careful consideration, the modified result is regarded ;;; as correct, the test should be modified accordingly. Otherwise, the bug should ;;; be fixed. ;;; Be careful. Regression tests are good for considering all the effects of ;;; a change, but they do not themselves determine the correctness of a change. ;;; When the regression tests determine that something has changed, it is up ;;; to YOU to be careful and determine the correct result. (deftest "$@Gc$&(J " () ($@Gc$&(J) () :not-self) (deftest " $@!d!!Gc!t(J#>!$@!*!'(J:$@$&(J " () ($@Gc$&(J) () :not-self) ;;; The basics: $@8^CJF0;l(J (deftest $@Gc$&(J ()) (deftest $@9T$/(J () ($@9T$$(J)) ;Looks like it could be an adverb ;$@9T$/(J: OK (deftest $@1K$0(J ()) (deftest $@OC$9(J ()) (deftest $@BT$D(J ()) (deftest $@;`$L(J ()) (deftest $@8F$V(J ()) (deftest $@FI$`(J ()) (deftest $@J,$+$k(J ()) (deftest $@@.$k(J ()) ;;; $@0lCJF0;l(J (deftest $@@8$-$k(J ()) (deftest $@8+$k(J ()) ;;; Distal style ;;; These all produce the improbable but possible result of removing only the ;;; masu and adding $@$k(J as if it were a $@0lCJF0;l(J, since the result of that situation ;;; would look the same. (deftest $@Gc$$$^$9(J () ($@Gc$&(J $@Gc$$$k(J)) (deftest $@CV$-$^$9(J () ($@CV$/(J $@CV$-$k(J)) ;$@CV$-$^$9(J: OK (deftest $@1K$.$^$9(J () ($@1K$0(J $@1K$.$k(J)) (deftest $@OC$7$^$9(J () ($@OC$9(J $@OC$7$k(J $@OC$9$k(J $@OC(J)) (deftest $@;}$A$^$9(J () ($@;}$D(J $@;}$A$k(J)) (deftest $@;`$K$^$9(J () ($@;`$L(J $@;`$K$k(J)) (deftest $@8F$S$^$9(J () ($@8F$V(J $@8F$S$k(J)) (deftest $@FI$_$^$9(J () ($@FI$`(J $@FI$_$k(J)) (deftest $@J,$+$j$^$9(J () ($@J,$+$k(J $@J,$+$j$k(J)) (deftest $@@.$j$^$9(J () ($@@.$k(J $@@.$j$k(J)) (deftest $@@8$-$^$9(J () ($@@8$-$k(J $@@8$/(J)) ;$@@8$-$^$9(J: OK (deftest $@8+$^$9(J () ($@8+$k(J)) ;;; Irregulars (deftest $@Mh$^$9(J () ($@Mh$k(J)) (deftest $@$-$^$9(J () ($@$/$k(J $@$-$k(J)) (deftest $@$7$^$9(J () ($@$9$k(J $@$7$k(J)) (deftest $@Gc$$$^$;$s(J () ($@Gc$&(J $@Gc$$$k(J)) (deftest $@CV$-$^$;$s(J () ($@CV$/(J $@CV$-$k(J)) ;$@CV$-$^$;$s(J: OK (deftest $@1K$.$^$;$s(J () ($@1K$0(J $@1K$.$k(J)) (deftest $@OC$7$^$;$s(J () ($@OC$9(J $@OC$7$k(J $@OC$9$k(J $@OC(J)) (deftest $@;}$A$^$;$s(J () ($@;}$D(J $@;}$A$k(J)) (deftest $@;`$K$^$;$s(J () ($@;`$L(J $@;`$K$k(J)) (deftest $@8F$S$^$;$s(J () ($@8F$V(J $@8F$S$k(J)) (deftest $@FI$_$^$;$s(J () ($@FI$`(J $@FI$_$k(J)) (deftest $@J,$+$j$^$;$s(J () ($@J,$+$k(J $@J,$+$j$k(J)) (deftest $@@.$j$^$;$s(J () ($@@.$k(J $@@.$j$k(J)) (deftest $@@8$-$^$;$s(J () ($@@8$-$k(J $@@8$/(J)) ;$@@8$-$^$;$s(J: OK (deftest $@8+$^$;$s(J () ($@8+$k(J)) ;;; Irregulars (deftest $@Mh$^$;$s(J () ($@Mh$k(J)) (deftest $@$-$^$;$s(J () ($@$/$k(J $@$-$k(J)) (deftest $@$7$^$;$s(J () ($@$9$k(J $@$7$k(J)) ;;; Past tense (deftest $@Gc$C$?(J () ($@Gc$&(J $@Gc$D(J $@Gc$k(J)) (deftest $@CV$$$?(J () ($@CV$/(J $@CV$$$k(J)) ;$@CV$$$?(J: OK (deftest $@9T$C$?(J ();iku is irregular It looks like a $@$k(J/$@$D(J/$@$&(J. ($@9T$/(J $@9T$$(J $@9T$&(J $@9T$D(J $@9T$k(J)) ;$@9T$C$?(J: OK (deftest $@OC$7$?(J () ($@OC$9(J $@OC$7$k(J $@OC$9$k(J $@OC(J)) ;$@OC$7$?(J: OK (deftest $@;}$C$?(J () ($@;}$D(J $@;}$&(J $@;}$k(J)) (deftest $@;`$s$?(J ();Don't mis-interpret () ($@;`$L(J)) (deftest $@;`$s$@(J () ($@;`$L(J $@;`$V(J $@;`$`(J $@;`$s(J)) ;$@;`$s$@(J: OK (deftest $@8F$s$@(J () ($@8F$V(J $@8F$`(J $@8F$L(J $@8F$s(J)) ;$@8F$s$@(J: OK (deftest $@FI$s$@(J () ($@FI$`(J $@FI$L(J $@FI$V(J $@FI$s(J)) ;$@FI$s$@(J: OK (deftest $@J,$+$C$?(J () ($@J,$+$k(J $@J,$$(J $@J,$+$&(J $@J,$+$D(J)) ;$@J,$+$C$?(J: OK (deftest $@@.$C$?(J () ($@@.$k(J $@@.$&(J $@@.$D(J)) ;;; $@0lCJF0;l(J (deftest $@@8$-$?(J () ($@@8$-$k(J $@@8$/$k(J)) ;$@@8$-$?(J: OK (deftest $@8+$?(J () ($@8+$k(J)) ;;; Gerund ;;; These all also map to $@$D(J, because of the plan imperative form. ;;; This seems surprising, if you're not thinking about it. (deftest $@Gc$C$F(J () ($@Gc$&(J $@Gc$D(J $@Gc$k(J $@Gc$C$D(J $@Gc$C$F$k(J)) ;$@Gc$C$F(J: OK (deftest $@CV$$$F(J () ($@CV$/(J $@CV$$$k(J $@CV$$$D(J $@CV$$$F$k(J)) ;$@CV$$$F(J: OK (deftest $@9T$C$F(J ();iku is irregular It looks like a $@$k(J/$@$D(J/$@$&(J. ($@9T$/(J $@9T$$(J $@9T$&(J $@9T$D(J $@9T$k(J $@9T$C$D(J $@9T$C$F$k(J)) ;$@9T$C$F(J: OK (deftest $@OC$7$F(J () ($@OC$9(J $@OC$7$k(J $@OC$7$D(J $@OC$9$k(J $@OC(J $@OC$7$F$k(J)) ;$@OC$7$F(J: OK (deftest $@;}$C$F(J () ($@;}$D(J $@;}$&(J $@;}$k(J $@;}$C$D(J $@;}$C$F$k(J)) ;$@;}$C$F(J: OK (deftest $@;`$s$F(J ();Don't mis-interpret ($@;`$s$D(J $@;`$s$F$k(J) ($@;`$L(J)) ;$@;`$s$F(J: OK (deftest $@;`$s$G(J () ($@;`$L(J $@;`$V(J $@;`$`(J)) ;$@;`$s$G(J: OK (deftest $@8F$s$G(J () ($@8F$V(J $@8F$`(J $@8F$L(J)) ;$@8F$s$G(J: OK (deftest $@FI$s$G(J () ($@FI$`(J $@FI$L(J $@FI$V(J)) (deftest $@J,$+$C$F(J () ($@J,$+$k(J $@J,$+$&(J $@J,$+$D(J $@J,$+$C$D(J $@J,$+$C$F$k(J)) ;$@J,$+$C$F(J: OK (deftest $@@.$C$F(J () ($@@.$k(J $@@.$&(J $@@.$D(J $@@.$C$D(J $@@.$C$F$k(J)) ;$@@.$C$F(J: OK ;;; $@0lCJF0;l(J (deftest $@@8$-$F(J () ($@@8$-$k(J $@@8$-$D(J $@@8$/$k(J $@@8$-$F$k(J)) ;$@@8$-$F(J: OK (deftest $@8+$F(J () ($@8+$k(J $@8+$D(J $@8+$F$k(J)) ;$@8+$F(J: OK ;;; Potential (deftest $@Gc$($k(J () ($@Gc$&(J)) ;$@Gc$($k(J: OK (deftest $@?)$Y$i$l$k(J () ($@?)$Y$k(J $@?)$Y$i$k(J $@?)$V(J)) ;$@?)$Y$i$l$k(J: OK (deftest $@8F$Y$k(J () ($@8F$V(J)) ;$@8F$Y$k(J: OK ;;; Passive ;;; These also look like they could be $@0lCJ$I$&$7(J potentials. (deftest $@Gc$o$l$k(J () ($@Gc$&(J $@Gc$o$k(J)) ;$@Gc$o$l$k(J: OK (deftest $@CV$+$l$k(J () ($@CV$/(J $@CV$+$k(J)) ;$@CV$+$l$k(J: OK (deftest $@1K$,$l$k(J () ($@1K$0(J $@1K$,$k(J)) (deftest $@OC$5$l$k(J () ($@OC$9(J $@OC$9$k(J $@OC$5$k(J $@OC(J)) ;Because of irregular $@$9$k(J (deftest $@BT$?$l$k(J () ($@BT$D(J $@BT$?$k(J)) (deftest $@;`$J$l$k(J () ($@;`$L(J $@;`$J$k(J)) (deftest $@FI$^$l$k(J () ($@FI$`(J $@FI$^$k(J)) ;$@FI$^$l$k(J: OK (deftest $@8F$P$l$k(J () ($@8F$V(J $@8F$P$k(J)) (deftest $@8+$i$l$k(J () ($@8+$k(J $@8+$i$k(J)) ;;; Irregulars (deftest $@Mh$i$l$k(J () ($@Mh$k(J $@Mh$i$k(J)) (deftest $@$5$l$k(J () ($@$9$k(J $@$5$k(J $@$9(J)) ;$@$9(J because of the regular rule. ;;; Causitive (deftest $@Gc$o$;$k(J () ($@Gc$&(J $@Gc$o$9(J)) ;$@Gc$o$;$k(J: OK (deftest $@CV$+$;$k(J () ($@CV$/(J $@CV$+$9(J)) ;$@CV$+$;$k(J: OK (deftest $@1K$,$;$k(J () ($@1K$0(J $@1K$,$9(J)) ;$@1K$,$;$k(J: OK (deftest $@OC$5$;$k(J () ($@OC$k(J $@OC$9(J $@OC$9$k(J $@OC$5$9(J $@OC(J)) ;Because of irregular $@$9$k(J ;$@OC$5$;$k(J: OK (deftest $@BT$?$;$k(J () ($@BT$D(J $@BT$?$9(J)) ;$@BT$?$;$k(J: OK (deftest $@;`$J$;$k(J () ($@;`$L(J $@;`$J$9(J)) ;$@;`$J$;$k(J: OK (deftest $@FI$^$;$k(J () ($@FI$`(J $@FI$^$9(J)) ;$@FI$^$;$k(J: OK (deftest $@8F$P$;$k(J () ($@8F$V(J $@8F$P$9(J)) ;$@8F$P$;$k(J: OK (deftest $@8+$5$;$k(J () ($@8+$k(J $@8+$9(J $@8+$9$k(J $@8+$5$9(J $@8+(J)) ;Because of regular & irregular rules ;$@8+$5$;$k(J: OK ;;; Irregulars (deftest $@Mh$5$;$k(J () ($@Mh$k(J $@Mh$9(J $@Mh$9$k(J $@Mh$5$9(J $@Mh(J)) ;because of regular & irregular rules. ;$@Mh$5$;$k(J: OK (deftest $@$5$;$k(J () ($@$9$k(J $@$5$9(J $@$9(J)) ;$@$9(J because of the regular rule. ;$@$5$;$k(J: OK ;;; Conditional (deftest $@Gc$($P(J () ($@Gc$&(J)) (deftest $@CV$1$P(J () ($@CV$/(J)) (deftest $@1K$2$P(J () ($@1K$0(J)) (deftest $@OC$;$P(J () ($@OC$9(J)) (deftest $@BT$F$P(J () ($@BT$D(J)) (deftest $@;`$M$P(J () ($@;`$L(J)) (deftest $@FI$a$P(J () ($@FI$`(J)) (deftest $@8F$Y$P(J () ($@8F$V(J)) (deftest $@8+$l$P(J () ($@8+$k(J)) ;;; $@$?$i(J conditional form (deftest $@Gc$C$?$i(J () ($@Gc$&(J $@Gc$D(J $@Gc$k(J)) (deftest $@CV$$$?$i(J () ($@CV$/(J $@CV$$$k(J)) (deftest $@9T$C$?$i(J ();iku is irregular It looks like a $@$k(J/$@$D(J/$@$&(J. ($@9T$/(J $@9T$$(J $@9T$&(J $@9T$D(J $@9T$k(J)) (deftest $@OC$7$?$i(J () ($@OC$9(J $@OC$7$k(J $@OC$9$k(J $@OC(J)) ;$@OC$7$?$i(J: OK (deftest $@;}$C$?$i(J () ($@;}$D(J $@;}$&(J $@;}$k(J)) (deftest $@;`$s$?$i(J ();Don't mis-interpret () ($@;`$L(J)) (deftest $@;`$s$@$i(J () ($@;`$L(J $@;`$V(J $@;`$`(J)) (deftest $@8F$s$@$i(J () ($@8F$V(J $@8F$`(J $@8F$L(J)) (deftest $@FI$s$@$i(J () ($@FI$`(J $@FI$L(J $@FI$V(J)) (deftest $@J,$+$C$?$i(J () ($@J,$+$k(J $@J,$+$&(J $@J,$+$D(J)) (deftest $@@.$C$?$i(J () ($@@.$k(J $@@.$&(J $@@.$D(J)) ;;; $@0lCJF0;l(J (deftest $@@8$-$?$i(J () ($@@8$-$k(J $@@8$/$k(J)) ;$@@8$-$?$i(J: OK (deftest $@8+$?$i(J () ($@8+$k(J)) ;;; Plain negative (deftest $@Gc$o$J$$(J () ($@Gc$&(J $@Gc$o$J$$(J $@Gc$o$J$&(J $@Gc$o$J$$$k(J)) ;$@Gc$o$J$$(J: OK (deftest $@CV$+$J$$(J () ($@CV$/(J $@CV$+$J$$(J $@CV$+$J$&(J $@CV$+$J$$$k(J)) ;$@CV$+$J$$(J: OK (deftest $@1K$,$J$$(J () ($@1K$0(J $@1K$,$J$$$k(J $@1K$,$J$&(J)) ;$@1K$,$J$$(J: OK (deftest $@OC$5$J$$(J () ($@OC$9(J $@OC$5$J$$$k(J $@OC$5$J$&(J)) ;$@OC$5$J$$(J: OK (deftest $@BT$?$J$$(J () ($@BT$D(J $@BT$?$J$$$k(J $@BT$?$J$&(J)) ;$@BT$?$J$$(J: OK (deftest $@;`$J$J$$(J () ($@;`$L(J $@;`$J$J$$$k(J $@;`$J$J$&(J)) ;$@;`$J$J$$(J: OK (deftest $@FI$^$J$$(J () ($@FI$`(J $@FI$^$J$$$k(J $@FI$^$J$&(J)) ;$@FI$^$J$$(J: OK (deftest $@8F$P$J$$(J () ($@8F$V(J $@8F$P$J$$$k(J $@8F$P$J$&(J)) ;$@8F$P$J$$(J: OK (deftest $@8+$J$$(J () ($@8+$k(J $@8+$J$$$k(J $@8+$J$&(J)) ;$@8+$J$$(J: OK ;;; Irregulars (deftest $@Mh$J$$(J () ($@Mh$k(J $@Mh$J$$$k(J $@Mh$J$&(J)) ;$@Mh$J$$(J: OK (deftest $@$7$J$$(J () ($@$9$k(J $@$7$k(J $@$7$J$$$k(J $@$7$J$&(J)) ;$@$7$k(J because of regular rules. ;$@$7$J$$(J: OK (deftest $@$J$$(J () ($@$"$k(J $@$J$$$k(J $@$J$&(J)) ;$@$J$$(J: OK ;;; $@$:(J negatives (deftest $@Gc$o$:(J () ($@Gc$&(J)) ;$@Gc$o$:(J: OK (deftest $@CV$+$:(J () ($@CV$/(J)) ;$@CV$+$:(J: OK (deftest $@1K$,$:(J () ($@1K$0(J)) ;$@1K$,$:(J: OK (deftest $@OC$5$:(J () ($@OC$9(J)) ;$@OC$5$:(J: OK (deftest $@BT$?$:(J () ($@BT$D(J)) ;$@BT$?$:(J: OK (deftest $@;`$J$:(J () ($@;`$L(J)) ;$@;`$J$:(J: OK (deftest $@FI$^$:(J () ($@FI$`(J)) ;$@FI$^$:(J: OK (deftest $@8F$P$:(J () ($@8F$V(J)) ;$@8F$P$:(J: OK (deftest $@8+$:(J () ($@8+$k(J)) ;$@8+$:(J: OK ;;; Irregulars (deftest $@Mh$:(J () ($@Mh$k(J)) ;$@Mh$:(J: OK (deftest $@$;$:(J () ($@$9$k(J $@$;$k(J)) ;$@$;$k(J because of regular rules. ;$@$;$:(J: OK ;;; Plain command form (deftest $@Gc$((J () ($@Gc$&(J $@Gc$($k(J)) (deftest $@CV$1(J () ($@CV$/(J $@CV$1$k(J)) ;$@CV$1(J: OK (deftest $@1K$2(J () ($@1K$0(J $@1K$2$k(J)) (deftest $@OC$;(J () ($@OC$9(J $@OC$;$k(J)) (deftest $@BT$F(J () ($@BT$D(J $@BT$F(J $@BT$k(J $@BT$F$k(J)) ;$@BT$F(J: OK (deftest $@;`$M(J () ($@;`$L(J $@;`$M$k(J)) (deftest $@FI$a(J () ($@FI$`(J $@FI$a$k(J)) (deftest $@8F$Y(J () ($@8F$V(J $@8F$Y$k(J)) (deftest $@8+$m(J () ($@8+$k(J)) ;;; Irregulars (deftest $@Mh$$(J () ($@Mh$k(J $@Mh$$$k(J $@Mh$&(J)) ;$@Mh$$(J: OK (deftest $@$3$$(J () ($@$/$k(J $@$3$$$k(J $@$3$&(J)) ;$@$3$$(J: OK (deftest $@$7$m(J () ($@$9$k(J $@$7$k(J)) ;$@$7$k(J because of regular rules. ;;; The plain desideratives (deftest $@Gc$$$?$$(J () ($@Gc$&(J $@Gc$$$k(J $@Gc$$$?$$$k(J $@Gc$$$?$&(J)) ;$@Gc$$$?$$(J: OK (deftest $@CV$-$?$$(J () ($@CV$/(J $@CV$-$k(J $@CV$-$?$$$k(J $@CV$-$?$&(J)) ;$@CV$-$?$$(J: OK (deftest $@1K$.$?$$(J () ($@1K$0(J $@1K$.$k(J $@1K$.$?$$$k(J $@1K$.$?$&(J)) ;$@1K$.$?$$(J: OK (deftest $@OC$7$?$$(J () ($@OC$9(J $@OC$7$k(J $@OC$7$?$$$k(J $@OC$7$?$&(J)) ;$@OC$7$?$$(J: OK (deftest $@;}$A$?$$(J () ($@;}$D(J $@;}$A$k(J $@;}$A$?$$$k(J $@;}$A$?$&(J)) ;$@;}$A$?$$(J: OK (deftest $@;`$K$?$$(J () ($@;`$L(J $@;`$K$k(J $@;`$K$?$$$k(J $@;`$K$?$&(J)) ;$@;`$K$?$$(J: OK (deftest $@8F$S$?$$(J () ($@8F$V(J $@8F$S$k(J $@8F$S$?$$$k(J $@8F$S$?$&(J)) ;$@8F$S$?$$(J: OK (deftest $@FI$_$?$$(J () ($@FI$`(J $@FI$_$k(J $@FI$_$?$$$k(J $@FI$_$?$&(J)) ;$@FI$_$?$$(J: OK (deftest $@J,$+$j$?$$(J () ($@J,$+$k(J $@J,$+$j$k(J $@J,$+$j$?$$$k(J $@J,$+$j$?$&(J)) ;$@J,$+$j$?$$(J: OK (deftest $@@.$j$?$$(J () ($@@.$k(J $@@.$j$k(J $@@.$j$?$$$k(J $@@.$j$?$&(J)) ;$@@.$j$?$$(J: OK (deftest $@@8$-$?$$(J () ($@@8$-$k(J $@@8$/(J $@@8$-$?$$$k(J $@@8$-$?$&(J)) ;$@@8$-$?$$(J: OK (deftest $@8+$?$$(J () ($@8+$k(J $@8+$?$$$k(J $@8+$?$&(J)) ;$@8+$?$$(J: OK ;;; Irregulars (deftest $@Mh$?$$(J () ($@Mh$k(J $@Mh$?$$$k(J $@Mh$?$&(J)) ;$@Mh$?$$(J: OK (deftest $@$-$?$$(J () ($@$/$k(J $@$-$k(J $@$-$?$$$k(J $@$-$?$&(J)) ;$@$-$?$$(J: OK (deftest $@$7$?$$(J () ($@$9$k(J $@$7$k(J $@$7$?$$$k(J $@$7$?$&(J)) ;$@$7$?$$(J: OK (deftest $@Gc$$$?$,$k(J () ($@Gc$&(J $@Gc$$$k(J)) (deftest $@CV$-$?$,$k(J () ($@CV$/(J $@CV$$(J $@CV$-$k(J)) (deftest $@1K$.$?$,$k(J () ($@1K$0(J $@1K$.$k(J)) (deftest $@OC$7$?$,$k(J () ($@OC$9(J $@OC$7$k(J)) (deftest $@;}$A$?$,$k(J () ($@;}$D(J $@;}$A$k(J)) (deftest $@;`$K$?$,$k(J () ($@;`$L(J $@;`$K$k(J)) (deftest $@8F$S$?$,$k(J () ($@8F$V(J $@8F$S$k(J)) (deftest $@FI$_$?$,$k(J () ($@FI$`(J $@FI$_$k(J)) (deftest $@J,$+$j$?$,$k(J () ($@J,$+$k(J $@J,$+$j$k(J)) (deftest $@@.$j$?$,$k(J () ($@@.$k(J $@@.$j$k(J)) (deftest $@@8$-$?$,$k(J () ($@@8$-$k(J $@@8$/(J $@@8$$(J)) ; Could be an adverb or adjective. (deftest $@8+$?$,$k(J () ($@8+$k(J)) ;;; Irregulars (deftest $@Mh$?$,$k(J () ($@Mh$k(J)) (deftest $@$-$?$,$k(J () ($@$/$k(J $@$-$k(J)) (deftest $@$7$?$,$k(J () ($@$9$k(J $@$7$k(J)) ;;; Here's a compound test. (deftest $@9T$-$?$,$C$F$$$^$9(J () ($@9T$/(J $@9T$-$?$,$C$F(J $@9T$-$?$,$k(J $@9T$-$?$,$&(J $@9T$-$?$,$D(J $@9T$-$?$,$C$D(J $@9T$-$?$,$C$F$$$k(J $@9T$-$?$,$C$F$&(J $@9T$$(J $@9T$-$k(J)) ;$@9T$-$?$,$C$F$$$^$9(J: OK (deftest $@FI$s$G$$$k(J () ($@FI$s$G(J $@FI$`(J $@FI$L(J $@FI$V(J)) ;$@FI$s$G$$$k(J: OK (deftest $@Gc$C$F$$$k(J () ($@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J)) ;$@Gc$C$F$$$k(J: OK (deftest $@FI$s$G$$$?(J () ($@FI$s$G(J $@FI$`(J $@FI$L(J $@FI$V(J $@FI$s$G$$$k(J $@FI$s$G$/(J)) ;$@FI$s$G$$$?(J: OK (deftest $@Gc$C$F$$$?(J () ($@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J $@Gc$C$F$$$k(J $@Gc$C$F$/(J)) ;$@Gc$C$F$$$?(J: OK (deftest $@FI$s$G$$$^$9(J () ($@FI$s$G(J $@FI$`(J $@FI$L(J $@FI$V(J $@FI$s$G$$$k(J $@FI$s$G$&(J)) ;$@FI$s$G$$$^$9(J: OK (deftest $@Gc$C$F$$$^$9(J () ($@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J $@Gc$C$F$$$k(J $@Gc$C$F$&(J)) ;$@Gc$C$F$$$^$9(J: OK (deftest $@FI$s$G$"$k(J () ($@FI$s$G(J $@FI$`(J $@FI$L(J $@FI$V(J)) ;$@FI$s$G$"$k(J: OK (deftest $@Gc$C$F$"$k(J () ($@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J)) ;$@Gc$C$F$"$k(J: OK (deftest $@FI$s$G$*$/(J () ($@FI$s$G(J $@FI$`(J $@FI$L(J $@FI$V(J $@FI$s$G$*$$(J)) ;$@FI$s$G$*$/(J: OK (deftest $@Gc$C$F$*$/(J () ($@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J $@Gc$C$F$*$$(J)) ;$@Gc$C$F$*$/(J: OK (deftest $@FI$s$G$_$k(J () ($@FI$s$G(J $@FI$`(J $@FI$L(J $@FI$V(J)) ;$@FI$s$G$_$k(J: OK (deftest $@Gc$C$F$_$k(J () ($@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J)) ;$@Gc$C$F$_$k(J: OK (deftest $@FI$s$G$7$^$&(J () ($@FI$s$G(J $@FI$`(J $@FI$L(J $@FI$V(J)) ;$@FI$s$G$7$^$&(J: OK (deftest $@Gc$C$F$7$^$&(J () ($@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J)) ;$@Gc$C$F$7$^$&(J: OK (deftest $@FI$s$G$/$@$5$$(J () ($@FI$s$G(J $@FI$`(J $@FI$L(J $@FI$V(J $@FI$s$G$/$@$5$$$k(J $@FI$s$G$/$@$5$&(J)) ;$@FI$s$G$/$@$5$$(J: OK (deftest $@Gc$C$F$/$@$5$$(J () ($@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J $@Gc$C$F$/$@$5$$$k(J $@Gc$C$F$/$@$5$&(J)) ;$@Gc$C$F$/$@$5$$(J: OK (deftest $@FI$s$G2<$5$$(J () ($@FI$s$G(J $@FI$`(J $@FI$L(J $@FI$V(J $@FI$s$G2<$5$$$k(J $@FI$s$G2<$5$&(J)) ;$@FI$s$G2<$5$$(J: OK (deftest $@Gc$C$F2<$5$$(J () ($@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J $@Gc$C$F2<$5$$$k(J $@Gc$C$F2<$5$&(J)) ;$@Gc$C$F2<$5$$(J: OK (deftest $@FI$s$G$J$5$$(J () ($@FI$s$G(J $@FI$`(J $@FI$L(J $@FI$V(J $@FI$s$G$J$5$$$k(J $@FI$s$G$J$5$&(J)) ;$@FI$s$G$J$5$$(J: OK (deftest $@Gc$C$F$J$5$$(J () ($@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J $@Gc$C$F$J$5$$$k(J $@Gc$C$F$J$5$&(J)) ;$@Gc$C$F$J$5$$(J: OK (deftest $@FI$s$G$$$/(J () ($@FI$s$G(J $@FI$`(J $@FI$L(J $@FI$V(J $@FI$s$G$$$$(J)) ;$@FI$s$G$$$/(J: OK (deftest $@Gc$C$F$$$/(J () ($@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J $@Gc$C$F$$$$(J)) ;$@Gc$C$F$$$/(J: OK (deftest $@FI$s$G$/$k(J () ($@FI$s$G(J $@FI$`(J $@FI$L(J $@FI$V(J)) ;$@FI$s$G$/$k(J: OK (deftest $@Gc$C$F$/$k(J () ($@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J)) ;$@Gc$C$F$/$k(J: OK (deftest $@FI$s$G$"$2$k(J () ($@FI$s$G(J $@FI$`(J $@FI$L(J $@FI$V(J $@FI$s$G$"$0(J)) ;$@FI$s$G$"$2$k(J: OK (deftest $@Gc$C$F$"$2$k(J () ($@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J $@Gc$C$F$"$0(J)) ;$@Gc$C$F$"$2$k(J: OK (deftest $@FI$s$G$d$k(J () ($@FI$s$G(J $@FI$`(J $@FI$L(J $@FI$V(J)) ;$@FI$s$G$d$k(J: OK (deftest $@Gc$C$F$d$k(J () ($@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J)) ;$@Gc$C$F$d$k(J: OK (deftest $@FI$s$G$b$i$&(J () ($@FI$s$G(J $@FI$`(J $@FI$L(J $@FI$V(J)) ;$@FI$s$G$b$i$&(J: OK (deftest $@Gc$C$F$b$i$&(J () ($@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J)) ;$@Gc$C$F$b$i$&(J: OK (deftest $@FI$s$G$$$?$@$/(J () ($@FI$s$G(J $@FI$`(J $@FI$L(J $@FI$V(J $@FI$s$G$$$?$@$$(J)) ;$@FI$s$G$$$?$@$/(J: OK (deftest $@Gc$C$F$$$?$@$/(J () ($@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J $@Gc$C$F$$$?$@$$(J)) ;$@Gc$C$F$$$?$@$/(J: OK (deftest $@FI$s$G$/$l$k(J () ($@FI$s$G(J $@FI$`(J $@FI$L(J $@FI$V(J $@FI$s$G$/$k(J)) ;$@FI$s$G$/$l$k(J: OK (deftest $@Gc$C$F$/$l$k(J () ($@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J $@Gc$C$F$/$k(J)) ;$@Gc$C$F$/$l$k(J: OK (deftest $@FI$s$G$$$?$@$-$^$9(J () ($@FI$s$G(J $@FI$`(J $@FI$L(J $@FI$V(J $@FI$s$G$$$?$@$/(J $@FI$s$G$$$?$@$-$k(J)) ;$@FI$s$G$$$?$@$-$^$9(J: OK (deftest $@Gc$C$F$$$?$@$-$^$9(J () ($@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J $@Gc$C$F$$$?$@$/(J $@Gc$C$F$$$?$@$-$k(J)) ;$@Gc$C$F$$$?$@$-$^$9(J: OK (deftest $@Gc$C$FD:$-$^$9(J () ($@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J $@Gc$C$FD:$/(J $@Gc$C$FD:$-$k(J)) ;$@Gc$C$FD:$-$^$9(J: OK (deftest $@FI$s$G$/$@$5$$(J () ($@FI$s$G(J $@FI$`(J $@FI$L(J $@FI$V(J $@FI$s$G$/$@$5$&(J $@FI$s$G$/$@$5$$$k(J)) ;$@FI$s$G$/$@$5$$(J: OK (deftest $@Gc$C$F$/$@$5$$(J () ($@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J $@Gc$C$F$/$@$5$&(J $@Gc$C$F$/$@$5$$$k(J)) ;$@Gc$C$F$/$@$5$$(J: OK (deftest $@FI$s$G>e$2$k(J () ($@FI$s$G(J $@FI$`(J $@FI$L(J $@FI$V(J $@FI$s$G>e$0(J)) ;$@FI$s$G>e$2$k(J: OK (deftest $@Gc$C$F$"$2$k(J () ($@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J $@Gc$C$F$"$0(J)) ;$@Gc$C$F$"$2$k(J: OK (deftest $@FI$s$G:9$7>e$2$k(J () ($@FI$s$G(J $@FI$`(J $@FI$L(J $@FI$V(J $@FI$s$G:9$7>e$0(J)) ;$@FI$s$G:9$7>e$2$k(J: OK (deftest $@Gc$C$F:9$7>e$2$k(J () ($@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J $@Gc$C$F:9$7>e$0(J)) ;$@Gc$C$F:9$7>e$2$k(J: OK (deftest $@Gc$C$F:9$7$"$2$k(J () ($@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J $@Gc$C$F:9$7$"$0(J)) ;$@Gc$C$F:9$7$"$2$k(J: OK (deftest $@Gc$C$F$5$7$"$2$k(J () ($@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J $@Gc$C$F$5$7$"$0(J)) ;$@Gc$C$F$5$7$"$2$k(J: OK (deftest $@Gc$C$F$5$7>e$2$k(J () ($@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J $@Gc$C$F$5$7>e$0(J)) ;$@Gc$C$F$5$7>e$2$k(J: OK (deftest $@FI$`$i$7$$(J () ($@FI$`(J $@FI$`$i$7$&(J $@FI$`$i$7$$$k(J)) ;$@FI$`$i$7$$(J: OK (deftest $@FI$`$=$&(J () ($@FI$`(J $@FI$`$9(J)) ;$@FI$`$=$&(J: OK (deftest $@FI$`$h$&(J () ($@FI$`(J)) ;$@FI$`$h$&(J: OK (deftest $@FI$`$h$&$@(J () ($@FI$`(J $@FI$`$h$&(J)) ;$@FI$`$h$&$@(J: OK (deftest $@Gc$*$&(J () ($@Gc$&(J)) ;$@Gc$*$&(J: OK (deftest $@CV$3$&(J () ($@CV$/(J)) ;$@CV$3$&(J: OK (deftest $@1K$4$&(J () ($@1K$0(J)) ;$@1K$4$&(J: OK (deftest $@OC$=$&(J () ($@OC$9(J)) ;$@OC$=$&(J: OK (deftest $@BT$H$&(J () ($@BT$D(J)) ;$@BT$H$&(J: OK (deftest $@;`$N$&(J () ($@;`$L(J)) ;$@;`$N$&(J: OK (deftest $@FI$b$&(J () ($@FI$`(J)) ;$@FI$b$&(J: OK (deftest $@8F$\$&(J () ($@8F$V(J)) ;$@8F$\$&(J: OK (deftest $@8+$h$&(J () ($@8+$k(J)) ;$@8+$h$&(J: OK ;;; Irregulars (deftest $@Mh$h$&(J () ($@Mh$k(J)) ;$@Mh$h$&(J: OK (deftest $@$3$h$&(J () ($@$/$k(J)) ;$@$3$h$&(J: OK (deftest $@$7$h$&(J () ($@$9$k(J $@$7$k(J)) ;$@$7$k(J due to the regular rules. ;$@$7$h$&(J: OK (deftest $@FI$s$A$c$&(J () ($@FI$s$G$7$^$&(J $@FI$s$G(J $@FI$`(J $@FI$L(J $@FI$V(J)) ;$@FI$s$A$c$&(J: OK (deftest $@Gc$C$A$c$&(J () ($@Gc$C$F$7$^$&(J $@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J)) ;$@Gc$C$A$c$&(J: OK (deftest $@FI$s$A$c$C$?(J () ($@FI$s$G$7$^$&(J $@FI$s$G(J $@FI$`(J $@FI$L(J $@FI$V(J $@FI$s$A$c$&(J $@FI$s$A$c$k(J $@FI$s$A$c$D(J)) ;$@FI$s$A$c$C$?(J: OK (deftest $@Gc$C$A$c$C$?(J () ($@Gc$C$F$7$^$&(J $@Gc$C$F(J $@Gc$&(J $@Gc$C$D(J $@Gc$D(J $@Gc$k(J $@Gc$C$A$c$&(J $@Gc$C$A$c$k(J $@Gc$C$A$c$D(J)) ;$@Gc$C$A$c$C$?(J: OK (deftest $@:o=|$9$k(J () ($@:o=|(J)) ;$@:o=|$9$k(J: OK ;;; Honorific prefixes (deftest $@$*?e(J () ($@?e(J)) ;$@$*?e(J: OK (deftest $@$4HS(J () ($@HS(J)) ;$@$4HS(J: OK (deftest $@8fHS(J () ($@HS(J)) ;$@8fHS(J: OK ;;; Adjectives (deftest $@?7$7$/(J () ($@?7$7$$(J)) ;$@?7$7$/(J: OK (deftest $@?7$7$/$F(J () ($@?7$7$$(J $@?7$7$/$D(J $@?7$7$/$F$k(J)) ;$@?7$7$/$F(J: OK (deftest $@?7$7$+$C$?(J () ($@?7$7$$(J $@?7$7$+$&(J $@?7$7$+$D(J $@?7$7$+$k(J)) ;$@?7$7$+$C$?(J: OK (deftest $@855$$G$O$"$j$^$;$s(J () ($@855$(J $@855$$G$O$"$k(J $@855$$G$O$"$j$k(J $@855$$@(J $@855$$G$9(J)) ;$@855$$G$O$"$j$^$;$s(J: OK (deftest $@855$$G$O$J$$(J () ($@855$(J $@855$$G$O$J$$$k(J $@855$$G$O$J$&(J $@855$$@(J)) ;$@855$$G$O$J$$(J: OK (deftest $@855$$8$c$"$j$^$;$s(J () ($@855$(J $@855$$8$c$"$k(J $@855$$8$c$"$j$k(J $@855$$@(J $@855$$G$9(J)) ;$@855$$8$c$"$j$^$;$s(J: OK (deftest $@855$$8$c$J$$(J () ($@855$(J $@855$$8$c$J$$$k(J $@855$$8$c$J$&(J $@855$$@(J)) ;$@855$$8$c$J$$(J: OK (deftest $@?7$7$/$J$/$F(J () ($@?7$7$$(J $@?7$7$/$J$$(J $@?7$7$/$J$/$D(J $@?7$7$/$J$/$F$k(J)) ;$@?7$7$/$J$/$F(J: OK (deftest $@?7$7$1$l$P(J () ($@?7$7$$(J $@?7$7$/(J $@?7$7$1$k(J)) ;$@?7$7$1$l$P(J: OK (deftest $@?7$7$/$J$$(J () ($@?7$7$$(J $@?7$7$/$J$&(J $@?7$7$/$J$$$k(J)) ;$@?7$7$/$J$$(J: OK (deftest $@JY6/Cf(J () ($@JY6/(J)) ;$@JY6/Cf(J: OK (deftest $@7k:'<0(J () ($@7k:'(J)) ;$@7k:'<0(J: OK (deftest $@K:$l$b$N(J () ($@K:$l(J $@K:$l$k(J $@K:$k(J)) ;$@K:$l$b$N(J: OK (deftest $@K:$lJ*(J () ($@K:$l(J $@K:$l$k(J $@K:$k(J)) ;$@K:$lJ*(J: OK (deftest $@N99T |$@$3$l$G(Jxinfo$@$GF|K\8l$,I=<($G$-$^$9!%(JEmacs$@$N(Jinfo$@$O;H$$$:$i$+$C$?$N$G!$(J ;; > |xinfo$@$NB8:_$O$H$F$b$"$j$,$?$$$H;W$$$^$9!%(J ;; ;; $@!V;H$$$:$i$+$C$?!W$H$O2?$G$9$+!#(J ;; $@"*!V;H$$$:!W$O!"!V;H$o$:!W$G$9$+!#(J ;; $@"*!V;H$o$J$+$C$?$i!W$G$9$+!#(J ;; $@$G$O!"!V;H$$$:!W$H!V$i$+$C$?!W$H!V$:$i!W$r(Jedict $@$,$o$+$i$J$C$?!#(J ;; $@;d$N@h@8$K?R$M$h$&!#(J (deftest $@>/$J$+$i$:(J () ($@>/$J$$(J $@>/$J$+$k(J $@>/$k(J)) ;$@>/$J$+$i$:(J: OK ;;; Test the various titles. (deftest $@a15H.Bt$/$s(J () ($@>.Bt(J)) ;$@>.Bt$/$s(J: OK (deftest $@@1LnMM(J () ($@@1Ln(J)) ;$@@1LnMM(J: OK (deftest $@8E:d$5$^(J () ($@8E:d(J)) ;$@8E:d$5$^(J: OK ;;; Test the various number cases. (deftest $@Fs?M(J () ($@0l?M(J $@?M(J)) ;$@Fs?M(J: OK (deftest 17$@?M(J () ($@0l?M(J $@?M(J)) ;17$@?M(J: OK (deftest $@#1#7?M(J () ($@0l?M(J $@?M(J)) ;$@#1#7?M(J: OK ;;; This one caused infinite recursion, due to a hole in the ;;; redundant-expansion checking (things didn't get checked for redundancy ;;; quite soon enough, so short cycles weren't detected). (deftest $@=P$F(J () ($@=P$k(J $@=P$F$k(J $@=P$D(J)) ;$@=P$F(J: OK ;;; This one caused infinite recursion, due to failure to root certain ;;; patterns. I've since added checks on the patterns to enforce rootedness. (deftest $@DL$8$k(J () ()) ;$@DL$8$k(J: OK (deftest $@#2. Morphology and private dictionary handling/editing by Bob Kerns . Helpful remarks from Ken-Ichi Handa . The EDICTJ PD dictionary is maintained by Jim Breen . This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. Introduction This software, called edict, helps nemacs/mule users to use the public domain Japanese-English dictionary EDICT. (It is sometimes called EDICTJ, but it is the same thing.) Edict is a set of functions that it helps you to perform: * Search for an English word. With one key command, ie "*", the English word under or in front of the point is used as the key in a search of EDICT. The matching words are shown in a window that is not selected, edict also tries to make the window fit snugly around the matches. * Search for a kanji/kana sequence. Here you mark a region, and then with one key command, ie "_", that region is used as the key in a search of EDICTJ. The matches are presented as above. Edict will attempt to transform the character sequence in the region to a "ground form", ie verbs will be transformed to their plain present form, eg " 使って" to "使う", and also "様" and such postfixes will be stripped from the sequence, then it will search for the transformed sequence in the dictionary. * Inserting one of the matches of a search into the text in the buffer from which the search was initiated. This is also a key command, ie "+". If you perform the command again, the next word in the list of matches will be inserted instead. Edict realizes if the search was done for an English or a Japanese word, and inserts accordingly. * Update a private edict file. If you give a numeric argument, ie C-u, to the two commands above, edict will help you insert this key in a private edict file. The updating is done in an electric mode that tries to ensure that the syntax of the file is correct. Right now the input methods EGG and SKK are supported in the electric mode. Edict is entirely written in emacs lisp. It has been tested and works in Nemacs 3.3.2 and testing has begun in Mule 0.9.2, soon 0.9.3. Short Getting Started Guide The best way to get started using the software is to install it using the install.edict script, if that fails or if you are not to keen to use installation scripts with unknown effects, this is the harder, and more "error prone" way of doing it. This text a more talkative version of the getting started guide in the edict.el file. ** Installing with install.edict. Make a new directory to keep the edict software. Move all the files there. Cd there and run the installation script, eg: cd /usr/local/src/edict ./install.edict ** Installing edict yourself (Indented text includes more information, that you might find useful if you are a novice.) 1. Make sure that you have placed edict.el in a directory that is included in the nemacs's search path, look at the variable "load-path" to make sure that the directory is in that list. One way to get to see the load-path, is to type "load-path", this will print the value in the mini buffer. Another way is to print "load-path" in a buffer that is in lisp interaction mode, like *scratch* when you start nemacs. 2. As mentioned above you will, for convenience, want to define what keys to use when activating the commands. To do that you will have to add something like this to your .emacs (or .nemacs) file: ---------------- 8< ---------------- (autoload 'edict-search-english "edict" "Search for a translation of an English word") (global-set-key "\e*" 'edict-search-english) (autoload 'edict-search-kanji "edict" "Search for a translation of a Kanji sequence") (global-set-key "\e_" 'edict-search-kanji) (autoload 'edict-insert "edict" "Insert the last translation") (global-set-key "\e+" 'edict-insert) ---------------- 8< ---------------- The autoload functions tells nemacs what program file to load when a certain function is referenced. This way the program file does not have to be loaded when nemacs is started, but instead it is started when you first (if at all) use the function. The global-set-key maps a sequence of key strokes a function. Global means that it will be valid for all modes. Note that you can change the key binding to whatever you like, these are only "examples". In your personalized nemacs these three key sequences may be taken or you may prefer something else. 3. You have to tell edict where it can find the edict dictionary. Preferably, Place the edict dictionary in the standard emacs lisp library directory. If you don't have write access there, put it in your ~/emacs directory and make sure that this directory is in the load-path list. You can add a local emacs directory to load-path by, for instance: (setq load-path (cons (concat (getenv "HOME") "/emacs") load-path)) Note that nemacs searches the load path in a "left to right" order, if you put a file in a directory that appears early in the load-path list, this will be loaded in preference of something appearing a later directory. The variable *edict-files* should be a list of filenames of edict dictionary files that you want edict to load and search in. The real dictionary EDICTJ should be one of these files. You may also have have some local file(s) there, like your friend's private edict files. Something like this *may* be appropriate to: (setq *edict-files* '("edictj" "~my-friend-the-user/.edict" "~my-other-friend-the-user/.edict")) By default, nemacs searches the load-path (the same directories that are searched when you do m-X load-fileedict), for a file named "edictj". 4. Set the name of your *own* local edictj file. (Note that this file should not be included in the list above!) Edict will include the additions that you do in this file. The variable *edict-private-file* defaults to "~/.edict", if you want something else do a: (setq *edict-private-file* "~/somewhere/somethingelse") or more sensible (setq *edict-private-file* "~/emacs/private-edict") In UNIX filenames that begin with a "." are "invisible" if you do a plain "ls" command. If you want to see them you have to do a "ls -a", "-a" for "all". Don't forget to submit your useful words to Jim Breen once in a while! His address is . You are done. Please report errors and comments to . Examples Here we will try to give some examples of how it all works. These examples assume that you are reasonably familiar with nemacs and/or mule and that you are familiar with one input method, like EGG or SKK. In these examples, I will use the default key mappings as described above, I hope it is clear what I mean. * Searching for an English word. ** When to use? Just some idle suggestions: Either you are a Japanese speaker and you want to find what an English word means, or you aren't and you want to find out what the Japanese equivalent might be. Note that you can use M-_ just as well for searching for English text, if you want to search for a multi word string. M-* is just usually more convenient. ** How does it work? When you issue the command, M-*, edict will try to find and English word at or in front of the point, much like ispell does. So, for the example below, edict will find the word "dictionary" if the point is at any of the "^" positions. Why would I like to search that dictionary file? ^^^^^^^^^^^ If you are not looking at an English character, edict will scan backwards until it finds the first English character. If you place the point somewhere on dictionary, and press M-*, edict will ask you this in the mini buffer: Translate word (default "dictionary"): If you hit RETURN, the default, "dictionary", will be used. If you don't like the default, you can type something else in. Just hit RETURN, then edict will say: Searching for word "dictionary"... and then after a short while it will say, "Found it!", and also display an unselected window called "*edict matches*", looking something like this: ---------------- 8< ---------------- 辞書 [じしょ] /dictionary/ ディクショナリ /dictionary/ 字引 [じびき] /dictionary/ 辞典 [じてん] /dictionary/ 英和 [えいわ] /English-Japanese (e.g. dictionary)/ 広辞苑 [こうじえん] /Kojien (pn) (Japanese Dictionary)/ 電子辞書 [でんしじしょ] /electronic dictionary/ ---------------- 8< ---------------- The matches are sorted so that "clear matches", like the first 4 above, are at the top. This is to aid you when you try to find the "correct" match. English verbs that are inserted into the dictionary as "/to something/" are also considered to be "clear matches". So if you search for "use", you will get: ---------------- 8< ---------------- 用いる [もちいる] /to use/to make use of/ 役 [やく] /use/service/role/position/ 採用 [さいよう] /use/adapt/ 行使 [こうし] /use/exercise/ 使う [つかう] /to use/ 用 [よう] /task/business/use/ 用途 [ようと] /use/usefulness/ 仍て [よって] /accordingly/because of/ 両用 [りょうよう] /dual use/ 利用 [りよう] /use (vs)/utilization/ 要因 [よういん] /primary factor/main cause/ 洋館 [ようかん] /western-style house/ 有用 [ゆうよう] /useful (an)/helpful/ 憂さを晴らしに /for amusement/by way of diversion (distraction from grief)/ ---------------- 8< ---------------- and a lot of other matches. "Clear matches" are at the top, and not so clear matches are at the bottom. ** What is an English character? What is romaji? When edict tries to find and English word, it will look for something that *looks* like and English word. This means that even strings that are in JIS/EUC will be considered to be English text, these will be remapped to ASCII before they are used as keys in a search. Examples of English strings: string ｓｔｒｉｎｇ ｓｔｒing These will be remapped to "string" before searching. * Searching for a Japanese string. Searching for a Japanese string is currently slight more complicated. Edict can currently not find the word boundaries in Japanese text. (This will change soon, edict will in the future try to make an educated guess based on the grammar of the sentence under the point. 私はedictを使っている。 ^ ^ 1 2 Say that you want to search for "使って". What you have to do is to move to the starting char, 1 above, and press C-, nemacs will then say, "Mark set", in the mini buffer. Then you move to the first char after the string you want to search for, to 2 above, char "い". Now you have marked a region, now you can do the command M-_. Edict will say "Searching for word "使って" and then in rapid sequence show the remappings, don't bother about those. It will find the word "使う " in the dictionary and in a separate window display: ---------------- 8< ---------------- 使う [つかう] /to use/ ---------------- 8< ---------------- This example showed that edict tries to map verbs and adjectives back to their plain form. Edict can also clean up a string from "alien" chars, for instance the sequence that you want to search for has been split in a news article like this: 私はedictを使 >> っている。 If you now put the mark at the same chars as before, 使 and い, edict will first clean up the string, ie remove the newline and the ">" chars and leading white space. Then it will apply the transformation rules. The chars that edict will remove in strings are currently: "　-〆―-∇ \n\t>;!:#?,.\"/@─-╂", there are specified in the *edict-kanji-whitespace* variable. If you want other chars, please add to this string, and also tell us what you prefer so that it can be incorporated into future releases of edict. Edict also tries to remove postfixes that carry "no" information, or even if they carry information they might not be in the dictionary with that (possibly) common postfix. An example of a postfix is "様". Searching for this string: 田中様 will find: ---------------- 8< ---------------- 田中 [たなか] /Tanaka (pn)/ 上小田中 [かみこたなか] /Kamikotanaka (pl)/ 下小田中 [しもこたなか] /Shimokotanaka (pl)/ ---------------- 8< ---------------- * Inserting from the list of matches. What do you do with a match when you have found it? Obviously, you may be reading and using edict to find words that you don't understand. One might also use edict to find words when writing, we believe that it is should be convenient for writing both Japanese and English. Again, searching for the word "search" will give you ---------------- 8< ---------------- 探す [さがす] /to search/to seek/to look for/ サーチ /search/ 探索 [たんさく] /search/ 捜査 [そうさ] /search (vs)/investigation/ 査読 [さどく] /investigative reading/research/ 研究所 [けんきゅうしょ] /research lab/ 研究会 [けんきゅうかい] /research society/ 研究 [けんきゅう] /study (vs)/research/investigation/ 客員研究員 [きゃくいんけんきゅういん] /visiting researcher/ 研究員 [けんきゅういん] /researcher/ 研究開発 [けんきゅうかいはつ] /R&D/research & development/ 研究生 [けんきゅうせい] /research student/ 捜す [さがす] /to seek/to search for/to look for/ 探索木 [たんさくぎ] /search tree/ ---------------- 8< ---------------- If you now hit M-+, edict will insert the first match (探す) at point, and then if you hit M-+ again, it will replace the first one it inserted with the second. When it comes to the end of the list it wraps. You can also use this command with a numerical argument, getting the nth match in the list, starting with row 1. So C-u 3 M-+ will give you: "探索". Edict works similarly for inserting English strings. Searching for " 探" will give you: ---------------- 8< ---------------- 探索木 [たんさくぎ] /search tree/ 探求 [たんきゅう] /quest/pursuit/ 手探り [てさぐり] /fumbling (vs)/groping/ 探す [さがす] /to search/to seek/to look for/ 探索 [たんさく] /search/ 探偵 [たんてい] /detective work/ ---------------- 8< ---------------- Doing the insert command will then give you in sequence: "search tree", "quest", "pursuit", "fumbling (vs)", etc. Note that all the matching English phrases are used. * Inserting and entry in the private edict file. OK, so what do you do if you cannot find a match? Or what do you do if you have a large set of words that you would like to insert into the dictionary? ** Searching for a word edict cannot find. Say that you search for "gazillion", then edict will tell you "No matches for key "gazillion". No you can redo the command, but with a numerical argument, ie C-u M-*, then you wind up in a buffer with edict electric mode with a newly created entry with the missing word at the correct place. The file in the buffer will be your private edict file. So, C-u M-* will give you: ---------------- 8< ---------------- [] /gazillion/ ---------------- 8< ---------------- Note now that you are in an "electric" environment, ie some keys do specialized things. TAB will move to the next slot, RETURN will create a new entry. When you move from slot to slot with TAB, edict will make sure that the correct input mode is active, ie you can insert Japanese in the Japanese slots and english in the english slots. You stop editing your private edict file by doing a save command, ie C-x C-s. I works similarly for an unknown Japanese string. You can also start these commands by doing M-x edict-add-word, M-x edict-add-english, or M-x edict-add-kanji. The last command has to be given a region, as usual with Japanese. TODO If you have any suggestions, please state them! Send them to , sending both text and an example of what functionality you want is probably best. If you think about contributing code, please make sure that you have the most recent version of edict.el before you start to hack around in it! Apart from that, to minimize wasted efforts and difficult merging sessions, please contribute code. * Edict will (quite) soon make an educated guess at what it is that you want to translate, search for, when you are looking at a Kanji/Kana characters. It will basically improve the forward-word backward-word functionality, since it does not work on Japanese text. When this starts to work, most searches will be performed with "M-*". This will simplify the user interface. * Edict will have (more) functionality for "intext replacement" of what one translated. This is convenient when writing for both speakers of Japanese and English. Silly Index Phrases that you might be wondering about. * More edict dictionaries, Short Getting Started Guide. * Input methods, EGG and SKK, and where to find them. edict-el-1.06.orig/edict.el.0960100644000175000017500000020424406524336052015350 0ustar rolandroland;;; ;;; Copyright (C) 1991, 1992 Per Hammarlund (perham@nada.kth.se) ;;; ;;; ;;; Some code that looks for translations of english and japanese using the ;;; EDICTJ Public Domain japanese/english dictionary. ;;; ;;; Written by Per Hammarlund ;;; Morphology and private dictionary handling/editing by Bob Kerns ;;; Helpful remarks from Ken-Ichi Handa . ;;; The EDICTJ PD dictionary is maintained by Jim Breen ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 1, or (at your option) ;;; any later version. ;;; ;;; This program is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with this program; if not, write to the Free Software ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; ;;; ;;; Short getting started guide, this assumes that you have not used ;;; the install script and that you understand the "technical" words ;;; used, if you don't, please read the documentation in edict.doc: ;;; ;;; 1. Make sure that you have placed edict.el in a directory that is included ;;; in the nemacs's search path, look at the variable "load-path" to make sure ;;; that the directory is in that list. ;;; ;;; 2. Add something like this to your .emacs (or .nemacs) file: ;;; (autoload 'edict-search-english "edict" "Search for a translation of an English word") ;;; (global-set-key "\e*" 'edict-search-english) ;;; (autoload 'edict-search-kanji "edict" "Search for a translation of a Kanji sequence") ;;; (global-set-key "\e_" 'edict-search-kanji) ;;; (autoload 'edict-insert "edict" "Insert the last translation") ;;; (global-set-key "\e+" 'edict-insert) ;;; Note that you can change the key binding to whatever you like, these are only "examples". ;;; ;;; 3. The variable *edict-files* should be a list of filenames of ;;; edict dictionary files that you want edict to load and search ;;; in. The real dictionary EDICTJ should be one of these files, ;;; you may also have have some local file(s) there. Something ;;; like this *may* be appropriate to: ;;; (setq *edict-files* '("edictj" ;;; "~my-friend-the-user/.edict" ;;; "~my-other-friend-the-user/.edict")) ;;; By default, it searches the load path (the same directories that are searched ;;; when you do m-X load-fileedict), for a file named "edictj". ;;; ;;; 4. Set the name of your *own* local edictj file. (Note that this file should ;;; not be included in the list above!) Edict will include the additions that ;;; you do in this file. The variable *edict-private-file* defaults to "~/.edict", ;;; if you want something else do a: ;;; (setq *edict-private-file* "~/somewhere/somethingelse/") ;;; (Don't forget to submit your useful words to Jim Breen once in a ;;; while! His address is jwb@monu6.cc.monash.edu.au) ;;; ;;; You are done. Report errors and comments to perham@nada.kth.se. ;;; ;;;cl.el is part of gnuemacs, so it should be no problem to require ;;; these Common Lisp extensions. (require 'cl) ;;; This should exist, but doesn't. See edict.install for the ;;; compiler half of this. You should be sure to load the same ;;; hacks into your compiler if you compile this by hand, or you ;;; won't get it byte compiled. (defmacro eval-when (when &rest forms) (and (or (member 'eval when) (member ':execute when)) (mapcar (function eval) forms)) (and (or (member 'load when) (member ':load-toplevel when)) (cons 'progn forms))) (defvar *edict-private-file* "~/.edict" "*This is the edict dictionary where the user's entries will be added.") ;;*edict-files* should contain a list of filenames for the files that ;; should be read up into the *edict* buffer. (defvar *edict-files* '("edictj") "*This is a list of edict files that are loaded into the *edict* buffer and searched. You will probably want at least one of them to be the real EDICT file.") ;;The edict buffer where the data base, of sorts, is and the buffer ;; variable. (defvar *edict-buffer-name* "*edict*") (defvar *edict-buffer* nil) ;;The edict matches buffer and the name of it (defvar *edict-match-buffer-name* "*edict matches*") (defvar *edict-match-buffer* nil) (defvar *edict-version-date* "920423 [平成４年４月２３日(木)]" "The variable *edict-version-date* contains a string with the date when this version was released. In both Swedish and Japanese standards") (defvar *edict-version* "0.9.6" "The variable *edict-version* contains a string that describes what version of the edict software that you are running.") (defun edict-version () "The function edict-version simply displays (as a message in the mini-buffer) the version of the edict software that you are running at the moment. The same string is also returned from the function." (interactive) (message (concat "Edict version " *edict-version* " of " *edict-version-date*))) ;;; Marker so we can find the individual files in the buffer. (defvar *edict-file-begin-marker* "<<<<<<<<<<<<<<<<") (defvar *edict-file-end-marker* ">>>>>>>>>>>>>>>>") ;;; This is the set of characters to be ignored in the middle of kanji ;;; words being looked up. ;;; The 〆 below should be ○, but there seems to be an off-by-one error ;;; in the regexp code. (defvar *edict-kanji-whitespace* "　-〆―-∇ \n\t>;!:#?,.\"/@─-╂") ;;; This is the set of characters to be ignored in the middle of english ;;; words being looked up. ;;; The 〆 below should be ○, but there seems to be an off-by-one error ;;; in the regexp code. (defvar *edict-eigo-whitespace* "　-〆―-∇ \n\t>;!:#?,.\"/@─-╂") (defvar *edict-eigo-characters* "[A-Za-zＡ-Ｚａ-ｚ]" "These are the characters that eigo is made up of.") (defvar *edict-unreadable-error* "While loading edict files: \"%s\" isn't readable!") (defvar *edict-non-existent-error* "While loading edict files: \"%s\" doesn't exist!") ;;; ;;;Reads the edict files (the ones in the list *edict-files*) into a buffer ;;; called what the string *edict-buffer-name* is set to. ;;; (defun edict-init () "Reads the edict file into a buffer called *edict*. This is done only once and the *edict-buffer* is created. Use the function edict-force-init to reread the edict files." ;;create a match buffer. (if (not (get-buffer *edict-match-buffer-name*)) (setq *edict-match-buffer* (get-buffer-create *edict-match-buffer-name*))) ;;Check that we have a list of strings, we will check that they are readable below. (if (not (listp *edict-files*)) ;;report an error and fail... (error "The variable *edict-files* should be a list of paths to edict files!") ;;Check for strings if it was a list. (if (notevery 'stringp *edict-files*) (error "Something in the list *edict-files* is not a string (path)!"))) ;;Create and read the edict files. (if (not (get-buffer *edict-buffer-name*)) (progn (save-window-excursion ;;First create the buffer and make it the current one (setq *edict-buffer* (get-buffer-create *edict-buffer-name*)) (set-buffer *edict-buffer*) ;;Read in the files from the list. (mapcar (function (lambda (filename) (catch 'found-file (dolist (dir load-path) (let ((file (expand-file-name filename dir))) (if (file-exists-p file) (if (file-readable-p file) (throw 'found-file (edict-add-file file)) (message (format *edict-unreadable-error* filename))) (message (format *edict-non-existent-error* filename)))) ;; If it's an absolute pathname, no need for a search. (when (or (equal (substring filename 0 1) "/") (equal (substring filename 0 1) "~")) (throw 'found-file nil)))))) (if *edict-private-file* (cons *edict-private-file* *edict-files*) *edict-files*)) ;;If none of the files were readable (if (= 0 (buffer-size)) (progn (kill-buffer *edict-buffer*) (error "No edict files found! Check value of *edict-files*."))) ))) t) ;;; ;;; ;;; (defun edict-force-init () "This function always rereads the edict files even if there is a edict buffer, named by the variable *edict-buffer-name*. Usefule when you have updated the *edict-files* variable or corrupted the edict buffer." (interactive) (kill-buffer *edict-buffer*) (edict-init)) ;;; ;;; Add file filename to the current buffer with the begin end markers around that file... ;;; (defun edict-add-file (filename) "This function adds a file, filename, to the current buffer. A *edict-file-begin-marker* and *edict-file-end-marker* are placed around the file contents." (goto-char (point-max)) (insert (format "%s %s\n" *edict-file-begin-marker* filename)) (let ((pos (point))) (insert-file-contents filename) (goto-char (point-max)) (insert (format "%s %s\n" *edict-file-end-marker* filename)) (goto-char pos) (when (looking-at "？？？？ /\\([ -.0-\177]+\\)/") (message "Loaded dictionary %s." (buffer-substring (match-beginning 1) (match-end 1)))) (goto-char (point-max)))) ;;; ;;; Remove any leading, trailing, or imbedded whitespace or other noise characters ;;; (such as the inserted ">" etc. used to denote inserted quotations in mail and ;;; news) ;;; (defun edict-clean-up-kanji (key) (let ((start 0) (loc 0) (end (length key)) (result "") (pattern (concat "[" *edict-kanji-whitespace* "]+"))) (while (and (< start end) (setq start (string-match pattern key start))) (setq result (concat result (substring key loc start))) (setq loc (setq start (match-end 0)))) (concat result (substring key loc)))) (defvar *edict-romaji-remaps* nil) (setq *edict-romaji-remaps* '(("ａ" . "a") ("ｂ" . "b") ("ｃ" . "c") ("ｄ" . "d") ("ｅ" . "e") ("ｆ" . "f") ("ｇ" . "g") ("ｈ" . "h") ("ｉ" . "i") ("ｊ" . "j") ("ｋ" . "k") ("ｌ" . "l") ("ｍ" . "m") ("ｎ" . "n") ("ｏ" . "o") ("ｐ" . "p") ("ｑ" . "q") ("ｒ" . "r") ("ｓ" . "s") ("ｔ" . "t") ("ｕ" . "u") ("ｖ" . "v") ("ｗ" . "w") ("ｘ" . "x") ("ｙ" . "y") ("ｚ" . "z") ("Ａ" . "A") ("Ｂ" . "B") ("Ｃ" . "C") ("Ｄ" . "D") ("Ｅ" . "E") ("Ｆ" . "F") ("Ｇ" . "G") ("Ｈ" . "H") ("Ｉ" . "I") ("Ｊ" . "J") ("Ｋ" . "K") ("Ｌ" . "L") ("Ｍ" . "M") ("Ｎ" . "N") ("Ｏ" . "O") ("Ｐ" . "P") ("Ｑ" . "Q") ("Ｒ" . "R") ("Ｓ" . "S") ("Ｔ" . "T") ("Ｕ" . "U") ("Ｖ" . "V") ("Ｗ" . "W") ("Ｘ" . "X") ("Ｙ" . "Y") ("Ｚ" . "Z"))) ;;; ;;; Lookup a mapping for zenkaku roman characters to ASCII. ;;; (defun edict-in-remap-list (item list) "Look for ITEM in LIST; return first link in LIST whose car is `equal' to ITEM." (let ((ptr list) (done nil) (result '())) (while (not (or done (endp ptr))) (cond ((string= item (car (car ptr))) (setq done t) (setq result ptr))) (setq ptr (cdr ptr))) result)) ;;; ;;; Remap zenkaku roman characters to ASCII. ;;; (defun edict-remap-romaji (eigo-string) (let ((stop (length eigo-string)) (current 0) (match nil) (result "")) (while (< current stop) (if (< (+ 1 current) stop) (setq match (edict-in-remap-list (substring eigo-string current (+ 2 current)) *edict-romaji-remaps*)) (setq match nil)) (if match (progn (setq result (concat result (cdr (car match)))) (setq current (+ 2 current))) (progn (setq result (concat result (substring eigo-string current (1+ current)))) (setq current (1+ current))))) result)) ;;; ;;; Eliminate extra whitespace, newlines, punctuation, etc. which would ;;; interfere with our dictionary lookup. ;;; (defun edict-clean-up-eigo (key) (let ((start 0) (loc 0) (end (length key)) (result "") (pattern (concat "[" *edict-eigo-whitespace* "]+"))) (while (and (< start end) (setq start (string-match pattern key start))) (setq result (concat result (substring key loc start) " ")) (setq loc (setq start (match-end 0)))) (setf result (concat result (substring key loc))) (edict-remap-romaji result))) ;;; ;;; slightly specialized function to be changed when the real backward word things are included. ;;; (defun edict-eigo-one-word (direction) "The function edict-eigo-one-word goes one word forward (direction > 0) or backward (direction <= 0). It assumes that is is looking at a word when invoked. It returns the point either at the beginning of a word or at the whitespace after a word." (let ((stop-point (point)) (stop nil)) (if (> direction 0) ;;forward (progn (while (not stop) (setq stop-point (point)) (if (< (point) (point-max)) (if (looking-at *edict-eigo-characters*) (forward-char 1) (setq stop t)) (setq stop t)))) ;;backward (progn (while (not stop) (setq stop-point (point)) (if (> (point) (point-min)) (if (looking-at *edict-eigo-characters*) (backward-char 1) (progn (setq stop t) (forward-char 1) (setq stop-point (point)))) (setq stop t ))))) stop-point)) ;;; ;;; perham ;;; (defun edict-find-word-at-point () "Find-word-at-point tries to find an English word close to or behind point. If it does not find any word it reports an error." (let (start end) ;; Move backward for word if not already on one. (if (not (looking-at *edict-eigo-characters*)) (re-search-backward *edict-eigo-characters* (point-min) 'stay)) (if (looking-at *edict-eigo-characters*) (progn (setq start (edict-eigo-one-word -1)) (setq end (edict-eigo-one-word 1)) (edict-clean-up-eigo (buffer-substring start end))) (error "Can't find English word!") ))) ;;; ;;; ;;; (defun edict-search-english (arg) "Attempts to translate the english word we are looking at. Picks the word in the same way as ispell, ie backs up from whitespace, and then expands. Result is presented in a window that is not selected. Clear the window by using a negative prefix argument. If given an argument, adds an english word to the private dictionary." (interactive "P") (if arg (if (< (prefix-numeric-value arg) 0) (edict-restore-display) (edict-add-english)) (let ((word (edict-get-english-word))) ;;Search if there is a word. (when word (edict-search-and-display word 'english))))) ;;; Return the english word, or nil (defun edict-get-english-word () (let (word real-word) ;;Find the word (setq word (edict-find-word-at-point)) ;;ask the user if this is really the word that is interesting. (setq real-word (read-string (format "Translate word (default \"%s\"): " word))) (setq real-word (edict-clean-up-eigo real-word)) (if (equal real-word "") (if (equal word "") nil word) real-word))) ;;; ;;; ;;; (defun edict-search-kanji (arg min max) "Attempts to translate the Kanji sequence between mark and point. Result is presented in a window that is not selected. Clear the window with for instance C-X 1 Given a numeric argument, this adds the Kanji sequence to the user's private dictionary." ;;Interactive, with a region as argument (interactive "P r") ;;make sure that the dictionary is read (edict-init) (if arg (if (< (prefix-numeric-value arg) 0) (edict-restore-display) (edict-add-kanji min max)) (let ((word (edict-clean-up-kanji (buffer-substring min max)))) (if (equal word "") (error "No word to search for!") (edict-search-and-display word '日本語)))) t) ;;; ;;; ;;; (defun edict-copy-of-current-line () "Copy-of-current-line creates and returns a copy of the line where point is. It does not affect the buffer it is working on, except for moving the point around. It leaves the point at the end of the line, which is fine for this application." ;;Find the start and end of the current line (let ((line-start (progn (beginning-of-line) (point))) (line-end (progn (end-of-line) (point)))) ;;return a copy of his line, perham, is there something that ;; should be tested here? (buffer-substring line-start line-end))) ;;; ;;; ;;; (defun edict-search (key buffer) "Searches the *edict-buffer* and returns a list of strings that are the matches. If there are no matches this string will be nil." ;;perham, should this really go here? Or what should we have? Look ;;at ispell.el... (save-window-excursion (message (format "Searching for word \"%s\"..." key)) (let ((match-list nil)) ;;select the database and goto to the first char (set-buffer buffer) (goto-char (point-min)) ;;Search for lines that match the key and copy the over to the ;; match buffer. (while (edict-search-key key) (setq match-list (edict-union match-list (list (edict-copy-of-current-line))))) match-list))) (defun edict-search-key (key) (search-forward ;Ken-ichi says that one cannot ;use the re-search-forward ;function with actually having ;some reg exp in the starget string. ;(concat "[\[/ ;]" key "[\]/ ]") key nil t)) ;;; ;;; ;;; (defvar *edict-previous-configuration* nil) (defun edict-note-windows () (or *edict-previous-configuration* (setq *edict-previous-configuration* (current-window-configuration)))) ;;; This doesn't work yet; leave it set to 'top! (defvar *edict-window-location* 'top "*Location to place edict matches window. top or bottom. Doesn't work yet.") (defun edict-display (key-list match-list) "Edict-display displayes the strings in a separate window that is not selected." (let* ((text-window (get-buffer-window (current-buffer))) (edict-window (get-buffer-window *edict-match-buffer*)) ;; We have available some of this window's height plus any we've already ;; already gotten. (avail-height (+ (window-height text-window) (if edict-window (window-height edict-window) 0))) ;; We limit the height to half of what's available, but no more than we need, ;; and no less than window-min-height. We must remember to include 1 line for ;; the mode-line in our minimum figure. (height (min (max window-min-height (+ (length match-list) 1)) (/ avail-height 2)))) (if (not edict-window) (progn ;; We don't have a window, so remember our existing configuration, ;; and either find an acceptable window to split, or use the current ;; window. (edict-note-windows) (let ((use-window (edict-find-acceptable-window text-window))) (if use-window (setq edict-window use-window text-window (split-window text-window height)) (setq edict-window text-window)))) ;; We have a window already. Just adjust its size appropriately. (unless (equal height (window-height edict-window)) (let ((selected (selected-window))) (select-window edict-window) (enlarge-window (- height (window-height edict-window)))))) (set-buffer *edict-match-buffer*) (let ((min (point-min))) ;; Replace everything. (erase-buffer) (mapcar (function (lambda (string-item) (insert string-item) (newline))) match-list) (when (eq *edict-window-location* 'bottom) (let ((w text-window) (setq text-window edict-window edict-window text-window)))) ;; OK, now let's move the exact matches to the top. (goto-char min) ;; Be careful to preserve the order. ;; An exact match is any of "^key ", "[key]", "/key/", or "/to key/". (dolist (key (reverse key-list)) (let* ((pattern (concat "^" key " \\|\\[" key "\\]\\|\\/" key "\\/\\|\\/to " key "\\/" )) (top-lines nil)) ;; First pull them out of the buffer into a list (top-lines). ;; Then re-insert them at the top. (while (re-search-forward pattern nil t) (forward-line 0) (let ((p (point))) (forward-line 1) (push (buffer-substring p (point)) top-lines) (delete-region p (point)))) (goto-char min) (mapcar 'insert top-lines))) ;; OK, display it all. (select-window text-window) (set-window-buffer edict-window *edict-match-buffer*) (set-window-start edict-window min))) t) ;;; Find a window which is of acceptable size to split. ;;; It must be at least twice window-min-height. (defun edict-find-acceptable-window (window) (catch 'no-window (let ((new-window window)) (while (< (window-height new-window) (* 2 window-min-height)) (setq new-window (next-window new-window)) (when (eq new-window window) (throw 'no-window nil))) new-window))) ;;; Try to put the display back the way it was before showing matches. (defun edict-restore-display () "Remove the edict windows." (when *edict-previous-configuration* (set-window-configuration *edict-previous-configuration*)) (setq *edict-previous-configuration* nil) t) ;;; Variables to remember the last insertion of a match into our ;;; buffer, for later replacement. (defvar edict-last-language nil) (defvar edict-insert-last-start) (defvar edict-insert-last-end) ;;; ;;; ;;; (defun edict-search-and-display (key &optional from-language) "Edict-search-and-display searches for matches to the argument key. If there are any matches these are displayed in a window that is not selected. This window can be removed with C-X 1." (edict-init) ;; Remember the last language looked up, so edict-insert can pick the ;; right one. (setq edict-last-language from-language) (save-excursion (let ((match-list nil) (one-char-keys nil) (key-list (edict-expand-string key () () (or from-language '日本語)))) ;; Sort them into the order we'd like exact matches to appear. (setq key-list (sort key-list (function (lambda (x y) (let ((lx (length x)) (ly (length y))) (if (= lx ly) (string-lessp x y) (> lx ly))))))) ;; For all the possibilities (dolist (key key-list) ;; Search for matches. We exlude any one-character keys on the theory that they're ;; likely to be uninteresting fragments. (if (string-match "^[、-瑤]$" key) ;1 char (push key one-char-keys) (setq match-list (edict-union match-list (edict-search key *edict-buffer*))))) ;; If we didn't get anything, we can try including the one-char keys. (or match-list (dolist (key one-char-keys) (setq match-list (edict-union match-list (edict-search key *edict-buffer*))))) (if (not match-list) (edict-delete-matches-window)) (edict-display key-list match-list)) (message "Found it!"))) (defun edict-insert (arg) "Insert the last value looked up at the current position. If repeated, replace with the next possibility. If given an argument N, use the Nth possibility. Inserts in the opposite language from what was looked up, unless the argument is negative." (interactive "P") ;; If we were given a negative argument, we need to switch languages. (cond ((null arg)) ((> (prefix-numeric-value arg) 0)) (t (case arg (- (setq arg nil)) (otherwise (setq arg (list (- (prefix-numeric-value arg)))))) (setq edict-last-language (ecase edict-last-language (english '日本語) (日本語 'english))))) (ecase edict-last-language (english (edict-insert-日本語 arg)) (日本語 (edict-insert-english arg)))) (defun edict-insert-english (arg) "Insert the last english word looked up at the current position. If repeated, replace with the next possibility. If given an argument N, use the Nth possibility." (interactive "P") (or *edict-match-buffer* (error "You must first look up a word.")) (let ((value nil)) (save-excursion (set-buffer *edict-match-buffer*) ;; If we're going to a specific one, always count from the beginning. (when arg (goto-char (point-min))) ;; If the last command was this, then we're going on to the next possibility. ;; Otherwise, start at the beginning. (case last-command (edict-insert-english) (t (goto-char (point-min)))) ;; Seach forward for // If we don't find one, start over from the ;; beginning. (unless (re-search-forward "/\\([^/\n]+\\)/" (point-max) t (prefix-numeric-value arg)) (goto-char (point-min)) (unless (or arg (re-search-forward "/\\([^/\n]+\\)/" (point-max) t)) (error "No match numbered %d found." (prefix-numeric-value arg)))) ;; Extract the match. Leave ourselves just before the final /, ;; so if it starts a new definition, we'll find it. (goto-char (match-end 1)) (setq value (buffer-substring (match-beginning 1) (match-end 1)))) ;; If we inserted one of our languages, then we should delete the old ;; one first. (case last-command ((edict-insert-english edict-insert-日本語) (delete-region edict-insert-last-start edict-insert-last-end))) ;; Insert, remembering where we did it, so it can be replaced if we ;; repeat the command. (setq edict-insert-last-start (point-marker)) (insert value) (setq edict-insert-last-end (point-marker))) ;; Remember this as the last command, not edict-insert. (setq this-command 'edict-insert-english) t) (defun edict-insert-日本語 (arg) "Insert the last 日本語 word looked up at the current position. If repeated, replace with the next possibility. If given an argument N, use the Nth possibility." (interactive "P") (or *edict-match-buffer* (error "You must first look up a word.")) (let ((value nil)) (save-excursion (set-buffer *edict-match-buffer*) ;; If we're going to a specific one, always count from the beginning. (when arg (goto-char (point-min))) ;; If the last command was this, then we're going on to the next possibility. ;; Otherwise, start at the beginning. (case last-command (edict-insert-日本語) (t (goto-char (point-min)))) ;; Seach forward for a word at the start of a line. If we don't find one, ;; start over from the beginning. (unless (re-search-forward "^\\(\\(\\ch\\|\\ck\\|\\cK\\|\\cc\\|\\cC\\)+\\)[ \t]" (point-max) t (prefix-numeric-value arg)) (goto-char (point-min)) (unless (or arg (re-search-forward "^\\(\\(\\ch\\|\\ck\\|\\cK\\|\\cc\\|\\cC\\)+\\)[ \t]" (point-max) t)) (error "No match numbered %d found." (prefix-numeric-value arg)))) (goto-char (match-end 1)) (setq value (buffer-substring (match-beginning 1) (match-end 1)))) ;; If we inserted one of our languages, then we should delete the old ;; one first. (case last-command ((edict-insert-日本語 edict-insert-english) (delete-region edict-insert-last-start edict-insert-last-end))) ;; Insert, remembering where we did it, so it can be replaced if we ;; repeat the command. (setq edict-insert-last-start (point-marker)) (insert value) (setq edict-insert-last-end (point-marker))) ;; Remember this as the last command, not edict-insert. (setq this-command 'edict-insert-日本語) t) ;;; Remove the matches window from the screen. ;;; This is harder than you'd think. (defun edict-delete-matches-window () (interactive) (let ((window (get-buffer-window *edict-match-buffer*))) (when window (let* ((selected (selected-window)) (next (previous-window window)) (height (window-height window)) (nedges (window-edges next)) (tedges (window-edges window))) (delete-window window) ;; The following is sheer magic. Deleting a window is not ;; an inverse to splitting a window. The space is returned ;; not to the window below, OR to the window above, but ;; rather is divided between them. (when (and (equal (car nedges) (car tedges)) (< (car (cdr nedges)) (car (cdr tedges)))) (select-window next) (shrink-window (/ (- height 1) 2)) (select-window selected)))) (error "No matches for key \"%s\"." key))) ;;; The previous configuration before adding an entry to a private dictionary. (defvar edict-previous-window-configuration nil) ;;; The previously-selected buffer before adding an entry. (defvar edict-previous-buffer nil) ;;; The filename of the file read in to add an entry to. (defvar edict-filename nil) ;;; Add an entry to a particular file, and update *edict-buffer*. ;;; Any of kanji/yomi/eigo may be omitted. The user will be given ;;; an oportunity to edit and then it will be saved. (defun edict-add-entry-to-file (filename kanji yomi eigo) (edict-init) (setq filename (expand-file-name filename)) (let* ((previous-buffer (current-buffer)) (buffer (find-file-noselect filename)) (window (get-buffer-window buffer))) (set-buffer buffer) ;; If it's a new file, give it a version string to print on loadup. (when (equal (point-min) (point-max)) (insert (format "？？？？ /%s's private dictionary/\n" (user-login-name)))) ;; Unless it's already in edict-edit mode, put it in that mode. ;; This gives us our fancy electric-dictionary editing. (unless (eq major-mode 'edict-edit-mode) (edict-edit-mode)) ;; Unless we already have a configuration to go back to, remember ;; this one. (unless edict-previous-window-configuration (setq edict-previous-window-configuration (current-window-configuration))) (unless edict-previous-buffer (setq edict-previous-buffer previous-buffer)) ;; Remember the filename, so we can update it in the *edict* buffer ;; when we finish. (setq edict-filename filename) (if window (select-window window) (split-window nil 4)) (goto-char (point-max)) (edict-insert-entry kanji yomi eigo) ;; Go into henkan mode if appropriate (switch-to-buffer buffer) (edict-set-henkan (or (null kanji) (null yomi))))) ;;; Turn on or off henkan (defun edict-set-henkan (henkan-flag) (cond ;;EGG ((fboundp 'egg:mode-line-display) (setq egg:*mode-on* henkan-flag egg:*input-mode* t) (egg:mode-line-display) ) ;;SKK ((fboundp 'skk-version) ;;This is a crude way of doing it, but it should give no secondary effects. (skk-mode (if henkan-flag 1 -1)) ) )) ;;; Insert a dictionary entry at point. (defun edict-insert-entry (kanji yomi eigo) ;; Make sure this is on a line of its own. (let ((p (point))) (beginning-of-line) (unless (equal p (point)) (end-of-line) (newline))) ;; Now insert a standard entry. (let ((start (point)) (p nil)) ;; Insert a new entry, leaving out any items which are nil, ;; and also leaving out the yomi if the entry consists of only kana. ;; "日本語" (if kanji (insert kanji) (setq p (point))) (when yomi (unless (string-match "^\\(\\ch\\|\\cH\\|\\ck\\|\\cK\\)+$" yomi) (error "yomi must be in kana: %s." yomi))) ;; "日本語 [にほんご]" (cond ((and kanji (string-match "^\\(\\ch\\|\\cH\\|\\ck\\|\\cK\\)+$" kanji))) (t (insert " [") (if yomi (insert yomi) (if (not p) (setq p (point)))) (insert "]"))) ;; "日本語 [にほんご] /Japanese language/" (cond ((null eigo) (insert " /") (unless p (setq p (point)))) ((stringp eigo) (insert " /" eigo)) ((consp eigo) (insert " ") (dolist (def eigo) (insert "/") (insert def))) (t (error "not a string or list of strings: %s" eigo))) (insert "/\n") ;; Go to the first un-filled-in field. (goto-char (or p start)))) ;;; Inverse of edict-insert-entry. Parse an entry. ;;; (multiple-value-bind (kanji yomi english) (edict-parse-entry) ;;; (edict-insert-entry kanji yomi english)) ;;; duplicates the current line's entry. (defun edict-parse-entry () (let ((kanji nil) (yomi nil) (english nil) (start nil) (p nil) (end nil)) (save-excursion (end-of-line) (setq end (point)) (beginning-of-line) (setq start (point)) (search-forward " " end) (setq p (1- (point))) (when (> p start) (setq kanji (buffer-substring start p))) ;; Pick up the [yomi] if there are any. (when (re-search-forward "\\[\\(\\ch\\|\\cH\\|\\ck\\|\\cK\\)+\\]" end t) (setq yomi (buffer-substring (match-beginning 1) (match-end 1))) (goto-char (match-end 0))) ;; Collect up all the definitions. (while (re-search-forward "/\\([^/\n]+\\)/" end t) (goto-char (match-end 1)) (push (buffer-substring (match-beginning 1) (match-end 1)) english))) (values kanji yomi english))) (defvar edict-edit-mode-map () "Mode map used by edict-add-english/kanji.") ;;; Initialize our mode map. (unless edict-edit-mode-map (setq edict-edit-mode-map (make-keymap)) (dotimes (i 128) ;; I don't know how to invoke multi-char commands, so don't hook ;; those. (unless (consp (aref edict-edit-mode-map i)) (setf (aref edict-edit-mode-map i) 'edict-standin))) (setf (aref edict-edit-mode-map 3) nil (aref edict-edit-mode-map 24) nil (aref edict-edit-mode-map 27) nil) (define-key edict-edit-mode-map "\C-c\C-c" 'edict-exit) (define-key edict-edit-mode-map "\C-x\C-s" 'edict-exit) (define-key edict-edit-mode-map "\t" 'edict-tab) (define-key edict-edit-mode-map "\r" 'edict-new-entry) (define-key edict-edit-mode-map "\C-A" 'edict-beginning-of-line) (define-key edict-edit-mode-map "\C-E" 'edict-end-of-line) (define-key edict-edit-mode-map "\C-x\C-s" 'edict-exit) (define-key edict-edit-mode-map "\C-x\C-s" 'edict-exit) (define-key edict-edit-mode-map "\C-x\C-s" 'edict-exit) (define-key edict-edit-mode-map "[" 'edict-open-bracket) (define-key edict-edit-mode-map "]" 'edict-close-bracket) (define-key edict-edit-mode-map "/" 'edict-slash)) (defun edict-edit-mode () "Major mode for editing edict entries. TAB Tab to next field in this entry. RETURN Start a new entry on the next line. c-A Edit the kanji field, and start entering kanji. c-E Go to the end, and start editing english. C-c C-c Install the edited changes & save the file. C-x C-s Install the edited changes & save the file. " (interactive) (kill-all-local-variables) ;; Associate these with the buffer. (make-local-variable 'edict-previous-window-configuration) (make-local-variable 'edict-previous-bufffer) (make-local-variable 'edict-filename) (set-syntax-table text-mode-syntax-table) (use-local-map edict-edit-mode-map) (setq local-abbrev-table text-mode-abbrev-table) (setq major-mode 'edict-edit-mode) (setq mode-name "Edict") (setq paragraph-start "^\\|$") (setq paragraph-separate "^\\|$") (run-hooks 'text-mode-hook)) ;;; Automagically pick the right mode, based on where we are in the string. ;;; That's henkan mode when we're in the entry or yomi sections, and english ;;; in the translation section. (defun edict-auto-set-henkan () (save-excursion (let ((x (point)) (end nil)) (end-of-line) (setq end (point)) (beginning-of-line) (edict-set-henkan (or (looking-at "$") (when (re-search-forward "[]/]" end t) (<= x (match-beginning 0)))))))) (defun edict-standin () "Invoke the command we would otherwise have invoked, after being sure we're in the right mode." (interactive) (setq this-command (aref global-map last-command-char)) (edict-execute-dictionary-command (function (lambda () (command-execute this-command))))) (defun edict-execute-dictionary-command (function) (edict-auto-set-henkan) (let ((buffer (current-buffer))) ;; Canonicalize the end to end in exactly one slash. (unless (<= (point) (point-min)) (save-excursion (backward-char 1) (when (looking-at "//\n") (forward-char 1) (delete-char 1)))) (funcall function) ;; Canonicalize the end of the line to end in exactly one slash. (save-excursion (end-of-line) (delete-horizontal-space) (unless (<= (point) (point-min)) (backward-char 2) (while (looking-at "//") ;; Two in a row; delete the second. (forward-char 1) (delete-char 1) (backward-char 2)) (forward-char 1) (unless (looking-at "\n") (unless (looking-at "[/\n]") (end-of-line) (unless (edict-line-has-english) (insert " /")) (insert ?/))))) ;; Then if we are at the end, make it end in two, for the sake of visual feedback. ;; Except if we're on a blank line, don't add anything. (unless (<= (point) (point-min)) (unless (save-excursion (end-of-line) (backward-char 1) (looking-at "\n")) (when (looking-at "\n") (insert "/") (backward-char 1)) (save-excursion (end-of-line) ;; Make sure there's a trailing newline. (when (>= (point) (point-max)) (newline) (backward-char 1)) (let ((end (point))) (beginning-of-line) (when (search-forward "/" end t) (when (looking-at "\n") (insert "/"))))))) ;; Only set the henkan if we're still in the same buffer. (when (eq buffer (current-buffer)) (edict-auto-set-henkan)))) (defun edict-line-has-english (&optional complete) (save-excursion (let ((p (point))) (end-of-line) (let ((end (point))) (goto-char p) (beginning-of-line) (if complete (re-search-forward "/[^/\n]+/" end t) (re-search-forward "/" end t)))))) (defvar *brackets-allowed-in-english* nil "*Allow brackets in the english section of dictionary entries, if non-null.") (defun edict-open-bracket () "Begin editing the yomi section of the entry, at the beginning of the entry. Self-inserts if in the english section." (interactive) (edict-execute-dictionary-command (function (lambda () (edict-char-bracket t))))) (defun edict-close-bracket () "Begin editing the yomi section of the entry, at the end of the entry. Self-inserts if in the english section.." (interactive) (edict-execute-dictionary-command (function (lambda () (if (looking-at "\\]") (edict-tab) (edict-char-bracket nil)))))) (defun edict-char-bracket (open-p) (let ((p (point))) (end-of-line) (let ((end (point))) (beginning-of-line) (cond ((and *brackets-allowed-in-english* (save-excursion (re-search-forward "/[^\n/]*/" end t)) (<= (match-beginning 0) p)) (goto-char p) (edict-standin)) ((re-search-forward "\\[\\(\\ch\\|\\cH\\|\\ck\\|\\cK\\)*\\]" end t) (goto-char (or (if open-p (match-beginning 1) (match-end 1)) ;; Empty (1+ (match-beginning 0))))) ((re-search-forward "[ \t]" end t) (goto-char (match-beginning 0)) (insert " []") (backward-char 1)) (t (goto-char p) (edict-standin)))))) (defun edict-slash () "Begin editing the english section of the entry, at the start of the entry. Self-inserts if in the english section." (interactive) (edict-execute-dictionary-command (function edict-slash-internal))) (defun edict-slash-internal () (if (looking-at "/\n") (forward-char) (let ((p (point))) (end-of-line) (let ((end (point))) (beginning-of-line) (cond ((and (save-excursion (re-search-forward "/[^/\n]*/" end t)) (<= (match-beginning 0) p)) (goto-char p) (edict-standin)) ((search-forward "/" end t)) ;; On an empty line, just insert a definition. ((looking-at "$") (insert " //") (backward-char 1)) ;; Otherwise, this line has no english, go to the end and add one. (t (end-of-line) (backward-char 1) (unless (looking-at " ") (insert " ")) (insert "//") (backward-char 1))))))) (defun edict-tab () "Tab to the next edict field in this entry. At the end, wraps back to the beginning.." (interactive) (edict-execute-dictionary-command (function edict-tab-internal))) (defun edict-tab-internal () (let ((p (point)) (end nil)) (end-of-line) (setq end (point)) (goto-char p) (cond ((re-search-forward "[ \t]\\(\\[\\)\\|\\(/\\)" end t) (let ((f-begin (or (match-beginning 1) (match-beginning 2))) (f-end (or (match-end 1) (match-end 2)))) (goto-char f-begin) (edict-set-henkan (looking-at "\\[")) (goto-char f-end))) (t (beginning-of-line) (edict-set-henkan t))))) (defun edict-beginning-of-line () "Go to the beginning of the edict entry." (interactive) (edict-execute-dictionary-command (function (lambda () (beginning-of-line) (edict-set-henkan t))))) (defun edict-end-of-line () "Go to the beginning of the edict entry." (interactive) (edict-execute-dictionary-command (function (lambda () (end-of-line) (edict-set-henkan nil))))) (defun edict-new-entry (arg) "Start a new edict entry on the next line. If given an argument, copies the word but not the yomi or english. If given an argument > 4 (i.e. c-U c-U), copies the word and definition, but not the yomi." (interactive "P") (edict-execute-dictionary-command (function (lambda () (edict-new-entry-internal arg))))) (defun edict-new-entry-internal (arg) (end-of-line) ;;clean up in the dictionary to save space. (delete-horizontal-space) ;;first check that the last thing on this line is a '/', otherwise add one. (unless (<= (point) (point-min)) (backward-char) (unless (looking-at "/") (end-of-line) (insert "/")) (multiple-value-bind (kanji yomi english) (edict-parse-entry) (end-of-line) (if (>= (point) (point-max)) (newline) (forward-char 1)) (cond ((null arg) (edict-insert-entry nil nil nil)) ((<= (prefix-numeric-value arg) 4) (edict-insert-entry kanji nil nil)) (t (edict-insert-entry kanji nil english)))))) (defun edict-exit () "Exit the editing of a private edict file, saving the buffer and updating the running copy of the dictionary, and restoring the window configuration." (interactive) (save-buffer) (let* ((buffer (current-buffer)) (edict-private-buffer (find-file-noselect (expand-file-name *edict-private-file*))) (filename (or edict-filename (buffer-file-name edict-private-buffer))) (configuration edict-previous-window-configuration) (previous-buffer edict-previous-buffer)) (setq edict-previous-window-configuration nil edict-previous-buffer nil) (set-buffer *edict-buffer*) (goto-char (point-min)) (search-forward (format "%s %s" *edict-file-begin-marker* filename)) (forward-line) (let ((loc (point))) (search-forward (format "%s %s" *edict-file-end-marker* filename)) (forward-line 0) (delete-region loc (point)) (goto-char loc) (insert-buffer buffer) (when configuration (set-window-configuration configuration)) (when previous-buffer (switch-to-buffer previous-buffer))))) (defun edict-add-word () "Add any word to the private dictionary." (interactive) (edict-add-entry-to-file *edict-private-file* nil nil nil)) (defun edict-add-english () "Add the english word at point to the dictionary." (interactive) (let ((word (edict-get-english-word))) (when word (edict-add-entry-to-file *edict-private-file* nil nil word)))) (defun edict-add-kanji (min max) "Add the region as a kanji entry in the dictionary." (interactive "r") (edict-add-entry-to-file *edict-private-file* (edict-clean-up-kanji (buffer-substring min max)) nil nil)) ;;; Table of morphological rules. (defvar *edict-syntax-types* nil) ;;; defstruct's defsetfs should expand into this; sigh. (eval-when (eval load compile) (defstruct edict-syntax-type name rules) ) (defun get-edict-syntax-type (name) (if (symbolp name) (catch 'found-it (dolist (s *edict-syntax-types*) (when (eq (edict-syntax-type-name s) name) (throw 'found-it s))) (let ((new (make-edict-syntax-type :name name :rules ()))) (push new *edict-syntax-types*) new)) name)) (eval-when (eval load compile) (defstruct edict-rule name pattern ;Pattern which it must match filter ;Syntactic filter on previous form function ;Function to transform the input additional-args ;Arguments to transform function from-syntax-types ;Syntaxes for which this is vali to-syntax-types) ;Syntaxes to consider after this rule. ) ;;; Delete all occurrances of a rule from the rule base. (defun edict-delete-rule (name) (dolist (s *edict-syntax-types*) (let ((old (edict-get-rule-from-syntax-type name s))) (when old (setf (edict-syntax-type-rules s) (delq old (edict-syntax-type-rules s))))))) ;(defun edict-decircularize-rules () ; (interactive) ; (dolist (s *edict-syntax-types*) ; (dolist (r (edict-syntax-type-rules s)) ; (setf (edict-rule-from-syntax-types r) ; (mapcar (function (lambda (type) ; (if (symbolp type) ; type ; (edict-syntax-type-name type)))) ; (edict-rule-from-syntax-types r))) ; (setf (edict-rule-to-syntax-types r) ; (mapcar (function (lambda (type) ; (if (symbolp type) ; type ; (edict-syntax-type-name type)))) ; (edict-rule-to-syntax-types r)))))) ; ;(defun edict-circularize-rules () ; (interactive) ; (dolist (s *edict-syntax-types*) ; (dolist (r (edict-syntax-type-rules s)) ; (setf (edict-rule-from-syntax-types r) ; (mapcar (function (lambda (type) ; (if (symbolp type) ; (get-edict-syntax-type type) ; type))) ; (edict-rule-from-syntax-types r))) ; (setf (edict-rule-to-syntax-types r) ; (mapcar (function (lambda (type) ; (if (symbolp type) ; (get-edict-syntax-type type) ; type))) ; (edict-rule-to-syntax-types r)))))) (defun edict-add-rule (name rule) (edict-delete-rule name) (dolist (s (edict-rule-from-syntax-types rule)) (push rule (edict-syntax-type-rules s)))) (defun edict-get-rule-from-syntax-type (name syntax-type) (catch 'edict-get-rule (dolist (rule (edict-syntax-type-rules syntax-type)) (if (eq name (edict-rule-name rule)) (throw 'edict-get-rule rule))))) (defmacro define-edict-rule (name pattern fromto function &rest additional-args) ;; First, some compatibility stuff. (let ((filter nil) (from nil) (to nil)) (when (stringp fromto) (setq filter fromto fromto nil)) (when (null fromto) (setq fromto '(日本語 日本語))) (setq from (first fromto) to (second fromto)) (unless (listp from) (setq from (list from))) (unless (listp to) (setq to (list to))) (unless (string-match "^\\^\\|\\$$" pattern) (error "Rule %s: pattern must start with ^ or end with $: \"%s\"" name pattern)) (when filter (unless (stringp filter) (error "Rule %s: filter must be a regexp" name))) (` (define-edict-rule-internal '(, name) '(, pattern) '(, filter) '(, from) '(, to) (function (, function)) (function (, additional-args)))))) (defun define-edict-rule-internal (name pattern filter from-syntax-types to-syntax-types function additional-args) (unless (string-match "^\\^\\|\\$$" pattern) (error "Rule %s: pattern must start with ^ or end with $: \"%s\"" name pattern)) (when filter (unless (stringp filter) (error "Rule %s: filter must be a regexp" name))) (let ((from-types nil) (to-types nil)) (dolist (f from-syntax-types) (push (get-edict-syntax-type f) from-types)) (dolist (to to-syntax-types) (push (get-edict-syntax-type to) to-types)) (edict-add-rule name (make-edict-rule :name name :pattern pattern :filter filter :from-syntax-types from-types :to-syntax-types to-types :function function :additional-args additional-args)) name)) (defun edict-subst-affix (string &rest affixes) (let ((x nil) (i 1) (prev -1) (result "")) (dolist (x affixes) (let ((pos (match-beginning i))) (cond ((eq x 'edict-identity)) ((eq x 'edict-ignore) (setq result (concat result (substring string (max prev 0) (match-beginning i))) prev (match-end i))) ((and (symbolp x) (fboundp x)) (setq result (concat result (substring string (max prev 0) (match-beginning i)) (funcall x (substring string (match-beginning i) (match-end i)))))) ((not (stringp x)) (error "%s is not a string or function name in edict-subst-affix" x)) ((and pos (>= pos prev)) (setq result (concat result (substring string (max prev 0) (match-beginning i)) x)) (setq prev (match-end i)))) (incf i))) (concat result (substring string (max prev 0))))) ;;; Takes a series of alternating pairs of substitution functions ;;; and arguments for those substitution functions. This can be ;;; used to algorithmically replace certain parts (typically involving ;;; changing an い行 to う行 final character. (defun edict-subst-modified-affix (string &rest affixes) (let ((fun nil) (args nil) (i 1) (prev -1) (result "")) (while affixes (setq fun (car affixes) args (car (cdr affixes)) affixes (cdr (cdr affixes))) (let ((pos (match-beginning i))) (cond ((eq fun 'edict-identity)) ((eq fun 'edict-ignore) (setq result (concat result (substring string (max prev 0) (match-beginning i))) prev (match-end i))) ((not (or (stringp fun) (and (symbolp fun) (fboundp fun)))) (error "%s is not a string or function name in %s" 'edict-subst-modified-affix x)) ((and pos (>= pos prev)) (setq result (concat result (substring string (max prev 0) pos) (apply fun (substring string (match-beginning i) (match-end i)) args))) (setq prev (max prev (match-end i))))) (incf i))) (concat result (substring string (max prev 0))))) ;;; Ignore this piece (defun edict-ignore (affix) "") ;;; Keep this piece (defun edict-identity (affix) affix) ;;; Substitute for this piece (defun edict-subst (affix data) data) ;;; More or less a guon table, for converting doshi suffixes. (defvar *edict-doshi-suffix* '(["わ" "い" "う" "え" "お"];; u -> wa; kau->kawanai ["か" "き" "く" "け" "こ"] ["が" "ぎ" "ぐ" "げ" "ご"] ["さ" "し" "す" "せ" "そ"] ["ざ" "じ" "ず" "ぜ" "ぞ"] ["た" "ち" "つ" "て" "と"] ["だ" "ぢ" "づ" "で" "ど"] ["な" "に" "ぬ" "ね" "の"] ["は" "ひ" "ふ" "へ" "ほ"] ["ば" "び" "ぶ" "べ" "ぼ"] ["ぱ" "ぴ" "ぷ" "ぺ" "ぽ"] ["ま" "み" "む" "め" "も"] ["ら" "り" "る" "れ" "ろ"])) (defun edict-modify-verb (suffix from to) (catch 'exit (dolist (b *edict-doshi-suffix*) (if (equal suffix (aref b from)) (throw 'exit (aref b to)))) (throw 'skip-rule nil))) ;;; Set this to true for debugging. (defvar *edict-expand-string-trace* nil) ;;; This returns a list of the results of applying all rules whose ;;; patterns match, to all levels of recursion. (defun edict-expand-string (string &optional others previous syntax) (let* ((result nil) (syntax (or syntax '日本語)) (stype (get-edict-syntax-type syntax))) (dolist (rule (edict-syntax-type-rules stype)) (when (string-match (edict-rule-pattern rule) string) (catch 'skip-rule (unless (and previous (edict-rule-filter rule) (edict-filter-rule rule previous)) (let ((temp (apply (edict-rule-function rule) string (edict-rule-additional-args rule)))) (unless (or (equal temp string) (edict-find temp others) (edict-find temp result)) (when *edict-expand-string-trace* (read-string (format "%s: %s -> %s -:" (edict-rule-name rule) string temp))) (setq result (edict-union (edict-expand-string-recurse temp (cons string (append result others)) string rule) result)))))))) (if (edict-find string result) result (cons string result)))) (defun edict-expand-string-recurse (string others previous rule) (edict-expand-string-syntaxes string others previous (edict-rule-to-syntax-types rule))) (defun edict-expand-string-syntaxes (string others previous syntaxes) (let ((result nil)) (dolist (syntax syntaxes) (setq result (edict-union (edict-expand-string string (append result others) previous syntax) result))) result)) ;;; Returns T if the rule should not be run, because of the past ;;; history of expansions. I.e. if something started out with く ;;; on the end, and we've made it into an adjective, we should disable ;;; any expansions based on it being a the conjunctive/stem form of a verb. ;;; This is done purely based on the most immediately preceding expansion, ;;; because that is what determined the sense of the word. (defun edict-filter-rule (rule previous) (let ((filter (edict-rule-filter rule))) (cond ((null filter) nil) ((null previous) nil) ((stringp filter) (string-match filter previous)) ((symbolp filter) (funcall filter frob)) ((consp filter) (apply (car filter) frob (cdr filter))) (t (error "Bogus filter in rule %s: %s" (edict-rule-name rule) filter))))) (defun edict-find (elt list) (catch 'edict-find (dolist (test list) (when (equal elt test) (throw 'edict-find test))))) (defun edict-union (set1 set2) (let ((result set2)) (dolist (frob set1) (unless (edict-find frob set2) (setq result (cons frob result)))) result)) ;;; The syntax of the rules is: ;;; (define-edict-rule name ). ;;; ;;; is a regular expression, with the parts to be substituted ;;; being denoted by \\(\\). ;;; ;;; is a funtion responsible for determining the replacements. ;;; The current choices are edict-subst-modified-affix and edict-subst-affix. ;;; These functions are called just after doing match-string, so the regexp variables ;;; are set up. They are applied to the string, and . These functions ;;; are responsible for determining and performing the substitutions to be made, and ;;; returning a list of possiblities. ;;; ;;; edict-subst-affix is the simpler case. It takes as conversion data one string ;;; for each subpattern in the pattern. This string will be used in place of the ;;; original. ;;; ;;; edict-subst-modified-affix takes as conversion data, an alternating list of ;;; functions and lists of additional arguments for those functions. Each function ;;; is applied to the substring being replaced and its additional arguments. ;;; Likely functions to use include edict-modify-verb, edict-ignore, and edict-subst. ;;; Strip "います" (define-edict-rule 「います」を削除する "\\(\\cc\\|\\ch\\)\\([いきぎしちにびみり]\\)\\(ま\\(す\\|せん\\)\\)$" "ませる$" edict-subst-modified-affix edict-identity () edict-modify-verb (1 2) edict-ignore ()) (define-edict-rule 「ます」を削除する "\\(\\cc\\|[いきぎしちにびみりえけげせてねべめれ]\\)\\(ま\\(す\\|せん\\)\\)$" "ませる$" edict-subst-affix edict-identity "る") (define-edict-rule 「来ます」の特別ルール "\\(来ま\\(す\\|せん\\)\\)$" () edict-subst-affix "来る") (define-edict-rule 「きます」の特別ルール "\\(^\\|て\\|んで\\)\\(きま\\(す\\|せん\\)\\)$" "ませる$" edict-subst-modified-affix edict-identity () edict-subst ("くる")) (define-edict-rule 「します」の特別ルール "\\(しま\\(す\\|せん\\)\\)$" () edict-subst-affix "する") ;;; The several cases of て／って. ;;; Note either pattern may generate multiple possibilities. ;;; Also, た. (define-edict-rule 「て／た」から「う」まで変換する "\\(っ\\(て\\|た[ら]?\\)\\)$" () edict-subst-affix "う") (define-edict-rule 「て／た」から「つ」まで変換する "\\(っ\\(て\\|た[ら]?\\)\\)$" () edict-subst-affix "つ") (define-edict-rule 「て／た」から「る」まで変換する "\\(っ\\(て\\|た[ら]?\\)\\)$" () edict-subst-affix "る") (define-edict-rule 一段の「て／た」から「る」まで変換する "\\(\\cc\\|[いきぎしちにびみりえけげせてねべめれ]\\)\\(\\(て\\|た[ら]?\\)\\)$" () edict-subst-affix edict-identity "る") (define-edict-rule 「て／た」から「す」まで変換する "\\(し\\(て\\|た[ら]?\\)\\)$" () edict-subst-affix "す") (define-edict-rule 「て／た」から「く」まで変換する "\\(い\\(て\\|た[ら]?\\)\\)$" () edict-subst-affix "く") (define-edict-rule 「て／た」から「ぐ」まで変換する "\\(い[でだ]\\)$" () edict-subst-affix "ぐ") (define-edict-rule 「て／た」から「ぶ」まで変換する "\\(ん\\(で\\|だ[ら]?\\)\\)$" () edict-subst-affix "ぶ") (define-edict-rule 「て／た」から「む」まで変換する "\\(ん\\(で\\|だ[ら]?\\)\\)$" () edict-subst-affix "む") (define-edict-rule 「て／た」から「ぬ」まで変換する "\\(ん\\(で\\|だ[ら]?\\)\\)$" () edict-subst-affix "ぬ") ;;; 行く is an irregular verb. (define-edict-rule 行くの特別ルール "行\\(っ\\(て\\|た[ら]?\\)\\)$" () edict-subst-affix "く") (define-edict-rule 「来て」の特別ルール "来\\(て\\|た[ら]?\\)$" () edict-subst-affix "来る") (define-edict-rule 「きて」の特別ルール "\\(きて\\|きた[ら]?\\)$" () edict-subst-affix "くる") (define-edict-rule 「して」の特別ルール "\\(して\\|した[ら]?\\)$" () edict-subst-affix "する") ;;; Potential form. ;;; The filters here are due to 「一段の「て／た」から「る」まで変換する」 (define-edict-rule れる "\\(\\cc\\|\\ch\\)\\(れる\\)$" "れて$" edict-subst-affix edict-identity "る") (define-edict-rule ける "\\(\\cc\\|\\ch\\)\\(ける\\)$" "けて$" edict-subst-affix edict-identity "く") (define-edict-rule せる "\\(\\cc\\|\\ch\\)\\(せる\\)$" "せて$" edict-subst-affix edict-identity "す") (define-edict-rule てる "\\(\\cc\\|\\ch\\)\\(てる\\)$" "\\(て\\|てられる\\)$" edict-subst-affix edict-identity "つ") (define-edict-rule ねる "\\(\\cc\\|\\ch\\)\\(ねる\\)$" "ねて" edict-subst-affix edict-identity "ぬ") (define-edict-rule める "\\(\\cc\\|\\ch\\)\\(める\\)$" "めて" edict-subst-affix edict-identity "む") (define-edict-rule え "\\(\\cc\\|\\ch\\)\\(える\\)$" "えて" edict-subst-affix edict-identity "う") (define-edict-rule げる "\\(\\cc\\|\\ch\\)\\(げる\\)$" "けて" edict-subst-affix edict-identity "ぐ") (define-edict-rule べる "\\(\\cc\\|\\ch\\)\\(べる\\)$" "べて" edict-subst-affix edict-identity "ぶ") ;;; 一段動詞。 Also serves for the passive. (define-edict-rule られる "\\(\\cc\\|[いきぎしちにびみりえけげせてねべめれ]\\)\\(られる\\)$" () edict-subst-affix edict-identity "る") ;;; Passive (define-edict-rule 五段動詞の「あれる」を変換する "\\([わかがさたなまばら]\\)\\(れる\\)$" () edict-subst-modified-affix edict-modify-verb (0 2) edict-ignore ()) (define-edict-rule 来られるのルール "来\\(られる\\)$" () edict-subst-affix "る") (define-edict-rule されるのルール "\\(される\\)$" () edict-subst-affix "する") ;;; Causitive (define-edict-rule 五段動詞の「あせる」を変換する "\\([わかがさたなまばら]\\)\\(せる\\)$" () edict-subst-modified-affix edict-modify-verb (0 2) edict-ignore ()) (define-edict-rule 一段動詞の「あせる」を変換する "\\(\\cc\\|[いきぎしちにびみりえけげせてねべめれ]\\)\\(させる\\)$" () edict-subst-affix edict-identity "る") (define-edict-rule させるのルール "\\(させる\\)$" () edict-subst-affix "する") ;;; eba conditional form. (define-edict-rule 「えば」を変換する "\\([えけげせてねべめれ]\\)\\(ば\\)$" () edict-subst-modified-affix edict-modify-verb (3 2) edict-ignore ()) ;;; tara conditional form is handled as part of the て／た／たら rules. ;;; The informal negative form. (define-edict-rule 「ない」を変換する "\\([わかがさたなまばら]\\)\\(ない\\|ず\\)$" () edict-subst-modified-affix edict-modify-verb (0 2) edict-ignore ()) (define-edict-rule 一段の「ない」を変換する "\\(\\cc\\|[いきぎしちにびみりえけげせてねべめれ]\\)\\(ない\\|ず\\)$" () edict-subst-affix edict-identity "る") (define-edict-rule 「しない」の特別ルール "\\(しない\\|せず\\)$" () edict-subst-affix "する") (define-edict-rule 「ない」の特別ルール "^\\(ない\\)$" () edict-subst-affix "ある") ;;; Conjunctive form (define-edict-rule 一段のconjunctive "\\(\\cc\\|\\ch\\)[いきぎしちにびみりえけげせてねべめれ]\\(\\)$" "く$\\|かった$\\|くる$\\|くれる$\\|ください$\\|あげる$\\|上げる$\\|しまう$\\|くて$\\|くない$\\|ければ$\\|いる$\\|からず$\\|います$\\|ある$\\|みる$\\|下さい$\\|なさい$\\|やる$\\|もらう$" edict-subst-modified-affix edict-identity () edict-subst ("る")) (define-edict-rule 五段のconjunctive "\\(\\cc\\|\\ch\\)\\([いきぎしちにびみり]\\)$" "く$\\|かった$\\|くる$\\|くれる$\\|ください$\\|あげる$\\|上げる$\\|しまう$\\|くて$\\|くない$\\|ければ$\\|いる$\\|からず$\\|います$\\|ある$\\|みる$\\|下さい$\\|なさい$\\|やる$\\|もらう$" edict-subst-modified-affix edict-identity () edict-modify-verb (1 2)) (define-edict-rule 「する」の特別conjunctive "\\(\\cc\\|\\ch\\|\\ck\\|\\cK\\)\\(し\\)$" "す$" edict-subst-affix edict-identity "する") (define-edict-rule 「じる」の特別conjunctive "\\(\\cc\\|\\ch\\)\\(じ\\)$" () edict-subst-affix edict-identity "じる") (define-edict-rule 「ずる」の特別conjunctive "\\(\\cc\\|\\ch\\)\\(じ\\)$" () edict-subst-affix edict-identity "ずる") ;;; The informal imperative form, 五段動詞 (define-edict-rule 「れ」の五段動詞を変換する "\\(\\cc\\|\\ch\\)\\([えけげせてねべめれ]\\)$" () edict-subst-modified-affix edict-identity () edict-modify-verb (3 2)) ;;; The informal imperative form, 一段動詞 (define-edict-rule 「ろ」の一段動詞を変換する "\\(\\cc\\|[いきぎしちにびみりえけげせてねべめれ]\\)\\(ろ\\)$" () edict-subst-affix edict-identity "る") ;;; Irregulars (define-edict-rule 「来い」の特別ルール "^\\(来い\\)$" () edict-subst-affix "来る") (define-edict-rule 「こい」の特別ルール "^\\(こい\\)$" "く$" edict-subst-affix "くる") (define-edict-rule 「しろ」の特別ルール "^\\(しろ\\)$" () edict-subst-affix "する") ;;; The plain desiderative (define-edict-rule 「たい」を削除する "\\(\\cc\\|\\ch\\)\\([いきぎしちにびみり]\\)\\(たい\\|たがる\\)$" () edict-subst-modified-affix edict-identity () edict-modify-verb (1 2) edict-ignore ()) (define-edict-rule 一段の「たい」を削除する "\\(\\cc\\|[いきぎしちにびみりえけげせてねべめれ]\\)\\(たい\\|たがる\\)$" () edict-subst-affix edict-identity "る") (define-edict-rule 「したい」の特別ルール "^\\(したい\\|したがる\\)$" () edict-subst-affix "する") (define-edict-rule 「来たい」の特別ルール "^\\(来たい\\|来たがる\\)$" () edict-subst-affix "来る") (define-edict-rule 「きたい」の特別ルール "^\\(きたい\\|きたがる\\)$" () edict-subst-affix "くる") ;;; Flush auxilliary verbs after te form. (define-edict-rule 助動詞ー１ "\\(\\cc\\|\\ch\\)\\(く\\|て\\|んで\\)\\(いる\\|おる\\|います\\|ある\\|おく\\|みる\\)$" () edict-subst-modified-affix edict-identity () edict-identity () edict-ignore ()) (define-edict-rule 助動詞ー１ａ "\\(\\cc\\|\\ch\\)\\(て\\|んで\\)\\(る\\)$" () edict-subst-modified-affix edict-identity () edict-identity () edict-ignore ()) (define-edict-rule 助動詞ー２ "\\(\\cc\\|\\ch\\)\\(く\\|て\\|んで\\)\\(下さい\\|ください\\|なさい\\|いく\\|行く\\|くる\\|来る\\)$" () edict-subst-modified-affix edict-identity () edict-identity () edict-ignore ()) (define-edict-rule 助動詞ー３ "\\(\\cc\\|\\ch\\)\\(く\\|て\\|んで\\)\\(\\([さ差]し\\)?[あ上]げる\\|やる\\|もらう\\|いただく\\|頂く\\|くれる\\|くださる\\)$" () edict-subst-modified-affix edict-identity () edict-identity () edict-ignore ()) (define-edict-rule 助動詞ー４ "\\(\\cc\\|\\ch\\)\\(く\\|て\\|んで\\)\\(する\\|成る\\|なる\\|しまう\\)$" () edict-subst-modified-affix edict-identity () edict-identity () edict-ignore ()) (define-edict-rule modifiers "\\(\\cc\\|\\ch\\)[いたうくぐすつぬぶむる]\\(らしい\\|そう\\|よう\\)$" () edict-subst-affix edict-identity "") (define-edict-rule humble "\\(お\\)\\(\\cc\\|\\ch\\)+\\([いきぎしちにびみり]\\)\\(に成る\\|になる\\|する\\|いたす\\|申し上げる\\|もうしあげる\\)$" () edict-subst-modified-affix edict-ignore () edict-identity () edict-modify-verb (1 2) edict-ignore ()) ;;; Volitional (define-edict-rule 五段の「おう」 "\\(\\cc\\|\\ch\\)\\([おこごそとのぼもろ]\\)\\(う\\)$" () edict-subst-modified-affix edict-identity () edict-modify-verb (4 2) edict-ignore ()) (define-edict-rule 一段の「よう」 "\\(\\cc\\|[いきぎしちにびみりえけげせてねべめれ]\\)\\(よう\\)$" () edict-subst-affix edict-identity "る") (define-edict-rule 「来よう」の特別ルール "\\(来よう\\)$" () edict-subst-affix "来る") (define-edict-rule 「こよう」の特別ルール "\\(こよう\\)$" () edict-subst-affix "くる") (define-edict-rule 「しよう」の特別ルール "\\(しよう\\)$" () edict-subst-affix "する") (define-edict-rule てしまう "[^ん]\\(ちゃう\\)$" () edict-subst-affix "てしまう") (define-edict-rule でしまう "ん\\(ちゃう\\)$" () edict-subst-affix "でしまう") ;; Honorific prefixes (define-edict-rule 敬語の接頭辞 "^\\(お\\|御\\|ご\\)" () edict-subst-affix "") ;; Various forms of adjectives. (define-edict-rule 形容詞ーく "\\(\\cc\\|\\ch\\)\\(く\\)$" "\\(か\\(れる\\|せる\\|ない\\|ず\\)\\|き\\(ます\\|ません\\|たい\\|なから\\|つつ\\|やさい\\|にくい\\|そうな\\)\\|け\\(ば\\|\\|る\\)\\|こう\\|い\\(た\\|たら\\|たり\\|たろう\\|て\\|ている\\)\\)$" edict-subst-affix edict-identity "い") (define-edict-rule 形容詞ーくて "\\(\\cc\\|\\ch\\)\\(くて\\)$" () edict-subst-affix edict-identity "い") (define-edict-rule 形容詞ーくない "\\(\\cc\\|\\ch\\)\\(くない\\)$" () edict-subst-affix edict-identity "い") (define-edict-rule 形容詞ーからず "\\(\\cc\\|\\ch\\)\\(からず\\)$" () edict-subst-affix edict-identity "い") (define-edict-rule 形容詞ーかった "\\(\\cc\\|\\ch\\)\\(かった\\)$" () edict-subst-affix edict-identity "い") (define-edict-rule 形容詞ーない "\\(\\cc\\|\\ch\\)\\(\\(じゃ\\|では\\)\\(ない\\|ありません\\)\\)$" () edict-subst-affix edict-identity "") (define-edict-rule 形容詞ーければ "\\(\\cc\\|\\ch\\)\\(ければ\\)$" () edict-subst-affix edict-identity "い") ;;; Other affixes (define-edict-rule other-suffixes "\\(\\cc\\|\\ch\\)\\(的\\|てき\\|もの\\|物\\|者\\|式\\|中\\|員\\|する\\|さん\\|先生\\|様\\|さま\\|ちゃん\\|君\\|くん\\|屋\\)$" () edict-subst-affix edict-identity "") (define-edict-rule other-prefixes "^\\(昨\\|来\\|全\\|半\\|毎\\)\\cc" () edict-subst-affix "") ;;; Canonicalize number expressions (define-edict-rule numbers "^\\([0-9０-９一二三四五六七八九十百千万億]+\\)\\(\\cc\\|\\ch\\)" () edict-subst-affix "一" edict-identity ) (define-edict-rule 数なし "^\\([0-9０-９一二三四五六七八九十百千万億]+\\)\\(\\cc\\|\\ch\\)" () edict-subst-affix edict-ignore edict-identity ) (define-edict-rule だ "\\(じゃない\\|ではない\\|だった\\|だろう\\)$" () edict-subst-affix "だ") (define-edict-rule です "\\(じゃありません\\|ではありません\\|でしょう\\)$" () edict-subst-affix "です") (define-edict-rule です/だ "\\(です\\)$" () edict-subst-affix "だ") (define-edict-rule cupola "\\(\\cc\\|\\ch\\)\\(だ\\|です\\)$" () edict-subst-affix edict-identity edict-ignore) (define-edict-rule english-plural "\\([^i][^e]\\|i[^e]\\|[^i]e\\)\\(s\\)$" (english english-noun) edict-subst-affix edict-ignore) (define-edict-rule english-plural-ies "\\(ies\\)$" (english english-noun) edict-subst-affix "y") (provide 'edict) edict-el-1.06.orig/install.edict.0960100644000175000017500000005304006524336052016412 0ustar rolandroland#!/bin/sh # Installation Script Copyright (C) 1992 Bob Kerns echo < and Copyright (c) 1992 Bob Kerns edict.el written by Per Hammarlund Morphology and private dictionary handling/editing by Bob Kerns International installation script by Bob Kerns Helpful remarks from Ken-Ichi Handa . The EDICTJ PD dictionary is maintained by Jim Breen Your credits here if you contribute! This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. GNUHEADER export EPATH EPATH="/tmp/edict.$$" export PATH PATH=$EPATH:/bin:/usr/bin:$PATH export PWD PWD=`pwd` export DATE DATE=`date` # Script for installing the edict nemacs library. if [ -d $EPATH ] || [ -f $EPATH ]; then rm -rf $EPATH fi trap "rm -rf $EPATH" 0 mkdir $EPATH if [ -f $EPATH/failure ]; then rm -f $EPATH/failure fi cat <<'ENDMSG' >$EPATH/msg #!/bin/sh X=$LN if [ ! X = 'EN' ]; then if egrep "^$X[ ]?$1[ ]?" $EPATH/text >/dev/null; then : ; else X='EN' fi fi egrep "^$X[ ]?$1[ ]?" $EPATH/text >/dev/null || { echo "Could not find $X message $1" exit 1 } # Do this to get variable substitution in messages. # Some /bin/sh's aren't 8-bit clean, and all of them will screw up # due to the the '$' chars in the JIS KI/KO sequences. # So we have to do things the hard way. Instead of allowing arbitrary # variable substitutions, we substitute for a fixed set of vars. # If you add a variable to this list, be sure it's exported! sed -e "s!@PWD!$PWD!; s!@DISTDIR!$DISTDIR!; s!@EMACSDIR!$EMACSDIR!; s!@HOME!$HOME!; s!@DATE!$DATE!; s!@LN!$LN!; s!@INSTDIR!$INSTDIR!" $EPATH/text | sed -n -e "s/^$X[ ][ ]*$1[ ][ ]*//p" ENDMSG chmod a+x $EPATH/msg cat <<'ENDLOG' >$EPATH/log #!/bin/sh export LN # Log the user's responses & the program's actions & discoveries. msg $1 >>/tmp/edict.log.$LN # For the sake of bug reports, log it in english as well. case "$LN" in EN) ;; *) LN='EN' msg $1 >>/tmp/edict.log.$LN ;; esac ENDLOG chmod a+x $EPATH/log cat <<'ENDLOGAPPEND' >$EPATH/logappend #!/bin/sh # Append a file to the log file(s) cat $1 >>/tmp/edict.log.EN case "$LN" in EN) ;; *) cat $1 >>/tmp/edict.log.$LN ;; esac rm $1 ENDLOGAPPEND chmod a+x $EPATH/logappend cat <<'ENDCOPY' >$EPATH/copy #!/bin/sh # Copy a file, logging and echoing that fact. touch $EPATH/mv.out echo "mv $2 $2.orig" if [ -f $2 ]; then echo "mv $2 $2.orig" mv $2 $2.orig >>$EPATH/mv.out 2>&1 || { cat $EPATH/mv.out touch $EPATH/failure } fi echo "mv $2 $2.orig" >>$EPATH/copy.out cat $EPATH/mv.out >>$EPATH/copy.out rm $EPATH/mv.out touch $EPATH/cp.out echo "cp -p $1 $2" cp -p $1 $2 >>$EPATH/cp.out 2>&1 || { cat $EPATH/cp.out touch $EPATH/failure } echo "cp -p $1 $2" >>$EPATH/copy.out cat $EPATH/cp.out >>$EPATH/copy.out rm $EPATH/cp.out touch $EPATH/chmod.out echo "chmod 0644 $2" chmod 0644 $2 >>$EPATH/chmod.out 2>&1 || { cat $EPATH/chmod.out touch $EPATH/failure } echo "chmod 0644 $2" >>$EPATH/copy.out cat $EPATH/chmod.out >>$EPATH/copy.out rm $EPATH/chmod.out logappend $EPATH/copy.out ENDCOPY chmod a+x $EPATH/copy # Build our database of textual messages # First item is the two-character language code. # Second item is the message name. A multiline message is # formed by having multiple lines with that name. # The remainder of the line is the text which should be printed. cat <<'END' >$EPATH/text # It is OK to have comments in here. # If a translation for a messsage does not exist, the english version will be used. EN LANGUAGE Using english messages. JA LANGUAGE 日本語を使っています。 SW LANGUAGE Anv{nder svenska meddelanden. EN DISTDIR What directory has the edict files? [@PWD] JA DISTDIR edictのファイルの登録簿はどこですか？ [@PWD] SW DISTDIR Var finns edictprogrammets filer? [@PWD] EN XDISTDIR The edict files are in @DISTDIR JA XDISTDIR edict のファイルの登録簿は @DISTDIR にあります。 SW XDISTDIR Edictprogrammets filer finns i @DISTDIR. EN EDICTJDIR What directory has the edictj dictionary? [@DISTDIR] JA EDICTJDIR edictj という電子辞典はどこですか？ [@DISTDIR] SW EDICTJDIR Var finns lexikonet EDICTJ? [@DISTDIR] EN XEDICTJDIR The edictj dictionary is in @DISTDIR. JA XEDICTJDIR edictjは@DISTDIRにあります。 SW XEDICTJDIR Lexikonet EDICTJ finns i @DISTDIR. EN INSTDIR Normally, this software should be placed in the directory EN INSTDIR which holds your site's emacs libraries. However, you do EN INSTDIR not have write access to that directory, so you will need to EN INSTDIR place them somewhere else. EN INSTDIR EN INSTDIR In what directory should I put the edict files? [leave in @DISTDIR] JA INSTDIR 日頃、このソフトウェアはサイトのnemacsのライブラリの登録簿に JA INSTDIR 格納するものです。でも、あなたはその登録簿を書けません。これから、 JA INSTDIR ソフトウェアは余所に格納しましょう。 JA INSTDIR JA INSTDIR edict は、どの登録簿に格納しておきましょうか？ [@DISTDIR] SW INSTDIR Egentligen skall edictprogrammets filer placeras i katalogen SW INSTDIR som har emacs |vriga filer; emacs "bibliotek". Men iom att SW INSTDIR du inte har skrivr{ttigheter d{r, s} m}ste du l{gga dem SW INSTDIR n}gon annanstans. SW INSTDIR SW INSTDIR I vilken katalog ska jag placera edictprogrammets filer? [@DISTDIR] EN XINSTDIR The installation will be in @INSTDIR JA XINSTDIR ソフトウェアは@INSTDIRに格納しまうす。 SW XINSTDIR Edictprogrammet kommer att installeras i @INSTDIR. EN BYTECOMP Emacs byte-compiling @DISTDIR/edict.el and EN BYTECOMP @DISTDIR/edict-test.el. SW BYTECOMP Emacs byte-compiling @DISTDIR/edict.el och SW BYTECOMP @DISTDIR/edict-test.el. (Detta ger dig SW BYTECOMP en "snabbare", kompilerad, version av programmen.) JA BYTECOMP emacs で @DISTDIR/edict.el と JA BYTECOMP @DISTDIR/edict-test.el を byte-compile しています。 EN DEFAULTS In the following questions, if a default value may appear between EN DEFAULTS square brackets. [] If you type Return, I will use that value. SW DEFAULTS I de f|ljande fr}gorna s} kan det finnas ett standardsvar, givet mellan SW DEFAULTS hakparenteser ([]), om du bara trycker RETURN kommer detta standardsvar att SW DEFAULTS anv{ndas. EN DOTEMACSQ Should I add the default key bindings and setup to your .emacs file? EN DOTEMACSQ You may type SHOW to see what will be inserted. EN DOTEMACSQ Please type yes, no, or show. SW DOTEMACSQ Ska jag l{gga till n|dv{ndig initieringskod till din .emacs-fil? SW DOTEMACSQ Om du skriver VISA visar jag vad som kommer att l{ggas till. SW DOTEMACSQ Svara JA, NEJ, eller VISA. EN DOTEMACSADD @HOME/.emacs updated. SW DOTEMACSADD @HOME/.emacs uppdaterad. EN YESORNO Please answer yes, no, or show. JA YESORNO 「はい」か「いいえ」か「示して」かと答えて下さい。ロマ字などいいです。 JA YESORNO 英語もいいです。 SW YESORNO Svara JA, NEJ eller VISA. EN YESNOCONV cat JA YESNOCONV sed 's/HAI/YES/; s/IIE/NO/; s/SHIME.*/SHOW/;\ JA YESNOCONV s/はい/YES/; s/いいえ/NO/; s/示.*/SHOW/; s/しめ.*/SHOW/' SW YESNOCONV sed 's/JA/YES/; s/NEJ/NO/; s/VISA/SHOW/' EN LOGHEADER ---------------------------------------------------------------- EN LOGHEADER Installation at @DATE. SW LOGHEADER ---------------------------------------------------------------- SW LOGHEADER Installering gjord @DATE. EN LOGBEGIN2 A log file is being kept in english in /tmp/edict.log.EN SW LOGBEGIN2 En logfil med engelsk inneh}ll kommer att skapas och underh}llas. SW LOGBEGIN2 Filen heter /tmp/edict.log.EN. EN LOGBEGIN A log file is being kept in /tmp/edict.log.@LN. SW LOGBEGIN En logfil som visar vad jag g|r finns. Den heter /tmp/edict.log.@LN. EN SUCCESS Installation successfully completed. SW SUCCESS Installationen gick bra. EN FAILURE Installation encountered errors. SW FAILURE Installationen gick inte bra, n}got fel intr{ffade. EN NOCPYEDIR The emacs libraries are already in the right locations. SW NOCPYEDIR Emacsbiblioteken finns redan p} r{tt plats. EN NOCPYEJDIR The edictj dictionary file is already in the right location. SW NOCPYEJDIR Lexikonet EDICTJ finns redan p} r{tt st{lle. EN EJUSEDEMO Using the demo version of the EDICTJ file. EN EJUSEDEMO Please place the real one in @INSTDIR/edictj JA EJUSEDEMO いま、デモedictを使っています. あの妥当edictjがインストル下さい。 SW EJUSEDEMO Jag kommer att anv{nde en demoversion av lexikonet SW EJUSEDEMO EDICTJ. Installera det riktiga lexikonet som SW EJUSEDEMO @INSTDIR/edictj EN .EMACSCOMNT ;;; This sets up the standard key bindings for edict commands to EN .EMACSCOMNT ;;; autoload from @INSTDIR. EN .EMACSCOMNT ;;; EN .EMACSCOMNT ;;; Place this in your $HOME/.emacs file. EN .EMACSCOMNT ;;; Edit the global-set-key forms if you wish to change the key assignments. EN .EMACSCOMNT ;;; The default key assignments are as follows (m- is the same as ESC-) EN .EMACSCOMNT ;;; m-* edict-search-english Search for an english word. EN .EMACSCOMNT ;;; m-& edict-search-kanji Search for a Japanese word. EN .EMACSCOMNT ;;; m-+ edict-insert Insert the last match. JA .EMACSCOMNT ;;; これは、edict の標準のキーバインディングを込み立てます。 JA .EMACSCOMNT ;;; その機能が @INSTDIR からautoload 自動ロードするのを込み立てます。 JA .EMACSCOMNT ;;; JA .EMACSCOMNT ;;; このコードは $HOME/.emacs に置いて下さい。 JA .EMACSCOMNT ;;; キーバインディングを変更すると、global-set-key の形を編集して下さい。 JA .EMACSCOMNT ;;; 以下、デファールトキーバインディングがあります。 JA .EMACSCOMNT ;;; (「m-」と 「ESC-」は同じです。) JA .EMACSCOMNT ;;; m-* edict-search-english 英語の言葉を探せ JA .EMACSCOMNT ;;; m-& edict-search-kanji 日本語の言葉を探せ JA .EMACSCOMNT ;;; m-+ edict-insert 一昨一致を挿入しろ SW .EMACSCOMNT ;;; F|ljande kod ser till att edictprogrammet laddas automatiskt SW .EMACSCOMNT ;;; fr}n @INSTDIR. SW .EMACSCOMNT ;;; SW .EMACSCOMNT ;;; Skriv in detta i din $HOME/.emacs fil. SW .EMACSCOMNT ;;; [ndra global-set-key anropen om du vill att kommandona SW .EMACSCOMNT ;;; skall anropas fr}n andra tangenter. SW .EMACSCOMNT ;;; Detta {r standardtangentmappningarna (m- {r samma som ESC-) SW .EMACSCOMNT ;;; m-* edict-search-english S|k med ett engelskt ord. SW .EMACSCOMNT ;;; m-& edict-search-kanji S|k med ett japanskt ord. SW .EMACSCOMNT ;;; m-+ edict-insert Skriv in senaste hittade ord. END # deduce which tr we have: v6 or v7 case "`echo B | tr A-Z a-z `" in b) trversion=v7 ;; B) trversion=v6 ;; # or System V esac export trversion # Some systems use LANG, not LANGUAGE (i.e. ultrix) export LN LN=$LANGUAGE [ $LN ] || LN=$LANG LN=`echo $LN | sed -n -e 's/^\(..\).*/\1/p'` LN=`echo $LN | case "$trversion" in v6) tr [a-z] [A-Z] ;; v7) tr a-z A-Z ;; esac` case "$LN" in JP) : ;; JP|EN|JA) : ;; SW) : ;; *) echo 'What language should I use?' echo '(EN = English, JA = Japanese, SW = Swedish) [EN]' read LN ;; esac LN=`echo $LN | case "$trversion" in v6) tr [a-z] [A-Z] ;; v7) tr a-z A-Z ;; esac` # Handle any common aliases for the language identifiers, such as the native terms # or country names. case "$LN" in '') LN='EN' ;; EN|ENGLISH|BRITISH|BRITAIN|ENGLAND|US|AMERICAN) LN='EN' ;; JA|'日本'|'日本語'|JAPANESE|NIHONGO|JP|NIHON|JAPAN) LN='JA' ;; SW|SWEDISH|SWEDEN|SWE|SE|SVENSKA|SVERIGE) LN='SW' ;; *) echo "I don't understand the language $LN." LN='EN' ;; esac log LOGHEADER case "$LN" in EN) log LOGBEGIN2 msg LOGBEGIN2 ;; *) log LOGBEGIN msg LOGBEGIN log LOGBEGIN2 msg LOGBEGIN2 ;; esac msg LANGUAGE log LANGUAGE echo msg DEFAULTS echo export DISTDIR msg DISTDIR read DISTDIR [ $DISTDIR ] || DISTDIR=`pwd` export EDICTJDIR msg EDICTJDIR read EDICTJDIR [ $EDICTJDIR ] || EDICTJDIR=$DISTDIR log XEDICTJDIR echo "# Values extracted from nemacs." >$EPATH/emacs.vars cat <$EPATH/emacs.info (setq epath (reverse load-path)) (setq edir (expand-file-name (car epath))) (if (string-match "/$" edir) (setq edir (substring edir 0 (- (length edir) 1)))) (princ (format "export EMACSDIR\nEMACSDIR=%s\n" edir)) (princ (format "export EMACSPATH\nEMACSPATH=%s" (car epath))) (let ((path (cdr epath))) (while path (princ (format ":%s" (car path))) (setq path (cdr path)))) (princ "\n") END nemacs -batch -load $EPATH/emacs.info >>$EPATH/emacs.vars . $EPATH/emacs.vars echo "# End of values extracted from nemacs." >>$EPATH/emacs.vars logappend $EPATH/emacs.vars # OK, let's see if we can install it into the normal location. if [ -w $EMACSDIR ]; then # Yes! export INSTDIR INSTDIR=$EMACSDIR else # No, gotta ask. export INSTDIR msg INSTDIR read INSTDIR [ $INSTDIR ] || INSTDIR=$DISTDIR fi msg XINSTDIR log XINSTDIR # Byte compile the program. log BYTECOMP msg BYTECOMP cat <$EPATH/emacs.comp (load-library "bytecomp") ;;; Fix emacs byte compiler bug... ;;; This used to blow out if given anything with a non-symbol ;;; in the CAR. Emacs 18.57 has a different form of the bug, ;;; where &optional or &rest in the argument list of a lambda ;;; combination silently mis-compiles. --RWK (defun byte-compile-form (form) (setq form (macroexpand form byte-compile-macro-environment)) (cond ((eq form 'nil) (byte-compile-constant form)) ((eq form 't) (byte-compile-constant form)) ((symbolp form) (byte-compile-variable-ref 'byte-varref form)) ((not (consp form)) (byte-compile-constant form)) ((symbolp (car form)) (let ((handler (get (car form) 'byte-compile))) (if handler (funcall handler form) (byte-compile-normal-call form)))) ((and (consp (car form)) (eq (car (car form)) 'lambda)) ;; It's a lambda combination. Turn it into a LET. (let* ((lambda-expr (car form)) (arglist (nth 1 lambda-expr)) (body (nthcdr 2 lambda-expr)) (params (cdr form)) (original-arglist arglist) ; For error reporting (original-params params) ; For error reporting (state nil) ;Last &-keyword seen. (binding-list nil) ;LET's binding list. (arg nil)) ;; Parse the argument list, and build the binding list. ;; Check for invalid arglist syntax as we go. (while arglist (setq arg (car arglist) arglist (cdr arglist)) (cond ((eq arg '&optional ) (when state (error "Illegal argument list syntax: &optional after %s." state)) (setq state arg)) ((eq arg '&rest ) (cond ((or (eq state nil) (eq state '&optional))) (t (error "Illegal argument list syntax: &rest after %s." state))) (setq arg (car arglist) arglist (cdr arglist)) (setq binding-list (cons (list arg (list* 'list params)) binding-list) params nil state arg)) (t (cond ((eq state '&rest) (error "Extra junk after &rest parameter: %s." (cons arg arglist)))) (unless (eq state '&optional) (unless params (error "Insufficient arguments. Arglist=%s\nParameters=%s" original-arglist original-params))) (setq binding-list (cons (list arg (car params)) binding-list) params (cdr params))))) (when params (error "Too many arguments. Arglist=%s\nParameters=%s" original-arglist original-params)) (setq binding-list (nreverse binding-list)) (byte-compile-form (list* 'let binding-list body)))) ;; Things like autoload, macro, mock-lisp. ((consp (car form)) (byte-compile-normal-call form)) (t (error "Illegal form: %s" form))) (setq byte-compile-maxdepth (max byte-compile-maxdepth (setq byte-compile-depth (1+ byte-compile-depth))))) ;;; Now here's another compiler fix: Add eval-when !! (defmacro eval-when (when &rest forms) (and (or (member 'eval when) (member ':execute when)) (mapcar (function eval) forms)) (and (or (member 'load when) (member ':load-toplevel when)) (cons 'progn forms))) (defun macro-function (name) (and (fboundp name) (let ((fun (symbol-function name))) (and (not (atom fun)) (eq (car fun) 'macro) (cdr fun))))) (defun macroexpand-1 (form) (if (atom form) form (if (listp (car form)) form (let ((expander (macro-function (car form)))) (apply expander (cdr form)))))) (defun byte-compile-file-form (form) (let ((expander nil)) (cond ((not (listp form)) form) ((memq (car form) '(defun defmacro)) (let* ((name (car (cdr form))) (tem (assq name byte-compile-macro-environment))) (if (eq (car form) 'defun) (progn (message "Compiling %s (%s)..." filename (nth 1 form)) (cond (tem (setcdr tem nil)) ((and (fboundp name) (eq (car-safe (symbol-function name)) 'macro)) ;; shadow existing macro definition (setq byte-compile-macro-environment (cons (cons name nil) byte-compile-macro-environment)))) (prog1 (cons 'defun (byte-compile-lambda (cdr form))) (if (not noninteractive) (message "Compiling %s..." filename)))) ;; defmacro (if tem (setcdr tem (cons 'lambda (cdr (cdr form)))) (setq byte-compile-macro-environment (cons (cons name (cons 'lambda (cdr (cdr form)))) byte-compile-macro-environment))) (cons 'defmacro (byte-compile-lambda (cdr form)))))) ((eq (car form) 'progn) (cons 'progn (mapcar (function byte-compile-file-form) (cdr form)))) ((listp (car form)) form) ((setq expander (macro-function (car form))) (byte-compile-file-form (macroexpand-1 form))) ((setq expander (get (car form) 'byte-compile-top-level-handler)) (byte-compile-file-form (funcall expander form))) ((eq (car form) 'require) (eval form) form) (t form)))) (put 'eval-when 'eval-when-top-level-handler 'byte-compile-top-level-handler) (defun eval-when-top-level-handler (form) (let ((when (nth 1 form)) (body (nthcdr 2 form))) (princ (format "Eval-when %s...\n" when)) (and (or (member 'compile when) (member ':compile-toplevel when)) (mapcar (function print) body) (mapcar (function eval) body)) (and (or (member 'load when) (member ':load-toplevel when)) (cons 'progn body)))) ;;; Now compile our two files. (byte-compile-file "$DISTDIR/edict.el") (byte-compile-file "$DISTDIR/edict-test.el") END nemacs -batch -load $EPATH/emacs.comp | tee $EPATH/emacs.comp.out logappend $EPATH/emacs.comp logappend $EPATH/emacs.comp.out # Now copy, if they're not already there. if [ $DISTDIR = $INSTDIR ]; then msg NOCPYEDIR log NOCPYEDIR else copy $DISTDIR/edict.ChangeLog $INSTDIR/edict.ChangeLog copy $DISTDIR/edict.el $INSTDIR/edict.el copy $DISTDIR/edict.elc $INSTDIR/edict.elc copy $DISTDIR/edict-test.el $INSTDIR/edict-test.el copy $DISTDIR/edict-test.elc $INSTDIR/edict-test.elc copy $DISTDIR/edict.texinfo $INSTDIR/edict.texinfo fi if [ $EDICTJDIR = $INSTDIR ]; then if [ -f $INSTDIR/edictj ]; then msg NOCPYEJDIR log NOCPYEJDIR else msg EJUSEDEMO log EJUSEDEMO copy $DISTDIR/edictj.demo $INSTDIR/edictj fi else if [ -r $EDICTJDIR/edictj ]; then copy $EDICTJDIR/edictj $INSTDIR/edictj elif [ -f $INSTDIR/edictj ]; then : ; else copy $DISTDIR/edictj.demo $INSTDIR/edictj fi fi if [ "$INSTDIR" = "$EMACSDIR" ]; then LOADFILE=edict else LOADFILE=$INSTDIR/edict fi # Build a file of suggested .emacs setup. echo >$INSTDIR/edict.emacs # Start it off with a language-specific explanatory comment. msg .EMACSCOMNT >>$INSTDIR/edict.emacs sed -e "s!@LOADFILE!$LOADFILE!; s!@INSTDIR!$INSTDIR!" <<'EMACSEND' >>$INSTDIR/edict.emacs (cond ((fboundp 'convert-region-kanji-code) (autoload 'edict-search-english "@LOADFILE" "Search for a translation of an English word") (global-set-key "\e*" 'edict-search-english) (autoload 'edict-search-kanji "@LOADFILE" "Search for a translation of a Kanji sequence") (global-set-key "\e&" 'edict-search-kanji) (autoload 'edict-add-english "@LOADFILE" "Add a translation of an English word") (autoload 'edict-add-kanji "@LOADFILE" "Add a translation of a Kanji sequence") (autoload 'edict-insert "@LOADFILE" "Insert the last item looked up in edict.") (global-set-key "\e+" 'edict-insert) (autoload 'edict-insert-english "@LOADFILE" "Insert the last item looked up in edict.") (autoload 'edict-insert-日本語 "@LOADFILE" "Insert the last item looked up in edict.") (setq *edict-files* '("@INSTDIR/edictj")))) EMACSEND # Extract the script for canonicalizing yes or no from whatever natural language. msg YESNOCONV >$EPATH/yesnoconv while [ "ALWAYS" ]; do msg DOTEMACSQ read DOTEMACSQ DOTEMACSQ=`echo $DOTEMACSQ | case "$trversion" in v6) tr [a-z] [A-Z] ;; v7) tr a-z A-Z ;; esac` DOTEMACSQ=`echo $DOTEMACSQ | (. $EPATH/yesnoconv)` case $DOTEMACSQ in Y|YES) sed -e '/;;; Start of EDICT/,/;;; End of EDICT/ D' $HOME/.emacs >$EPATH/.emacs.out echo ";;; Start of EDICT's automatically-added stuff." >>$EPATH/.emacs.out cat $INSTDIR/edict.emacs >>$EPATH/.emacs.out echo ";;; End of EDICT's automatically-added stuff." >>$EPATH/.emacs.out [ -f $HOME/.emacs ] && mv $HOME/.emacs $HOME/.emacs.orig mv $EPATH/.emacs.out $HOME/.emacs msg DOTEMACSADD log DOTEMACSADD break ;; N|NO) break ;; SHOW) echo more $INSTDIR/edict.emacs more $INSTDIR/edict.emacs ;; *) msg YESORNO ;; esac done if [ -f $EPATH/failure ]; then log FAILURE msg FAILURE else log SUCCESS msg SUCCESS fi