8. スクリプトなど

#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

[