#xyzzy で その場で電卓計算してくれる

calc-onthespot.l

;;
;; calc-onthespot.l
;;
;;## ■ calc-onthespot.l とは？
;;
;;### □テキスト入力中にその場で数値計算ができる。
;;計算式を書けば、任意の場所で 計算結果に変換します。例えば、
;;```
;;	「12年間の歳月」と一言で言うが、分で言うと 12*365*24*60 分になる。
;;```
;;などと書いていた場合、12*365*24*60 の後ろにカーソルを合わせて 実行すると、
;;
;;```
;;	「12年間の歳月」と一言で言うが、分で言うと 6,307,200 分になる。
;;```
;;と、その場で計算して 数字に書き換わります。
;;
;;### □calc-modeで漢数字が使える
;;calc-modeの入力のときに漢数字(全角数字,カンマ区切り数字)を使うことができるようになります。
;;
;;## ■動作環境
;;	xyzzy-0.2.2.245/0.2.2.252 での実行を確認しました。
;;
;;## ■インストール
;;	1. calc-onthespot.l を site-lisp に置いてください。
;;	2. .xyzzy / sitelinit.l に calc-onthespot 関数を任意のキーにバインドします。
;;	  すなわち、たとえば
;;```
;;(global-set-key '(#\C-c #\=) #'(lambda() (interactive)
;;                                 (require "calc-onthespot")
;;                                 (calc-onthespot)))
;;```
;;もしくは任意のモードの キーモードマップに
;;```
;; (define-key *foobarbar-mode-map* '(#\C-c #\=) #'(lambda() (interactive)
;;                                 (require "calc-onthespot")
;;                                 (calc-onthespot)))
;;```
;;などと入れます。
;;
;;	3.リージョンの数式を計算する calc-onthespot-region もあります。こちらは改行コードが入っていてもOKです。
;;	  こちらの場合、.xyzzy / sitelinit.l に calc-onthespot-region 関数を任意のキーにバインドします。
;;	  すなわち、たとえば
;;```
;;(global-set-key '(#\C-c #\-) #'(lambda() (interactive)
;;                                 (require "calc-onthespot")
;;                                 (calc-onthespot-region)))
;;```
;;もしくは任意のモードの キーモードマップに
;;```
;; (define-key *foobarbar-mode-map* '(#\C-c #\-) #'(lambda() (interactive)
;;                                 (require "calc-onthespot")
;;                                 (calc-onthespot-region)))
;;```
;;などと入れます。
;;
;;## ■使い方 (calc-onthespot: リージョン指定なしで実行)
;;	1. [半角スペーススタート]任意の場所で、半角スペースを１つ入れた後、スペースを含まない数式 を書いて、バインドしたキーを押下。
;;	   この場合でも "(～)"で囲まれている場所はスペースが含まれていてもOK
;;	2. [$スタート]任意の場所で "$"記号スタートで 半角で任意の数式 を書いて、バインドしたキーを押下。
;;	   この場合は 半角スペースならいくら含まれていてもOK
;;	3. [@スタート]任意の場所で "@"記号スタートで 半角で任意の数式 を書いて、バインドしたキーを押下。
;;	   この場合、$と同じ動きをしますが、もとの数式は 残したままで 計算結果を カーソルの位置に展開します。
;;	4. [=エンド]数式の最後が "="記号で終わっている場合、もとの数式は 残したままで 計算結果を カーソルの位置に展開します。
;;
;;## ■使い方 (calc-onthespot-region: リージョン指定して実行)
;;	0. 改行コードは 半角スペースに変換します。
;;	1. [=エンド]数式の最後が "="記号で終わっている場合、もとの数式は 残したままで 計算結果を カーソルの位置に展開します。
;;
;;## ■ ケタ区切りの "," の扱い
;;	標準では、結果が整数値で 1000を超える場合、3桁ごとに "," を入れます。
;;	.xyzzy/siteinit.lに
;;	```
;;	(setq *calc-onthespot-thousand-separate-mode* nil)
;;	```
;;	と入れていただければ、この","を入れないようにします。
;;	ただし、計算式にすでに "," が入っていた場合はそちらに合せます。
;;	※整数値以外の結果、すなわち小数部があっても 3桁毎区切りたい方は... 自由に直してください。
;;	  ソース中にサンプルコードを入れてありますのでご参考までに。
;;
;;## ■ 全角数字、全角計算記号の扱い
;;	全角数字、記号にも対応します(混在もOK)。計算式を英数字(ascii)の範囲で半角に変換してから計算します。結果は半角です。
;; (全部全角で)
;; ３＊（３００＊２００＋５００）＝
;;→
;; ３＊（３００＊２００＋５００）＝181,500
;;
;;## ■ 漢数字(大数)に対応
;;	漢数字を『無量大数(１０の６８乗)』の桁まで対応しました。大字(壱弐参伍拾廿萬)にも対応しています。
;; 二億三千万/２０万＝1,150
;; ６万８０００＊１．２＝81600.0
;; 弐拾＊六百万＝120,000,000
;; 千百十一*3=3,333
;; 1無量大数2不可思議3那由他/1阿僧祇=1,000,200,030,000
;;
;;## ■使い方(こつ)
;;- 数字と数字の間に 空白しかない場合、"+"演算子を入れます。
;;	```
;;	 $1 2 3 4 5 6 7 8 9 10 11 12 ;→ 78
;;	```
;;	regionで使うと、複数行のsummationをとることができます。
;;	```
;;	    6,700,212
;;	    9,170,030
;;	  320,113,213
;;	 =
;;	```
;;	```
;;	    6,700,212
;;	    9,170,030
;;	  320,113,213
;;	 =335,983,455
;;	```
;;
;;- 数字のなかの ","を除いてから計算します。このため"1,000*10" などがそのまま計算できる、のはいいのですが、
;;calcから関数を呼ぶときの引数が２つ以上あるときに困ります。この場合は 引数列挙のカンマの前後どちらかに空白を入れてください。
;;	```
;;	 gcd(171, 1957) ;→ 19
;;	```
;;なのでこういうこともできます。
;;	```
;;	 gcd(5,548,399 , 1,957) ;→ 19
;;	```
;;	
;;## ■使い方(おまけ)
;;- calcに ''calc::vat''関数をつけました。''消費税を加算した値''を計算します。(標準では ''1.08'' を掛けて小数点以下を''切り捨て''ます)
;;	```
;; vat(400 100 990 390 110)=2,149
;;	```
;;また、計算式の最後に"vat"があったら数式の結果を vat関数にかけて出力します。
;;	```
;; $ 450 180 1000 800 vat=2,624
;;	```
;;税率と端数の計算方法を変更するには次のようにします。
;;	```
;; (setq *calc-onthespot-vat-rate* 0.05)        ;;5%      (標準は 8%)
;; (setq *calc-onthespot-vat-op-frac* 'round)   ;;四捨五入(標準は 切り捨て)
;;	```
;;- calcに ''calc::age''関数をつけ加えました。
;;	:第1引数|生年月日(%Ymd yyyyMMdd形式の整数)
;;	:第2引数|基準日(%Ymd yyyyMMdd形式の整数)。省略した場合はシステム日付
;;	```
;;	 彼の年齢は$age(19551221)歳です。 ;→ 彼の年齢は58歳です。
;;	```
;;	やら
;;	```
;;	 彼の平成26年度の年度年齢は$age(19551221, 20150331)歳です。 ;→ 彼の平成26年度の年度年齢は59歳です。
;;	```
;;	ということができます。
;;- calcに''calc::today''という関数をつけました。今日の日付を %Ymd 形式(yyyyMMdd)の整数値で返します。何に使うかというと
;;	```
;;	 彼の年齢は$floor((today() - 19551221) / 10000)歳です。
;;	```
;;	を
;;	```
;;	 彼の年齢は58歳です。
;;	```
;;	にすることができる、ということですね。
;;
;;## ■使い方(漢数字パッケージによるすごいおまけ)
;;	副産物として作成した漢数字パッケージが 色々使えそうです。
;;- まず、calc-modeで漢数字を使えるようにする方法がこれ。
;; (add-hook 'ed::*calc-mode-hook*
;;           #'(lambda ()
;;               ;;(require "calc-ext")  ;← calc-extを使う場合はここで読んでください
;;               (require "calc-onthespot")
;;               (define-key ed::*calc-mode-map* #\RET
;;                           'calc-onthespot-eval-line)))
;;	とすることで、calc-modeで
;; $ ３８万＊１．９８
;;	などと入力してEnterを押すと、
;; $ 380000*1.98
;; 752400.0
;; $ 
;;	と動作するようになります。もちろん
;; $ １無量大数 / 3不可思議
;;	と入力してEnterを押すと、
;; $ 100000000000000000000000000000000000000000000000000000000000000000000 / 30000000000000000000000000000000000000000000000000000000000000000
;; 3333.333333333334
;; $ 
;;	となります。
;;- 次に、「編集→変換」の一つに「漢数字→算用数字」を付け加える方法。
;; (add-hook '*init-app-menus-hook*
;;           #'(lambda()
;;               (require "calc-onthespot")
;;               (add-menu-item (get-menu (get-menu *app-menu* 'ed::edit) :convert-popup) nil
;;                              "漢数字 -> 算用数字"
;;                              'calc-onthespot-kansuji-exchange-selection :any-selection)
;;               (add-menu-item *app-popup-menu* nil
;;                              "漢数字 -> 算用数字"
;;                              'calc-onthespot-kansuji-exchange-selection :any-selection)))
;;として、xyzzyを起動しなおせば、selectionを指定して 右クリックメニューや
;;編集→変換メニューで「漢数字→算用数字」変換ができるようになります。
;;
;;## ■ calc-modeがあるのになんで作ったの？
;;calc-modeは素晴らしいですよね。xyzzyの特長だと思うし、気軽に使えるのは最高。
;;だけど単体で使うばかりじゃないし、計算したくなるときは大抵テキスト編集しているわけで。
;;その場で計算して入れられればいいな。と思った次第。あと "," を除く一手間が面倒だったんだ。
;;
;;## ■ やってることは
;;カーソルの前の数式っぽいものをカットして calc.l の calc-stringに流し込んで
;;結果をinsertしてるだけです。
;;
;;## ■ 謝辞
;;誰かがすでに必ず作ってると思うので、その方に感謝します。
;;
;;### ■変更履歴
;;	[2014/04/10] 消費税計算関数vatで大きな数字でもオーバーフローしないように修正。
;;	[2014/04/09] 漢数字をcalc-modeで使う場合、calc-ext.l とケンカしないように修正
;;	[2014/04/08] 漢数字(無量大数[１０の６８乗]まで)に対応。"弐拾＊六百万" など。
;;	[2014/04/07] 全角英数字に対応。結果値の表記に "d0"が入る問題の対処。
;;	[2014/04/03] 消費税計算関数vat追加しました。デフォルトは 8%です。(2014/04/01 より日本の消費税率は8%になりました。)
;;	[2014/04/02] calc-onthespot-region 追加。数値間が空白なら"+"を補填。
;;	[2014/04/01] 年齢計算関数age追加。2値引数の存在に気づいて慌てて直す。リファクタリング。
;;	[2014/03/31] 初版作成。github gist に公開。
;;
;;## ■License
;;MITライセンスです。
;;
;;	Copyright (c) 2014 Okayu3
;;	Released under the MIT license
;;	http://opensource.org/licenses/mit-license.php
;;

(require "calc")
(defvar *calc-onthespot-vat-rate* 0.08)
(defvar *calc-onthespot-vat-op-frac* 'truncate)   ;;切り捨て
;;(defvar *calc-onthespot-vat-op-frac* 'round)    ;;四捨五入
;;(defvar *calc-onthespot-vat-op-frac* 'ceiling)  ;;切り上げ

(defun calc::vat (x)
  (apply *calc-onthespot-vat-op-frac*
         (list
          (let ((*read-default-float-format* 'double-float))
            (/ (* x (truncate (* 1000 (+ 1 *calc-onthespot-vat-rate*)))) 1000)))))
(defun calc::today ()
  (parse-integer (format-date-string "%Y%m%d")))
(defun calc::age (&rest lst)
  (let ((ymd-birth (nth 0 lst))
        (at-ymd (nth 1 lst)))
    (when ymd-birth
      (if (null at-ymd) (setf at-ymd (calc::today)))
      (floor (/ (- at-ymd ymd-birth) 10000)))))
(defvar *calc-onthespot-thousand-separate-mode* t)
(defun calc-onthespot ()
  (interactive)
  (let ((input (calc-onthespot-previous-word)))
    (when input
      (let ((calc-input (map-to-half-width-string (string-trim " \n\t" input) :ascii t :hiragana nil :katakana nil))
            (remain-mode nil)
            (thousand-separate-mode *calc-onthespot-thousand-separate-mode*))
        (setf calc-input
              (if (equal #\$ (char calc-input 0))
                  (substring calc-input 1)
                (if (equal #\@ (char calc-input 0))
                    (progn
                      (setf remain-mode t)
                      (substring calc-input 1))
                  calc-input)))
        (if (equal #\= (char calc-input (- (length calc-input) 1)))
            (progn
              (setf remain-mode t)
              (setf calc-input (substring calc-input 0 -1))))
        (when (string-match "\," calc-input)
          (setf calc-input (substitute-string calc-input "\\([0-9]\\)\,\\([0-9]\\)" "\\1\\2"))
          ;;(setf calc-input (substitute-string calc-input "\\(\\w\\)\,\\(\\w\\)" "\\1\\2"))
          ;;(setf calc-input (substitute-string calc-input "\," ""))
          (setf thousand-separate-mode t))
        (let* ((result-dsc (calc-onthespot-calc calc-input thousand-separate-mode)))
          (when result-dsc
            (if (not remain-mode)
                (backward-delete-char-untabify (length input)))
            (insert result-dsc)))
        ))))

(defun calc-onthespot-region ()
  (interactive)
  (let ((mk (mark t)))
    (when mk
      (let* ((p-b (region-beginning))
             (p-e (region-end))
             (input (buffer-substring p-b p-e))
             (thousand-separate-mode *calc-onthespot-thousand-separate-mode*)
             remain-mode
             (calc-input (map-to-half-width-string (string-trim " \n\t" input) :ascii t :hiragana nil :katakana nil))
             )
        (if (equal #\@ (char calc-input 0))
            (progn
              (setf remain-mode t)
              (setf calc-input (substring calc-input 1))))
        (if (equal #\= (char calc-input (- (length calc-input) 1)))
            (progn
              (setf remain-mode t)
              (setf calc-input (substring calc-input 0 -1))))
        (when (string-match "\," calc-input)
          (setf calc-input (substitute-string calc-input "\\(\\w\\)\,\\(\\w\\)" "\\1\\2"))
          (setf thousand-separate-mode t))
        (setf calc-input (substitute-string calc-input "\n" " "))
        (let* ((result-dsc (calc-onthespot-calc calc-input thousand-separate-mode)))
          (when result-dsc
            (if (not remain-mode)
                (backward-delete-char-untabify (length input)))
            (insert result-dsc)))
        ))))

(defun calc-onthespot-calc (calc-input thousand-separate-mode)
  (setf calc-input (string-trim " " calc-input))
  (if (string-match "vat$" calc-input)
      (setf calc-input (concat "vat(" (substring calc-input 0 -3) ")")))
  (setf calc-input (calc-onthespot-kansuji-exchange  calc-input))
  (while (string-match "[0-9０-９.]+[ \t]+[0-9０-９.]+" calc-input)
    (setf calc-input (substitute-string calc-input "\\([0-9０-９.]+\\)[ \t]+\\([0-9０-９.]+\\)" "\\1+\\2")))
  (setf calc-input
        (map-to-half-width-string calc-input :ascii t :hiragana nil :katakana nil))
  (let (result-dsc
        (result (handler-case
                    (let ((*read-default-float-format* 'double-float))
                      (ed::calc-string calc-input))
                  (error (c)
                    (progn (message (si:*condition-string c)) nil))))
        )
    (if result
        (setf result-dsc
              (cond ((and (integerp result)
                          thousand-separate-mode)
                     (format nil "~:D" result))
                    ((si:*ratiop result)
                     (let ((*read-default-float-format* 'double-float))
                       (format nil "~A" (float result 1d0))))
                    (t
                     (let ((*read-default-float-format* 'double-float))
                       (format nil "~A" result))))))
    result-dsc
    ;(calc-onthespot-force-separate result-dsc)
    )
  )

;;小数込みでも3桁で区切りたい方用コード
(defun calc-onthespot-force-separate (result-dsc)
  (let (loc)
    (when (and result-dsc
               (setf loc (string-match "\\." result-dsc)))
      (let ((pint (substring result-dsc 0 loc))
            (pdec (substring result-dsc loc)))
        (concat (format nil "~:D" (parse-integer pint :junk-allowed t)) pdec)))))

(defun calc-onthespot-previous-word ()
  (interactive "*p")
  (let (aa
        wk
        (posnow (point))
        (posbol (progn (goto-bol) (point)))
        )
    (goto-char posnow)
    (setf aa (buffer-substring posbol posnow))
    (setf aa (calc-onthespot-ch-empty aa))
    (string-match "\\([^ ]+\\)$" aa)
    (setf wk (match-string 1))
    (princ (concat "[calc]:" wk "\n"))
    (if wk
        (substitute-string wk (regexp-quote "_#_") " ")
      nil)
    ))

(defun calc-onthespot-ch-empty (input)
  (let ((start 0))
    (while (setf start (string-match "[\(（][^\)]+[\)）]" input start))
      (let* ((matched (match-string 0))
             (de-empty (substitute-string matched " " "_#_")))
        (setf start (+ start (length de-empty)))
        (when (string-match " " matched)
          (setf input (substitute-string input (regexp-quote matched) de-empty))))
      )
    (setf start (max (calc-onthespot-search-last-char input #\$)
                     (calc-onthespot-search-last-char input #\＄)))
    (if (>= start 0)
        (let* ((matched (substring input start))
               (de-empty (substitute-string matched " " "_#_")))
          (setf input de-empty)))
    (setf start (max (calc-onthespot-search-last-char input #\@)
                     (calc-onthespot-search-last-char input #\＠)))
    (if (>= start 0)
        (let* ((matched (substring input start))
               (de-empty (substitute-string matched " " "_#_")))
          (setf input de-empty)))
    input))

(defun calc-onthespot-search-last-char (str c)
  (if str
      (let (loc
            (len (length str)))
        (dotimes (i len)
          (setf loc (- (- len i) 1))
          (if (equal c (char str loc))
              (return-from calc-onthespot-search-last-char loc)))))
  -1)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;漢数字パッケージ
;; (calc-onthespot-kansuji  "千百八十三万百廿一")
;;→ 11830121
;; (calc-onthespot-kansuji-exchange "４／０．８万＊三百八十七")
;;→ "4/8000.0*387"
;; (calc-onthespot-kansuji-exchange "国会法第壱百弐拾壱条の二第一項の規定")
;;→ "国会法第121条の2第1項の規定"   ←文中の任意の漢数字を算用数字に変換します。
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar *calc-onthespot-numeration-class* nil)
(defvar *calc-onthespot-numeration-class-none* nil)
(defvar *calc-onthespot-numeration-regex-any* nil)
(let* ((num-names "十百千万億兆京垓杼穣溝澗正載極")
       (num-names2 "\\(?:恒河沙\\|阿僧祇\\|那由他\\|不可思議\\|無量大数\\)")
       (num-names0 "十百千")
       (cls-nms (concat "\\(?:[" num-names "]\\|" num-names2 "\\)"))
       (cls-nms0 (concat "[" num-names0 "]"))
       (cls-full (concat "\\(?:[0-9.," num-names "]\\|" num-names2 "\\)"))
       (cls-dn (concat "\\(?:[0-9" num-names "]\\|" num-names2 "\\)"))
       (cls-digit0 "[0-9]")
       (cls-digit1 "[0-9.]")
       (cls-digit2 "[0-9.,]")
       )
  (setq *calc-onthespot-numeration-class* cls-nms)
  (setq *calc-onthespot-numeration-regex-any* (concat
                                               (concat cls-nms0 cls-full "*" cls-dn) "\\|"
                                               (concat cls-digit1 cls-digit2 "*" cls-nms cls-full "*" cls-digit0) "\\|"
                                               (concat cls-digit1 cls-full "*" cls-nms) "\\|"
                                               (concat cls-nms0)))
;;   [百0][0-9.,百]*[0-9百]
;;   [0-9.][0-9.,]*[百][0-9.,百]*[0-9]
;;   [0-9.][0-9.,百]*[百]
;;   [百0]
  )

(defvar *calc-onthespot-kansuji-alist* nil)
(setq *calc-onthespot-kansuji-alist*
      (list (list "十" . (1 10))
            (list "百" . (1 100))
            (list "千" . (1 1000))
            (list "万" . (2 10000))
            (list "億" . (2 (expt 10 8)))
            (list "兆" . (2 (expt 10 12)))
            (list "京" . (2 (expt 10 16)))
            (list "垓" . (2 (expt 10 20)))
            (list "杼" . (2 (expt 10 24)))
            (list "穣" . (2 (expt 10 28)))
            (list "溝" . (2 (expt 10 32)))
            (list "澗" . (2 (expt 10 36)))
            (list "正" . (2 (expt 10 40)))
            (list "載" . (2 (expt 10 44)))
            (list "極" . (2 (expt 10 48)))
            (list "恒河沙" . (2 (expt 10 52)))
            (list "阿僧祇" . (2 (expt 10 56)))
            (list "那由他" . (2 (expt 10 60)))
            (list "不可思議" . (2 (expt 10 64)))
            (list "無量大数" . (2 (expt 10 68)))
            ))

(defun calc-onthespot-cnv-kanjinum (str)
  (let ((lst-cnv
         (list '("〇"  "0")
               '("一" "1")
               '("二" "2")
               '("三" "3")
               '("四" "4")
               '("五" "5")
               '("六" "6")
               '("七" "7")
               '("八" "8")
               '("九" "9")
               '("壱" "1")
               '("弐" "2")
               '("参" "3")
               '("伍" "5")
               '("拾" "十")
               '("廿" "2十")
               '("萬" "万")
               )))
    (dolist (rule lst-cnv)
      (setf str (substitute-string str (car rule) (cadr rule))))
    str
    ))

;;(calc-onthespot-kansuji-token "千百八十三万百十一")
;;→("1" "千" "1" "百" "8" "十" "3" "万" "1" "百" "1" "十" "1")
(defun calc-onthespot-kansuji-token (str)
  (let* (loc
         (n-cls *calc-onthespot-numeration-class*)
         (lst-tokens '())
         (regex0 (concat "\\(" n-cls "\\)\\([十百千]\\)"))
         (regex (concat "[0-9.,]+\\|" n-cls)))
    (setf str (calc-onthespot-cnv-kanjinum str))
    (setf str (map-to-half-width-string str :ascii t))
    (if (not (calc-onthespot-kansuji-check-syntax str))
        (error "Syntax error: ~c" str))
    (if (string-match "^[十百千]" str) (setf str (concat "1" str)))
    (setf loc -1)
    (while (setf loc (string-match regex0 str (+ loc 1)))
      (let ((matched (match-string 2)))
        (setf str (substitute-string str matched (concat "1" matched) :start (+ loc 1) :end (+ 1 (+ loc (length matched)))))))
    (setf loc 0)
    (let ((matched nil))
      (while (setf loc (string-match regex str (+ loc (length matched))))
        (setf matched (match-string 0))
        (push matched lst-tokens)))
    (reverse lst-tokens)
    ))

(defun calc-onthespot-kansuji-check-syntax (str)
  (string-match (concat  "[0-9.,]+\\|" *calc-onthespot-numeration-regex-any*) str)
  (equal (match-string 0) str)
  )

;;漢数字→数値
(defun calc-onthespot-kansuji (str)
  (let ((lst-token (calc-onthespot-kansuji-token str))
        (*read-default-float-format* 'double-float)
        (ans 0)
        (wk-unit 0)
        (wk-pre 0)
        )
    (if lst-token
        (progn
          (dolist (token lst-token)
            (let ((rule (cdr (assoc token *calc-onthespot-kansuji-alist* :test #'equal))))
              (cond ((and rule (= 1 (car rule)))
                     (setf wk-unit (+ wk-unit (* wk-pre (cadr rule))))
                     (setf wk-pre 0))
                    ((and rule (= 2 (car rule)))
                     (setf wk-unit (+ wk-unit wk-pre))
                     (setf ans (+ ans (* wk-unit (cadr rule))))
                     (setf wk-unit 0)
                     (setf wk-pre 0))
                    ((and (not rule)
                          (string-match "^[0-9\\.,]+$" token))
                     (setf token (substitute-string token "," ""))
                     (setf wk-pre (read-from-string token)))
                    (t
                     (error "Syntax error: ~c" token)))))
          (setf ans (+ ans (+ wk-unit wk-pre)))
          ))
    ans))

;;文字列中の漢数字を全て変換
(defun calc-onthespot-kansuji-exchange (calc-input)
  (let ((str (map-to-half-width-string (calc-onthespot-cnv-kanjinum calc-input) :ascii t)))
    (if (string-match *calc-onthespot-numeration-class* str)
        (let (kansuji-num
              kansuji-dsc
              (*read-default-float-format* 'double-float)
              (matched nil)
              (regex *calc-onthespot-numeration-regex-any*))
          (while (string-match regex str)
            (setf matched (match-string 0))
            (setf kansuji-num (calc-onthespot-kansuji matched))
            (setf kansuji-dsc (format nil "~A" kansuji-num))
            (setf str (substitute-string str (regexp-quote matched) kansuji-dsc)))
          ))
    str)
  )

;;calc-mode用漢数字フィルタ関数
(defvar *calc-eval-line-with-thousands-separator* nil)
(defun calc-onthespot-eval-line ()
  (interactive)
  (let* ((loc (progn (goto-eol) (point)))
         (input
          (buffer-substring (progn (goto-bol) (looking-at "^ *\\$") (match-end 0))
                            loc))
         (cand-input (calc-onthespot-kansuji-exchange input)))
    (when cand-input
      (if *calc-eval-line-with-thousands-separator*
          (setf cand-input (substitute-string cand-input "\\([0-9]\\)\,\\([0-9]\\)" "\\1\\2")))
      (goto-eol)
      (backward-delete-char-untabify (length input))
      (insert cand-input))
    ;;calc-ext.l ユーザ対応
    (if (fboundp (find-symbol "calc-eval-line-add-history"))
        (calc-eval-line-add-history)
      (ed::calc-eval-line))
    ))

;;selection用 漢数字→算用数字 メソッド
(defun calc-onthespot-kansuji-exchange-selection ()
  (interactive)
  (require "calc-onthespot")  
  (let ((cand-selection (if (not (= 2 (or (get-selection-type) 0))) nil
                          (buffer-substring
                                                (min (selection-mark) (selection-point))
                                                (max (selection-mark) (selection-point))))))
    (when cand-selection
      (let ((exc (calc-onthespot-kansuji-exchange cand-selection))
            (loc (max (selection-mark) (selection-point))))
        (if exc
            (progn
              (goto-char loc)
              (backward-delete-char-untabify (length cand-selection))
              (insert exc)))))))

;;任意の数字表現→漢数字
;; 使い方例: (calc-onthespot-tokansuji "310013154935202302" 2)
;; str "310013154935202302"
;; mode
;;    2 : "３１京１３兆１５４９億３５２０万２３０２"
;;    4 : "三十一京十三兆千五百四十九億三千五百二十万二千三百二"
;;    5 : "参拾壱京壱拾参兆壱千伍百四拾九億参千伍百弐拾万弐千参百弐"
;;    6 : "三一京一三兆一五四九億三五二〇万二三〇二"
;;
;; 他の例:
;;   (calc-onthespot-tokansuji "４億３２" 4)
;;    →"四億三十二"
;;   (calc-onthespot-tokansuji "１２２１百万" 2)
;;   →"１２億２１００万"
;;
(defun calc-onthespot-tokansuji (str mode)
  (let ((val (calc-onthespot-kansuji str)))
    (calc-onthespot-tokansuji-main val mode)
    ))

(defun calc-onthespot-tokansuji-main (val mode)
  (let ((ans "")
        (dic nil)
        wk)
    (dolist (rule *calc-onthespot-kansuji-alist*)
      (if (= 2 (cadr rule))
          (push rule dic)))
    (dolist (rule dic)
      (let ((base-num (caddr rule))
            (numeral-dsc (car rule)))
        (if (<= 1 (setf wk (/ (abs val) base-num)))
            (progn
              (setf ans (concat ans (calc-onthespot-tokansuji-thousand (truncate wk) mode) numeral-dsc))
              (setf val (mod val base-num))))
        )
      )
    (if (< 0 val)
        (setf ans (concat ans (calc-onthespot-tokansuji-thousand (truncate val) mode))))
    ans))

(defvar *calc-onthespot-tokansuji-mst* nil)
(setq *calc-onthespot-tokansuji-mst*
      '(("〇" "一" "二"  "三"  "四"  "五"  "六"  "七"  "八"  "九")
        ("〇" "壱" "弐"  "参"  "四"  "伍"  "六"  "七"  "八"  "九")))

;;４桁未満の正の整数の漢数字表記
;;val 3410
;;mode
;; 0:  3410
;; 1:  3,410
;; 2:  ３４１０
;; 3:  ３，４１０
;; 4:  三千四百十
;; 5:  参千四百壱拾
;; 6:  三四一〇
(defun calc-onthespot-tokansuji-thousand (val mode)
  (let ((ans "")
        (dic nil)
        (dic-mode 0)
        (keta (truncate (log val 10)))
        wk)
    (cond ((= mode 0)
           (setf ans (format nil "~A" (truncate val))))
          ((= mode 1)
           (setf ans (format nil "~:D" (truncate val))))
          ((= mode 2)
           (setf ans (map-to-full-width-string (format nil "~A" (truncate val)) :ascii t)))
          ((= mode 3)
           (setf ans (map-to-full-width-string (format nil "~:D" (truncate val)) :ascii t)))
          ((or (= mode 4) (= mode 5))
           (if (= mode 5) (setf dic-mode 1))
           (dolist (rule *calc-onthespot-kansuji-alist*)
             (if (= 1 (cadr rule))
                 (push rule dic)))
           (dolist (rule dic)
             (let ((base-num (caddr rule))
                   (numeral-dsc (car rule)))
               (if (<= 1 (setf wk (/ (abs val) base-num)))
                   (progn
                     (if (and (= dic-mode 1) (= base-num 10)) (setf numeral-dsc "拾"))
                     (if (and (= dic-mode 0) (>= base-num 10) (= 1 (truncate wk)))
                         (setf ans (concat ans numeral-dsc))
                       (setf ans (concat ans (nth (truncate wk) (nth dic-mode *calc-onthespot-tokansuji-mst*)) numeral-dsc)))
                     (setf val (mod val base-num))))
               )
             )
           (if (< 0 val)
               (setf ans (concat ans (nth (truncate val) (nth dic-mode *calc-onthespot-tokansuji-mst*)))))
           )
          ((= mode 6)
           (dotimes (i keta)
             (let ((base-num (expt 10 (- keta i))))
               (setf wk (/ (abs val) base-num))
               (setf ans (concat ans (nth (truncate wk) (nth 0 *calc-onthespot-tokansuji-mst*))))
               (setf val (mod val base-num))))
           (setf ans (concat ans (nth (truncate val) (nth 0 *calc-onthespot-tokansuji-mst*)))))
          )
    ans))