;;; skk-gadget.el --- 実行変換のためのプログラム -*- coding: iso-2022-jp -*-

;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
;;   Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp>

;; Author: Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp>
;; Maintainer: SKK Development Team <skk@ring.gr.jp>
;; Version: $Id: skk-gadget.el,v 1.44 2010/11/29 11:25:43 skk-cvs Exp $
;; Keywords: japanese, mule, input method
;; Last Modified: $Date: 2010/11/29 11:25:43 $

;; This file is part of Daredevil SKK.

;; Daredevil SKK 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.

;; Daredevil SKK 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 Daredevil SKK, see the file COPYING.  If not, write to
;; the Free Software Foundation Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; プログラム実行変換とは
;; ======================
;; 送り仮名のない辞書の変換の候補に Emacs Lisp のコードが書いてあれば、SKK
;; はそのコードを Lisp のプログラムとして実行し、その結果の文字列を画面に挿
;; 入する。例えば、辞書に
;;
;;         now /(current-time-string)/
;;
;; という行があるとき、`/now ' とタイプすれば画面には現在の時刻が表示され、
;; `▼Fri Apr 10 11:41:43 1992' のようになる。
;;
;; ここで使える Lisp のコードは改行を含んでいないものに限られる。またこのコー
;; ドは結果として文字列を返すものでなければならない。
;;
;; このファイルは実行変換プログラムを集めたものである。
;;
;; skk-gadget.el の `gadget' は「上手く工夫した道具」の意味。「色々飛び出す
;; 気のきいたおもちゃ箱」というような意味で名付けられた。
;; 余談だが、X Window で使用される `Widget' という言葉は、`window'+`gadget'
;; から作られた造語らしい。

;;; Code:

(eval-when-compile
  (require 'skk-macs)
  (require 'skk-vars))

;; -- programs
;;;###autoload
(defun skk-current-date (&optional pp-function format and-time)
  "`current-time-string' の出力を加工し、現在の日時 \(string\)を返す。
オプショナル引数の PP-FUNCTION を指定すると、`skk-current-date-1'
の返り値、FORMAT と AND-TIME を引数にして `funcall' する。
PP-FUNCTION の指定がない場合は `skk-default-current-date-function' を
`funcall' する。
FORMAT は `format' の第一引数の様式 \(string\)による出力指定テンプレート。
AND-TIME \(boolean\) を指定すると時刻も返す。
`skk-today' と `skk-clock' のサブルーチン。"
  (unless pp-function
    (setq pp-function skk-default-current-date-function))
  (funcall pp-function
	   (skk-current-date-1) format (not skk-date-ad) and-time))

(defun skk-current-date-1 (&optional specified-time)
  "`current-time-string' の出力を加工し、日付・時刻情報をリストにして返す。
\(year month day day-of-week hour minute second\)"
  (let* ((str (current-time-string specified-time))
	 (date (substring str 8 10)))
    (when (eq (aref date 0) ?\040)
      (setq date (substring date 1)))
    (list
     (substring str 20 24)
     (substring str 4 7)
     date
     (substring str 0 3)
     (substring str 11 13)
     (substring str 14 16)
     (substring str 17 19))))

;;;###autoload
(defun skk-default-current-date
  (date-information
   format num-type gengo gengo-index month-alist-index dayofweek-alist-index
   &optional and-time)
  "\
日付情報の標準的な出力をする他、ユーザにある程度のカスタマイズ機能を提供する。
この関数の引数でカスタマイズできない出力を希望する場合は、
`skk-default-current-date-function' に自前の関数を指定する。

DATE-INFORMATION は `current-time-string' が返した文字列を

  \(year month day day-of-week hour minute second\)

の形式で変換したリスト \(各要素は文字列\)。
FORMAT は `format' の第一引数の様式による出力形態を指定する文字列。
  nil であれば \"%s年%s月%s日\(%s\)%s時%s分%s秒\" \(もしくは
  \"%s年%s月%s日\(%s\)\" が使われる。
NUM-TYPE \(number\) は
  0 -> 無変換,
  1 -> 全角数字へ変換,
  2 -> 漢数字へ変換 \(位取りなし\),
  3 -> 漢数字へ変換 \(位取りをする\),
  4 -> その数字そのものをキーにして辞書を再検索,
  5 -> 漢数字 \(手形などで使用する文字を使用\)へ変換 \(位取りをする\),
  9 -> 将棋で使用する数字 \(\"３四\" など\) に変換
GENGO は元号表示するかどうか \(boolean\)。
GENGO-INDEX は `skk-gengo-alist' の各要素の cadr を 0 とする index
 \(number\)。nil であれば `current-time-string' の出力のまま無変換。
MONTH-ALIST-INDEX は `skk-month-alist' の各要素の cadr を 0 とする
 index \(number\)。nil であれば `current-time-string' の出力のまま無変換。
DAYOFWEEK-ALIST-INDEX は `skk-day-of-week-alist' の各要素の cadr を
 0 とする index \(number\)。nil であれば `current-time-string' の出力のま
ま無変換。
AND-TIME は時刻も表示するかどうか \(boolean\)。"
  (let ((year (car date-information))
	(month (nth 1 date-information))
	(day (nth 2 date-information))
	(day-of-week (nth 3 date-information))
	(hour (nth 4 date-information))
	(minute (nth 5 date-information))
	(second (nth 6 date-information))
	v)
    (when gengo
      (setq v (skk-ad-to-gengo-1 (string-to-number year))))
    (setq year (if gengo
		   (concat (if gengo-index
			       (nth gengo-index (car v))
			     (car (car v)))
			   (skk-num-exp (number-to-string (cdr v))
					num-type))
		 (skk-num-exp year num-type)))
    (when month-alist-index
      (setq month (skk-num-exp (nth month-alist-index
				    (cdr (assoc month skk-month-alist)))
			       num-type)))
    (setq day (skk-num-exp day num-type))
    (when dayofweek-alist-index
      (setq day-of-week (nth dayofweek-alist-index
			     (cdr (assoc day-of-week skk-day-of-week-alist)))))
    (when and-time
      (setq hour (skk-num-exp hour num-type))
      (setq minute (skk-num-exp minute num-type))
      (setq second (skk-num-exp second num-type)))
    (if and-time
	(format (or format "%s年%s月%s日(%s)%s時%s分%s秒")
		year month day day-of-week hour minute second)
      (format (or format "%s年%s月%s日(%s)") year month day day-of-week))))

(defun skk-today-execute-char ()
  (let ((tree (nth 4 skk-rule-tree))
	list char)
    (while (setq list (car tree))
      (if (memq 'skk-today list)
	  (setq char (char-to-string (car list))))
      (setq tree (cdr tree)))
    char))

;;;###autoload
(defun skk-today (arg)
  "\
`current-time-string' の出力を加工し、現在の日時を表す文字列を作り、挿入
する。実質的に「today エントリの呼び出し」だけなので、カスタマイズは個人
辞書の today エントリによる。"
  (interactive "p")
  (if (and (eq skk-henkan-mode 'on)	;▽モード
	   (equal (this-command-keys) (skk-today-execute-char))
	   (< skk-henkan-start-point (point)))
      (this-command-keys)
    ;;
    (unless skk-mode
      (skk-mode 1))
    (skk-set-henkan-point-subr)
    (insert "today")
    (skk-start-henkan arg)))

;;;###autoload
(defun skk-clock (&optional kakutei-when-quit time-signal)
  "デジタル時計をミニバッファに表示する。
quit するとその時点の日時を候補として挿入する。
quit したときに起動してからの経過時間をミニバッファに表示する。
interactive に起動する他、\"clock /(skk-clock)/\" などのエントリを SKK の辞書
に加え、\"/clock\"+ SPC で変換することによっても起動可。C-g で止まる。
実行変換で起動した場合は、C-g した時点の時点の日時を挿入する。
オプショナル引数の KAKUTEI-WHEN-QUIT が non-nil であれば C-g したときに確
定する。
オプショナル引数の TIME-SIGNAL が non-nil であれば、NTT の時報風に ding する。
それぞれ \"clock /(skk-clock nil t)/\" のようなエントリを辞書に挿入すれば良い。
skk-date-ad と skk-number-style によって表示方法のカスタマイズが可能。"
  (interactive "*")
  (let ((start (current-time))
	end
	mes
	expr1 expr2
	sec
	snd)
    (cond
     ((or (not skk-number-style)
	  (eq skk-number-style 0))
      (setq expr1 "[789]秒"
	    expr2 "0秒"))
     ((or (eq skk-number-style t)
	  ;; skk-number-style に 数字と t 以外の non-nil 値を入れている場
	  ;; 合、= を使うと Wrong type argument: number-or-marker-p, xxxx
	  ;; になってしまう。
	  (eq skk-number-style 1))
      (setq expr1 "[７８９]秒"
	    expr2 "０秒"))
     (t
      (setq expr1 "[七八九]秒"
	    expr2 "〇秒")))
    ;;
    (when (eval-when-compile (featurep 'xemacs))
      ;; XEmacs で sound がロードされているかどうか。
      (when (setq snd
		  (and (boundp 'sound-alist)
		       (eq t (catch 'tag
			       (mapc
				#'(lambda (list)
				    (when (eq 'drum (cadr (memq :sound list)))
				      (throw 'tag t)))
				sound-alist)))))
	(unless (assq 'clink sound-alist)
	  (load-sound-file "clink" 'clink))))
    ;;
    (save-match-data
      (condition-case nil
	  (let (case-fold-search
		inhibit-quit
		visible-bell)
	    (while (not quit-flag)
	      (setq mes (skk-current-date nil nil t)
		    sec 0)
	      (message "%s    Hit any key to quit" mes)
	      (when time-signal
		(cond
		 ((string-match expr1 mes)
		  ;; [7890] のように正規表現を使わず、7 だけで全てのマシンが
		  ;; 着いてゆけば良いのだが...。丁度この関数実行時に Garbage
		  ;; collection が呼ばれても表示される数字が飛ぶ場合がある。
		  (skk-ding nil 'drum))
		 ((string-match expr2 mes)
		  ;; 0 だけ「ポ〜ン」といきたいところですが、マシンによっ
		  ;; て差がある。
		  ;; 386SX 25Mhz + Mule-2.x だと「ピッ、ピッ」という感じ。
		  ;; 付いてゆくのが非常に辛い。68LC040 33Mhz + NEmacs だと
		  ;; 「ピピッ」となり、音のタイミングは良いのだが、とき
		  ;; どき 1 秒分ついていけなくなる。Pentium 90Mhz +
		  ;; Mule-2.xだと「ピッ」という単音になってしまう... (;_;)。
		  (if snd
		      (skk-ding nil 'clink)
		    (ding)
		    (unless (skk-sit-for (setq sec (+ sec 0.16))
					 'nodisplay)
		      (next-command-event)
		      (signal 'quit nil))
		    (ding)))))
	      (unless (skk-sit-for (- 1 sec) 'nodisplay)
		(next-command-event)
		(signal 'quit nil))))
	(quit
	 (prog2
	     (setq end (current-time))
	     (skk-current-date nil nil t)
	   (when kakutei-when-quit
	     (setq skk-kakutei-flag t))
	   (message "経過時間: %s 秒"
		    (skk-time-difference start end))))))))

;;;###autoload
(defun skk-ad-to-gengo (gengo-index &optional divider tail not-gannen)
  ;; 西暦を元号に変換する。オプション引数の divider が指定されていれば、年号と
  ;; 数字の間に、tail が指定されていれば、数字の末尾に、それぞれの文字列を連結
  ;; する。
  ;; 辞書見出し例;
  ;; せいれき#ねん /(skk-ad-to-gengo 0 nil "年")/(skk-ad-to-gengo 0 " " " 年")/
  (let ((v (skk-ad-to-gengo-1 (string-to-number
			       (car skk-num-list))
			      not-gannen)))
    (concat (nth gengo-index (car v))
	    divider
	    (if (not (stringp (cdr v)))
		(number-to-string (cdr v))
	      (cdr v))
	    tail)))

;;;###autoload
(defun skk-ad-to-gengo-1 (ad &optional not-gannen)
  ;; AD is a number and NOT-GANNEN is a boolean optional
  ;; arg.
  ;; return a cons cell of which car is a Gengo list
  ;; gotten from `skk-gengo-alist', and cdr is a number
  ;; of year.
  ;; if NOT-GANNEN is non-nil and calculated year is 1,
  ;; return a value of which cdr is "元" (string).
  (when (>= 1866 ad)
    (skk-error "分りません" "Unkown year"))
  (cons (cond ((>= 1911 ad)
	       (setq ad (- ad 1867))
	       (cdr (assq 'meiji skk-gengo-alist)))
	      ((>= 1925 ad)
	       (setq ad (- ad 1911))
	       (cdr (assq 'taisho skk-gengo-alist)))
	      ((>= 1988 ad)
	       (setq ad (- ad 1925))
	       (cdr (assq 'showa skk-gengo-alist)))
	      (t
	       (setq ad (- ad 1988))
	       (cdr (assq 'heisei skk-gengo-alist))))
	(cond (not-gannen ad)
	      ((= ad 1) "元")
	      (t ad))))

;;;###autoload
(defun skk-gengo-to-ad (&optional head tail)
  ;; 元号を西暦に変換する。オプション引数の HEAD, TAIL が指定されてい
  ;; れば、その文字列を先頭、末尾に連結する。
  ;; 辞書見出し例;
  ;;   しょうわ#ねん /(skk-gengo-to-ad "" "年")/(skk-gengo-to-ad "" " 年")/\
  ;;   (skk-gengo-to-ad "西暦" "年")/(skk-gengo-to-ad "西暦" " 年")/
  (save-match-data
    (when (string-match (car skk-num-list)
			skk-henkan-key)
      (let ((v (skk-gengo-to-ad-1
		(substring skk-henkan-key 0 (match-beginning 0))
		(string-to-number (car skk-num-list)))))
	(when v
	  (concat head
		  (number-to-string v)
		  tail))))))

;;;###autoload
(defun skk-gengo-to-ad-1 (gengo number)
  ;; GENGO is a string and NUMBER is a number.
  ;; return a year (number) equal to GENGO-NUMBER.
  (+ number
     (cond
      ((eq number 0)
       (skk-error "0 年はあり得ない"
		  "Cannot convert 0 year"))
      ((member gengo '("へいせい" "平成"))
       1988)
      ((member gengo '("しょうわ" "昭和"))
       (if (> 64 number)
	   1925
	 (skk-error "昭和は 63 年までです"
		    "The last year of Showa is 63")))
      ((member gengo '("たいしょう" "大正"))
       (if (> 15 number)
	   1911
	 (skk-error "大正は 14 年までです"
		    "The last year of Taisyo is 14")))
      ((member gengo '("めいじ" "明治"))
       (if (> 45 number)
	   1867
	 (skk-error "明治は 44 年までです"
		    "The last year of Meiji is 44")))
      (t
       (skk-error "判別不能な元号です！"
		  "Unknown Gengo!")))))

;;;###autoload
(defun skk-calc (operator)
  ;; 2 つの引数を取って operator の計算をする。
  ;; 注意: '/ は引数として渡せないので (defalias 'div '/) などとし、別の形で
  ;; skk-calc に渡す。
  ;; 辞書見出し例; #*# /(skk-calc '*)/
  (number-to-string (apply operator
			   (mapcar 'string-to-number
				   skk-num-list))))

;;;###autoload
(defun skk-plus ()
  ;; 辞書見出し例; #+#+# /(skk-plus)/
  (skk-calc '+))

;;;###autoload
(defun skk-minus ()
  (skk-calc '-))

;;;###autoload
(defun skk-times ()
  (skk-calc '*))

;;;###autoload
(defun skk-ignore-dic-word (&rest no-show-list)
  ;; 共用辞書に登録されている、違っている/気に入らない変換を出さないようにす
  ;; る。
  ;; 辞書見出し例;
  ;;   るすばん /留守番/(skk-ignore-dic-word "留守電")/
  ;;   かくてい /(skk-ignore-dic-word "確定")/
  (let (new-word)
    ;; skk-ignore-dic-word 自身のエントリを消す。消すべき候補は
    ;; skk-henkan-list から直接抽出しているので delete ではなく delq で十分。
    (setq skk-henkan-list (delq (nth skk-henkan-count skk-henkan-list)
				skk-henkan-list))
    ;; 全候補を skk-henkan-list に入れる。
    (while skk-current-search-prog-list
      (setq skk-henkan-list (skk-nunion skk-henkan-list (skk-search))))
    ;; 不要な候補を捨てる。
    (while no-show-list
      (setq skk-henkan-list (delete (car no-show-list) skk-henkan-list)
	    no-show-list (cdr no-show-list)))
    ;; カレントの候補 (skk-ignore-dic-word 自身のエントリ) を消したので、
    ;; skk-henkan-count は次の候補を指している。
    (setq new-word (or (nth skk-henkan-count skk-henkan-list)
		       (skk-henkan-in-minibuff)))
    ;; 候補がないとき。
    (unless new-word
      ;; 空文字列が登録されたら辞書登録の前の状態に戻す。
      ;; (nth -1 '(A B C)) は、A を返すので、n が負の数でないことをチェック
      ;; しておく必要がある。
      (if (> skk-henkan-count 0)
	  (setq skk-henkan-count (- skk-henkan-count 1)
		new-word (nth skk-henkan-count skk-henkan-list))
	;; (1- skk-henkan-count) == -1 になる。▽モードに戻す。
	(throw 'next-word 'none)))
    ;;
    (throw 'next-word new-word)))

;;;###autoload
(defun skk-henkan-face-off-and-remove-itself ()
  ;; skk-insert-new-word-function にセットするための関数。カレントバッファの
  ;; 変換部分が Overlay の face 属性によって表示が変更されているのを戻し、その
  ;; 後自分自身を skk-insert-new-word-function から取り除く自爆関数。
  (skk-henkan-face-off)
  (setq skk-insert-new-word-function nil))

;;;###autoload
(defun skk-gadget-units-conversion (unit-from number unit-to)
  "`skk-units-alist'を参照し、換算を行なう。
NUMBER について UNIT-FROM から UNIT-TO への換算を行なう。"
  (let ((v (assoc unit-to
		  (cdr (assoc unit-from skk-units-alist)))))
    (when v
      (concat (number-to-string (* number (cdr v)))
	      (car v)))))

(run-hooks 'skk-gadget-load-hook)

(provide 'skk-gadget)

;;; skk-gadget.el ends here
