;;; electric-french-tex.el
;;; Minor mode supporting French typographical conventions in latex

;;; Author: Marc Shapiro <shapiro@sor.inria.fr> 5-dec-94

;;; add this to your .emacs: 
;;; (autoload 'electric-french-tex "electric-french-tex" nil t nil)
;;; (add-hook 'LaTeX-mode-hook
;;; 	  '(lambda ()
;;; 	       (define-key LaTeX-mode-map "\C-c\C-v" 'electric-french-tex)
;;;	       ))
;;;
;;; Call this minor mode *after* all other per-mode or per-buffer changes!

(provide 'electric-french-tex)

(defvar electric-french-tex nil
  "t if electric-french-tex minor mode is on")
(make-variable-buffer-local 'electric-french-tex)

(or (assq 'electric-french-tex minor-mode-alist)
    (setq minor-mode-alist (cons '(electric-french-tex " EFTX")
                                 minor-mode-alist)))

(defvar electric-french-tex-previous-keymap nil
  "Keymap of buffer prior to applying electric-french-tex")
(make-variable-buffer-local 'electric-french-tex-previous-keymap)

(defun eft-apply-previous-keymap (arg)
  "Apply character to electric-french-tex-previous-keymap"
  (let* ((input (char-to-string last-input-char))
	 (func (lookup-key electric-french-tex-previous-keymap input t)))
    (while (keymapp func)
      (setq func (lookup-key func input t)))
    (or func
	(setq func (lookup-key global-map input t)))
    (while (keymapp func)
      (setq func (lookup-key func input t)))
    (cond
     ((null func) (ding))
     ((commandp func) (call-interactively func))
     ((symbolp func) (call-interactively func))
     (t (error "electric-french-tex can't deal with binding!")))))

(defun electric-french-tex (arg)
  "Minor mode for TeX/LaTeX for French typographical conventions and to
take into account TeX pecularities.  Accepts `oei' and `oeu' as shorthand
for `{\oe}i and `{\oe}u'.  Inserts spaces before punctuation.

With arg turn on electric-french-tex, with zero or negative arg turn off."
  (interactive "P")
  (if arg
      (setq electric-french-tex (or (listp arg) ;; C-u alone
				    (> (prefix-numeric-value arg) 0)))
    (setq electric-french-tex (not electric-french-tex)))
  
  (if electric-french-tex
      (let ((cmm (cons 'keymap (current-local-map)))) ;; inherit
	(setq electric-french-tex-previous-keymap (current-local-map))
	(use-local-map cmm)
	(define-key cmm "\"" 'eft-double-quote)
	(define-key cmm "i" 'eft-ui)
	(define-key cmm "u" 'eft-ui)
	(define-key cmm "!" 'eft-self-insert-with-space)
	(define-key cmm "?" 'eft-self-insert-with-space)
	(define-key cmm ":" 'eft-self-insert-with-space)
	(define-key cmm ";" 'eft-self-insert-with-space))
    (use-local-map electric-french-tex-previous-keymap)
    ))

(defun eft-ui (count)
  "Check letters `u' and `i' for preceding `oe'"
  (interactive "p")
  (cond ((and (string-match "[uiUI]" (char-to-string  last-input-char))
	      (>= (- (point) (point-min)) 2))
	 (forward-char -2)
	 (cond ((looking-at "oe")
		(delete-char 2)
		(insert "{\\oe}"))
	       ((or (looking-at "OE") (looking-at "Oe"))
		(delete-char 2)
		(insert "{\\OE}"))
	       (t
		(forward-char 2))))
	)
  (eft-apply-previous-keymap count))

(defun eft-self-insert-with-space (count)
  "Self-insert, delete whitespace, and insert unbreakable space if necessary"
  (interactive "p")
  (let ((pos (point)))
    (eft-apply-previous-keymap count)
    (save-excursion
      (cond ((and (string-match "[!?;:]" (char-to-string  last-input-char))
		  (>= (- (point) (point-min)) 1))
	     (goto-char pos)
	     (delete-horizontal-space)
	     (if (string-match "\\w\\|[)}]"
			       (char-to-string (preceding-char)))
		 (insert "\\,")))
	    (t t)))))

(defconst left-guillemet
  (cond ((eq system-type 'berkeley-unix)
	 "«")
	((eq system-type 'Apple-Macintosh)
	 "Ç")
	(t "\guillouv{}"))
  "Left guillemet, according to current encoding")
(defconst right-guillemet
  (cond ((eq system-type 'berkeley-unix)
	 "»")
	((eq system-type 'Apple-Macintosh)
	 "È")
	(t "\guillfer{}"))
  "Right guillemet, according to current encoding")

(defun eft-double-quote (arg)
  "Insert left guillement, right guillemet, or \" according to preceding
character.  With prefix argument, always insert \" characters."
  (interactive "P")
  (if arg
      (let ((count (prefix-numeric-value arg)))
	(if (listp arg)
	    (eft-apply-previous-keymap 1)	;C-u always inserts just one
	  (eft-apply-previous-keymap arg)))
    (insert
     (cond
      ((or (bobp)
	   (save-excursion
	     (forward-char -1)
	     (looking-at "[ \t\n]\\|\\s(")))
       left-guillemet)
      ((= (preceding-char) ?\\)
       ?\")
      (t right-guillemet)))))