| |
次のページ
前のページ
目次へ
#begin 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/dictionary';
#@dic_file = ("$ENV{HOME}/words",'ej.dic');
#@dic_file = ('gene.dic2','term95.dic','papadic5.dic');
$dic_path = '/usr/dict';
@dic_file = ('./eijirou.sdic');
###------------------------------------------------------------------
## main code
#&debug;
($word=shift) || die "usage: dic_look word\n";
#ここから改良
if($word =~ /^[0-9a-zA-Z]/){
foreach $dic (@dic_file){
&look_words($dic,&word_conv($word),&word_conv(&capital($word)));
}
# print sort rule @output;
print @output;
}else{
chdir $dic_path;
system('grep',$word,@dic_file);
}
## 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;
chdir $dic_path;
# open(LOOK,qq?look -f "■$word" $dic |?);
open(LOOK,qq?sass "<K>$word</K>" $dic ; sass "<K>$word " $dic |?);
while(<LOOK>){
s/^.+<K>(.+)<\/K>(.+)$/\1 :\2/;
push (@output,$_);
# push (@output,$_) if /^■$word\b/i;
}
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");
#副詞の ly
/^($a+)ly$/ && return ($&,"$1");
#もともと原形のとき
$_;
}
sub debug {
while(<DATA>){
chomp;
print join(',',&word_conv($_)),"\n";
}
exit;
}
__END__
#end dic_look
#begin dictionary
#!/bin/sh
while true;
do
echo -n "dictionary: ";
read word;
if test -z "$word"; then exit; fi
dic_look "$word"
echo;
done;
#end dictionary
;begin dictionary.el
(defvar gene-window-height 5
"*gene*ウィンドウの行数")
(defvar gene-buffer " *GENE*"
"gene 辞書を表示するバッファ")
(defvar gene-frame-alist
'((width . 70) ;表示桁数
(height . 30) ;表示行数
(menubar . nil) ;ミニバッファなし
(title . "GENE dictionary") ;タイトル
)
"gene 辞書を表示するフレームのパラメータ(X使用時だけ有効).
好きなように書き換えてください。")
(setq truncate-partial-width-windows nil)
(if (boundp 'MULE)
(define-program-coding-system
nil "dic_look" (cons *euc-japan*unix *euc-japan*unix))
;; in Emacs20
(set-language-environment "Japanese")
(set-terminal-coding-system 'euc-japan)
(set-default-coding-systems 'euc-japan))
(defvar gene-mode-map nil
"gene辞書を表示するバッファで使うキーマップ")
(cond ((not gene-mode-map)
(setq gene-mode-map (make-sparse-keymap))
(let ((i ?a))
(while (<= i ?z)
(define-key gene-mode-map (char-to-string i) 'gene-string-in-gene-buffer)
(setq i (1+ i))))
(define-key gene-mode-map "\C-m" 'gene-insert-to-text)))
(defun gene-mode ()
"gene辞書 メジャーモード"
(setq major-mode 'gene-mode
mode-name "GENE")
(use-local-map gene-mode-map)
(run-hooks 'gene-mode-hook))
(defun gene-string-1 (string)
"英単語を入力し、意味を表示する(インターフェース1)
適当なキーに割り当ててください。"
(interactive "sEnglish word: ")
(let (current-window)
(setq current-window (selected-window))
(save-excursion
(set-buffer (get-buffer-create gene-buffer))
(if (not (eq major-mode 'gene-mode)) (gene-mode))
(erase-buffer)
(call-process "dic_look" nil t nil string )
(select-window (display-buffer gene-buffer))
(shrink-window (- (window-height) gene-window-height))
)
(select-window current-window)
)
)
(defun gene-display-buffer ()
"gene バッファを表示する"
(if (and (>= (window-width) 82))
(progn
(split-window-horizontally 80)
(other-window 1)
(switch-to-buffer gene-buffer)
(other-window -1)
(display-buffer gene-buffer)
)))
(defun gene-string (string)
"英単語(日本語)を入力し、意味を表示する(インターフェース2)
日本語を入力したときには、grepをかける。
適当なキーに割り当ててください。"
(interactive "sEnglish(Japanese) word: ")
(let (current-window)
(setq current-window (selected-window))
(save-excursion
(set-buffer (get-buffer-create gene-buffer))
(if (not (eq major-mode 'gene-mode)) (gene-mode))
(erase-buffer)
(call-process "dic_look" nil t nil string )
(goto-char (point-min))
(if (not (get-buffer-window " *GENE*" t)) (gene-display-buffer))
; (set-buffer (get-buffer gene-buffer))
)
)
)
(defun gene-insert-to-text ()
"辞書の内容1行をもう一方のウィンドウのバッファに書き出す"
(interactive)
(beginning-of-line)
(let* ((beg (point))
(end (progn (next-line 1) (point)))
(str (buffer-substring-no-properties beg end)))
(other-window -1)
(insert str)))
(defun gene-word (ARG)
"ポイントの前の英単語の意味を表示する。適当なキーに割り当ててください"
(interactive "p")
(if (null ARG) 1)
(save-excursion
(if (not (looking-at "\\<"))
(forward-word -1))
(setq beg (point))
(forward-word ARG)
(setq end (point)))
(gene-string (downcase (buffer-substring-no-properties 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)))))
;; utility function
(defun gene-string-in-gene-buffer ()
"gene-mode では、アルファベット文字を入力したとたんに gene-string が起動される。"
(interactive)
(gene-string (read-string "English word: " (this-command-keys))))
;end dictionary.el
次のページ
前のページ
目次へ
|