[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[debian-users:03888] gene.el ベータ版
西本です。
HOWTOにつけるプログラムのベータ版をここに示します。perlスクリプトはそ
のまま使ってください。gene.elはまだまだ改良する予定です。
gene-stringまたはgene-string-1とgene-wordを適当なキーに割当ててください。
gene-string-1の方が *GENE*ウィンドウが適当な大きさになり、使いやすいと
思います。
----<gene.el>-
(defvar gene-window-height 5
"*gene*ウィンドウの行数")
(defun gene-string-1 (string)
"英単語を入力し、意味を表示する"
(interactive "sEnglish word: ")
(let (current-window)
(setq current-window (selected-window))
(save-excursion
(set-buffer (get-buffer-create " *GENE*"))
(erase-buffer)
(call-process "dic_look" nil t nil string "/usr/local/lib/genedic/gene.dic2")
(select-window (display-buffer " *GENE*"))
(shrink-window (- (window-height) gene-window-height))
)
(select-window current-window)
)
)
(defun gene-string (string)
"英単語を入力し、意味を表示する"
(interactive "sEnglish word: ")
(let (current-window)
(setq current-window (selected-window))
(save-excursion
(set-buffer (get-buffer-create " *GENE*"))
(erase-buffer)
(call-process "dic_look" nil t nil string "/usr/local/lib/genedic/gene.dic2")
(display-buffer " *GENE*"))
)
)
(defun gene-word ()
"ポイントの前の英単語の意味を表示する"
(interactive)
(save-excursion
(if (not (looking-at "\\<"))
(forward-word -1))
(setq beg (point))
(forward-word 1)
(setq end (point)))
(gene-string (downcase (buffer-substring beg end))))
(defun gene-word2 ()
"Print Japanese meaning of word at or before point."
(interactive)
(save-excursion
(setq end (point))
(if (not (looking-at "\\<"))
(forward-word -1))
(setq beg (point))
(gene-string (downcase (buffer-substring beg end)))))
----<dictionary>
#!/bin/sh
while true;
do
echo -n "dictionary: ";
read word;
if test -z "$word"; then exit; fi
dic_look "$word"
echo;
done;
----<dic_look>
#!/usr/bin/perl
### dic_look 活用語尾対応辞書検索 script
### 活用語のとき活用語尾から原形を調べる。また、語頭の大文字にも対応。
### さらに、複数の辞書でも検索できる。結果は sort された状態で表示。
### look コマンドと置き換えてください。
### 使用方法 : dic_look word
###
### Ver. 1.0 97/11/28 2時間で完成
###
##辞書ファイルのパスとファイル名
##自分の環境に応じて書きかえること
$dic_path = '/usr/local/lib/genedic';
@dic_file = ('gene.dic2');
#@dic_file = ('gene.dic2','term95.dic','papadic5.dic');
###------------------------------------------------------------------
## main code
#&debug;
($word=shift) || die "usage: dic_look word\n";
foreach $dic (@dic_file){
&look_words($dic,&word_conv($word),&word_conv(&capital($word)));
}
print sort rule @output;
## sub routines
sub rule{
##行頭の英語で sort
($aa) = $a =~ /^([a-zA-Z ]+)/;
($bb) = $b =~ /^([a-zA-Z ]+)/;
$aa cmp $bb;
}
sub look ($$){
##単語を辞書で検索
my $dic=shift; my $word=shift;
($word eq '') && return;
open(LOOK,qq?look "$word" $dic_path/$dic |?);
while(<LOOK>){
push (@output,$_) if /^$word\b/;
}
close LOOK;
}
sub look_words ($@){
##複数の単語を検索
my $dic=shift; my @words=@_;
foreach (@words){
&look($dic,$_);
}
}
sub capital ($){
##先頭が大文字なら小文字に変えたものを、そうでなければ '' を返す
local $_ = shift;
if (/^[A-Z]/){
tr/A-Z/a-z/;
return $_;
}else{
return '';
}
}
sub word_conv ($){
##活用形から原形として考えられるものすべてと自分自身を返す
local $_ = shift;
($_ eq '') && return '';
$a='[a-zA-Z]'; $x='[aiueo]'; $y='[^aiueo]';
#比較級、最上級
/^($a+(.))\2e(r|st)$/g && return ($&,"$1","$1$2");
/^($a+)ie(r|st)$/g && return ($&,"$1y","$1ie");
/^($a+)e(r|st)$/g && return ($&,"$1","$1e");
#3単現、複数形
/^($a+)ses$/g && return ($&,"$1s","$1se");
/^($a+)xes$/g && return ($&,"$1x","$1xe");
/^($a+)shes$/g && return ($&,"$1sh","$1she");
/^($a+)ches$/g && return ($&,"$1ch","$1che");
/^($a+)zes$/g && return ($&,"$1z","$1ze");
/^($a+)ies$/g && return ($&,"$1y","$1ie");
#/^($a+$y)ies$/g && return ($&,"$1y","$1ie");
#/^($a+$y)oes$/g && return ($&,"$1o","$1oe");
/^($a+)oes$/g && return ($&,"$1o","$1oe");
/^($a+)ves$/g && return ($&,"$1f","$1fe","$1ve");
/^($a+)s$/g && return ($&,"$1");
#過去形、過去分詞
/^($a+)ied$/g && return ($&,"$1y","$1ie","$1i");
#/^($a+$y)ied$/g && return ($&,"$1y","$1ie","$1i");
/^($a+(.))\2ed$/g && return ($&,"$1","$1$2","$1$2e");
/^($a+c)ked$/g && return ($&,"$1","$1k","$1ke");
/^($a+)ed$/g && return ($&,"$1","$1e");
#現在分詞
/^($a+(.))\2ing$/ && return ($&,"$1","$1$2","$1$2e");
/^($a+c)king$/ && return ($&,"$1","$1k","$1ke");
/^($a+)ying$/ && return ($&,"$1y","$1ye","$1ie");
/^($a+)ing$/ && return ($&,"$1","$1e");
#もともと原形のとき
$_;
}
sub debug {
while(<DATA>){
chomp;
print join(',',&word_conv($_)),"\n";
}
exit;
}