;;; accent-win.el --- To tape the french accents using  "Ctrl-Accent letter"

;; Copyright (C) 1998, 2001 Stéphane Levant <sun@tuxfamily.org>

;; Author: Stéphane Levant <sun@tuxfamily.org>
;; Created: Apr 1998
;; Keywords: i18n
;; Version: 1.1
;; URL: http://arsunik.free.fr/emacs

;; This file 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.

;; This file 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 GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Allows to tape accents using "Ctrl-Accent letter"
;; For example :    C-' e  =>  é

;; Code is very bad and this mode replace the iso-accent-mode and allow
;; only the french accents...

;; INSTALL: put this line in your .emacs:
;; (load "accent-win")

;; This mode will be always active everywhere and can't be turned off.
;; You'd never want to do that because it use only the Ctrl-accent keys.

;;; Code:

(provide 'iso-acc)

(defvar iso-language nil)

(defvar iso-accents-list nil
  "Association list for ISO accent combinations, for the chosen language.")

(defvar iso-accents-mode t)

(defvar iso-accents-enable '(?\C-' ?\C-` ?\C-^ ?\C-\" ?\C-~ ?\C-,))

(defvar iso-languages
  '(("french"
     (?\C-^ (?A . ?\302) (?E . ?\312) (?I . ?\316) (?O . ?\324) (?U . ?\333)
	    (?a . ?\342) (?e . ?\352) (?i . ?\356) (?o . ?\364) (?u . ?\373))
     (?\C-` (?A . ?\300) (?E . ?\310) (?U . ?\331)
	    (?a . ?\340) (?e . ?\350) (?u . ?\371))
     (?\C-\~ (?< . ?\253) (?> . ?\273) (?C . ?\307)
	     (?c . ?\347))
     (?\C-' (?E . ?\311) (?C . ?\307) (?e . ?\351) (?c . ?\347))
     (?\C-\" (?E . ?\313) (?I . ?\317) (?e . ?\353) (?i . ?\357))
     (?\C-, (?C . ?\307) (?c . ?\347) (?\/ . ?\260)
	     (?> . ?\273) (?< . ?\253)))))

(defun iso-accents-mode nil)

(defun iso-accents-accent-key (prompt)
  (if (and iso-accents-mode
	   (memq last-input-char iso-accents-enable))
      (iso-accents-compose prompt)
    (char-to-string last-input-char)))

(defun iso-accents-compose (prompt)
  (let* ((first-char last-input-char)
	 (list (assq first-char iso-accents-list))
	 (second-char (if (or prompt
			      (not (eq (key-binding "a")
				       'self-insert-command))
			      (> (length (this-single-command-keys)) 1)
			      this-command)
			  (progn
			    (message "%s%c"
				     (or prompt "Compose with ")
				     first-char)
			    (read-event))
			(read-event)))
	 (entry (cdr (assq second-char list))))
    (if entry
	(vector entry)
      (vector first-char))))


(defun iso-acc-minibuf-setup ()
  (setq iso-accents-mode
	(save-excursion
	  (set-buffer (window-buffer minibuffer-scroll-window))
	  iso-accents-mode)))

(defun iso-accents-customize (language)
  (interactive (list (completing-read "Language: " iso-languages nil t)))
  (let ((table (assoc language iso-languages))
	all-accents tail)
    (if (not table)
	(error "Unknown language '%s'" language)
      (setq iso-language language
	    iso-accents-list (cdr table))
      (if key-translation-map
	  (substitute-key-definition
	   'iso-accents-accent-key nil key-translation-map)
	(setq key-translation-map (make-sparse-keymap)))
      (setq tail iso-accents-list)
      (while tail
	(define-key key-translation-map (vector (car (car tail)))
	  'iso-accents-accent-key)
	(setq tail (cdr tail))))))

(iso-accents-customize "french")

(add-hook 'minibuf-setup-hook 'iso-acc-minibuf-setup)

;;; accent-win.el ends here