;;; euro.el

;; (c) Peter Kleiweg 1999, 2000
;; http://www.let.rug.nl/~kleiweg/

;; Land       	  Valutacode Eurokoersen
;;    
;; Nederland  	  NLG        1 euro = 2,20371 Nederlandse gulden
;; Oostenrijk 	  ATS        1 euro = 13,7603 Oostenrijkse schilling
;; België     	  BEF        1 euro = 40,3399 Belgische frank
;; Duitsland  	  DEM        1 euro = 1,95583 Duitse mark
;; Spanje     	  ESP        1 euro = 166,386 Spaanse peseta
;; Finland    	  FIM        1 euro = 5,94573 Finse markka
;; Frankrijk  	  FRF        1 euro = 6,55957 Franse frank
;; Griekenland    GRD        1 euro = 340,750 Griekse drachme
;; Ierland    	  IEP        1 euro = 0,787564 Ierse pond
;; Italië     	  ITL        1 euro = 1936,27 Italiaanse lire
;; Luxemburg  	  LUF        1 euro = 40,3399 Luxemburgse frank
;; Portugal   	  PTE        1 euro = 200,482 Portugese escudo

(defvar euro-currency-info t
  "If not nil, show name of currency")

(defvar euro-language 0
  "What language to use

0: English
1: Dutch")

(defvar euro-decimal "."
  "Decimal separator used when storing value into yank buffer")

(defvar euro-format-string "%.2f"
  "String specifying how to format a value before storing it into yank buffer")

;;; END OF USER OPTIONS

(defconst euro-values
  '((ATS . (13.7603  "Austrian shilling" "Oostenrijkse schilling"))
    (BEF . (40.3399  "Belgian franc"     "Belgische frank"))
    (DEM . (1.95583  "German mark"       "Duitse mark"))
    (ESP . (166.386  "Spanish peseta"    "Spaanse peseta"))
    (FIM . (5.94573  "Finnish markka"    "Finse mark"))
    (FRF . (6.55957  "French franc"      "Franse franc"))
    (GRD . (340.750  "Greek drachmae"    "Griekse drachme"))
    (IEP . (0.787564 "Irish pound"       "Ierse pond"))
    (ITL . (1936.27  "Italian lira"      "Italiaanse lire"))
    (LUF . (40.3399  "Luxembourg franc"  "Luxemburgse frank"))
    (NLG . (2.20371  "Dutch guilder"     "Nederlandse gulden"))
    (PTE . (200.482  "Portuguese escudo" "Portugese escudo"))))

(defun euro--scan-value ()
  (let ((regex "-?[0-9]+\\([.,][0-9]+\\)?\\|-?[.,][0-9]+")
	p
	i
	s
	f)
    (save-excursion
      (if (looking-at regex)
	  (goto-char (match-end 0)))
      (re-search-backward regex)
      (setq p (match-end 0))
      (while (and (> (point) (point-min)) (looking-at regex))
	(backward-char))
      (re-search-forward regex)
      (while (/= p (match-end 0))
	(goto-char (1+ (match-beginning 0)))
	(re-search-forward regex))
      (setq s (match-string 0)))
    (if (setq i (string-match "," s))
	(setq s (concat (substring s 0 i) "." (substring s (1+ i)))))
    (setq f (string-to-number s))
    ;; for some reason, my version of Emacs can't handle negative numbers with decimals
    (if (and (string= "-" (substring s 0 1)) (> f 0))
	(setq f (- f)))
    f))

(defun euro--format (f)
  (let ((s (format euro-format-string f))
	i)
    (if (and (not (string= "." euro-decimal))
	     (setq i (string-match "\\." s)))
	(setq s (concat
		 (substring s 0 i)
		 euro-decimal
		 (substring s (1+ i)))))
    s))

(defun euro--name (item)
  (if (= 0 euro-language)
    (car (cdr (cdr item)))
    (car (cdr (cdr (cdr item))))))

(defun euro--info (currency)
  (if euro-currency-info
      (concat "(" (euro--name (assoc currency euro-values)) ")  ")
    ""))

(defun euro--to-currency (currency euro)
  (* euro (car (cdr (assoc currency euro-values)))))

(defun euro--from-currency (currency value)
  (/ value (car (cdr (assoc currency euro-values)))))

(defun euro--from (currency)
  (let (e
	f)
    (setq f (euro--scan-value))
    (setq e (euro--from-currency currency f))
    (kill-new (euro--format e))
    (message
     (concat
      (euro--info currency)
      (symbol-name currency)
      " "
      (number-to-string f)
      " = EUR "
      (number-to-string e)))))

(defun euro--to (currency)
  (let (e
	f)
    (setq e (euro--scan-value))
    (setq f (euro--to-currency currency e))
    (kill-new (euro--format f))
    (message
     (concat
      "EUR "
      (number-to-string e)
      " = "
      (symbol-name currency)
      " "
      (number-to-string f)
      "  "
      (euro--info currency)))))

;;;###autoload
(defun euro-from-nlg ()
  "Convert NLG value at/before point to Euro, store in yank buffer"
  (interactive)
  (euro--from 'NLG))

;;;###autoload
(defun euro-to-nlg ()
  "Convert Euro value at/before point to NLG, store in yank buffer"
  (interactive)
  (euro--to 'NLG))

;;;###autoload
(defun euro-from-bef ()
  "Convert BEF value at/before point to Euro, store in yank buffer"
  (interactive)
  (euro--from 'BEF))

;;;###autoload
(defun euro-to-bef ()
  "Convert Euro value at/before point to BEF, store in yank buffer"
  (interactive)
  (euro--to 'BEF))

;;;###autoload
(defun euro-from-dem ()
  "Convert DEM value at/before point to Euro, store in yank buffer"
  (interactive)
  (euro--from 'DEM))

;;;###autoload
(defun euro-to-dem ()
  "Convert Euro value at/before point to DEM, store in yank buffer"
  (interactive)
  (euro--to 'DEM))

;;;###autoload
(defun euro-from-fim ()
  "Convert FIM value at/before point to Euro, store in yank buffer"
  (interactive)
  (euro--from 'FIM))

;;;###autoload
(defun euro-to-fim ()
  "Convert Euro value at/before point to FIM, store in yank buffer"
  (interactive)
  (euro--to 'FIM))

;;;###autoload
(defun euro-from-frf ()
  "Convert FRF value at/before point to Euro, store in yank buffer"
  (interactive)
  (euro--from 'FRF))

;;;###autoload
(defun euro-to-frf ()
  "Convert Euro value at/before point to FRF, store in yank buffer"
  (interactive)
  (euro--to 'FRF))

;;;###autoload
(defun euro-from-grd ()
  "Convert GRD value at/before point to Euro, store in yank buffer"
  (interactive)
  (euro--from 'GRD))

;;;###autoload
(defun euro-to-grd ()
  "Convert Euro value at/before point to GRD, store in yank buffer"
  (interactive)
  (euro--to 'GRD))

;;;###autoload
(defun euro-from-iep ()
  "Convert IEP value at/before point to Euro, store in yank buffer"
  (interactive)
  (euro--from 'IEP))

;;;###autoload
(defun euro-to-iep ()
  "Convert Euro value at/before point to IEP, store in yank buffer"
  (interactive)
  (euro--to 'IEP))

;;;###autoload
(defun euro-from-itl ()
  "Convert ITL value at/before point to Euro, store in yank buffer"
  (interactive)
  (euro--from 'ITL))

;;;###autoload
(defun euro-to-itl ()
  "Convert Euro value at/before point to ITL, store in yank buffer"
  (interactive)
  (euro--to 'ITL))

;;;###autoload
(defun euro-from-luf ()
  "Convert LUF value at/before point to Euro, store in yank buffer"
  (interactive)
  (euro--from 'LUF))

;;;###autoload
(defun euro-to-luf ()
  "Convert Euro value at/before point to LUF, store in yank buffer"
  (interactive)
  (euro--to 'LUF))

;;;###autoload
(defun euro-from-ats ()
  "Convert ATS value at/before point to Euro, store in yank buffer"
  (interactive)
  (euro--from 'ATS))

;;;###autoload
(defun euro-to-ats ()
  "Convert Euro value at/before point to ATS, store in yank buffer"
  (interactive)
  (euro--to 'ATS))

;;;###autoload
(defun euro-from-pte ()
  "Convert PTE value at/before point to Euro, store in yank buffer"
  (interactive)
  (euro--from 'PTE))

;;;###autoload
(defun euro-to-pte ()
  "Convert Euro value at/before point to PTE, store in yank buffer"
  (interactive)
  (euro--to 'PTE))

;;;###autoload
(defun euro-from-esp ()
  "Convert ESP value at/before point to Euro, store in yank buffer"
  (interactive)
  (euro--from 'ESP))

;;;###autoload
(defun euro-to-esp ()
  "Convert Euro value at/before point to ESP, store in yank buffer"
  (interactive)
  (euro--to 'ESP))

;;;###autoload
(defun euro-info ()
  "Display Euro values"
  (interactive)
  (let ((i euro-values)
	(oldwindow (selected-window)))
    (set-buffer (get-buffer-create "*Euro*"))
    (setq buffer-read-only nil)
    (erase-buffer)
    (while i
      (insert
       (symbol-name (car (car i)))
       " 1 = EUR "
       (format "%.9f" (/ 1 (car (cdr (car i)))))
       "  |  EUR 1 = "
       (symbol-name (car (car i)))
       " "
       (format "%11.6f" (car (cdr (car i))))
       "  ("
       (euro--name (car i))
       ")"
       (if (cdr i) "\n" ""))
      (setq i (cdr i)))
    (beginning-of-buffer)
    (end-of-line)
    (set-buffer-modified-p nil)
    (setq buffer-read-only t)
    (select-window (display-buffer "*Euro*"))
    (shrink-window (- (window-height) (length euro-values) 1))
    (select-window oldwindow)))