;;; lettre.el - Special code for lettre style.

;;; Code:
(defvar LaTeX-lettre-class-options
  '("10pt" "11pt" "12pt"
    "a4paper" "letterpaper" "legalpaper" "executivepaper" "b5paper" "a5paper"
     "oneside" "twoside"
    "origdate"
    "draft" "final" "noinfo" "nologhighlight" "loghighlight" "strict"
    "onecolumn" "twocolumn" "leqno" "fleqn"
    "french" "english" "USenglish" "german"
    "francais" "romand" "allemand" "americain" "anglais"
    )
  "Package options for the article class.")

(defvar LaTeX-lettre-default-toaddress "")
(defvar LaTeX-lettre-default-tofax "")


(defcustom LaTeX-lettre-contact-source nil
  "Source des contacts pour saisir le destinataire."
  :group 'LaTeX-style
  :type '(choice (const :tag "Saisie manuelle" nil) (const :tag "BBDB" t)))

  
(defun LaTeX-env-lettre-letter (env)
  (let ((toaddress
	 (if LaTeX-lettre-contact-source
	     (progn
	       (require 'bbdb)
	       (let* ((regexp (read-string "Rechercher les contacts s'accordant à l'expression rationnelle: "))
		      (records (bbdb-search (bbdb-records) regexp)))
		 (if records
		     (progn
		       ;; Selection enregistrement
		       (setq records (car records))
		       (concat 
			(aref records 0); prénom
			" "
			(aref records 1);; nom
			(let ((address (car-safe (aref records 6))))
			  (if (vectorp address)
			      (let ((street-line (aref address 1))
				    (city (aref address 2))
				    (state (aref address 3))
				    (zip (aref address 4))
				    (country (aref address 5)))
			      (concat
			       "\\\\\n"
			       (mapconcat 'identity street-line "\\\\\n")
			       (if street-line "\\\\\n" "")
			       zip " " city))
			    ""))
		       ))
		     (message "Aucun contact s'accordant à %s" regexp)
		     )))
	   (read-string "Adresse destinataire: " LaTeX-lettre-default-toaddress))))
    (setq LaTeX-lettre-default-toaddress toaddress)
    (LaTeX-insert-environment env
			      (concat TeX-grop toaddress TeX-grcl))))


(defun LaTeX-env-lettre-fax (env)
  (let ((tofax  (read-string "N° fax destinataire: " LaTeX-lettre-default-tofax))
	(toaddress (read-string "Adresse destinataire: " LaTeX-lettre-default-toaddress)))
    (setq LaTeX-lettre-default-toaddress toaddress)
    (setq LaTeX-lettre-default-tofax tofax)
    (LaTeX-insert-environment env
			        (concat TeX-grop tofax TeX-grcl  TeX-grop toaddress TeX-grcl)
			      )))

(defcustom LaTeX-lettre-instituts nil
  "Liste de vos instituts."
  :group 'LaTeX-style
  :type '(repeat (string :tag "Institut")))

(defvar LaTeX-lettre-instituts-hist nil
  "Historique des instituts utilisés.")

(defcustom LaTeX-lettre-openings
  '("Monsieur," "Madame," "Madame, Monsieur,")
  "Liste de vos apostrophes préférées."
  :group 'LaTeX-style
  :type '(repeat (string :tag "Apostrophe")))
  
(defvar LaTeX-lettre-openings-hist nil
  "Historique des apostrophes utilisées.")

(defcustom LaTeX-lettre-closings
  '("Je vous prie, %s de recevoir mes salutations les meilleures."
    "Je vous prie, %s de recevoir mes salutations distinguées."
    "Je vous prie, %s d'agréer l'expression de mes sentiments les meilleurs."
    )
  "Liste de vos salutations préférées. Un `%s' est remplacé par la première apostrophe précédente."
  :group 'LaTeX-style
  :type '(repeat (string :tag "Salutation")))
  
(defvar LaTeX-lettre-closings-hist nil
  "Historique des apostrophes utilisées.")

(defconst LaTeX-lettre-languages
  '("french" "romand" "english" "USenglish" "german" )
  "Liste des langues prises en charges.")
  
(defvar LaTeX-lettre-languages-hist nil
  "Historique des langues utilisées.")



(defun LaTeX-lettre-closing-arg ()
  (let ((opening
	 (save-excursion
	   (if (re-search-backward "\\opening{\\([^}]+\\)}" nil t)
	       (match-string 1)
	     ""))))
    (completing-read  "Salutation: "
		      (mapcar (lambda (x) (format x opening)) LaTeX-lettre-closings)
		      nil nil nil 'LaTeX-lettre-closings-hist)))

(TeX-add-style-hook
 "lettre"
 (lambda ()
   (setq LaTeX-default-document-environment "letter")
   (LaTeX-add-counters "labelstart")
   (let ((new-symbols '(
    ("Nref" "Référence expéditeur")
    ("Vref" "Référence destinataire")
    ("addpages" "Nombre de pages supplémentaires")
    ("address" 1)
    ("bitnet" 1)
    ("cc" 1)
    ("ccitt" 1)
    ("ccp" 1)
    ("closing" (TeX-arg-eval LaTeX-lettre-closing-arg))
    ("conc" "Objet")
    ("date" 1)
    ("decnet" 1)
    ("email" 1)
    ("marge" "Marge (longueur)")
    ("encl" 1)
    ("fax" 1)
    ("infos")
    ("institut" (TeX-arg-eval (lambda () (completing-read "Institut: " LaTeX-lettre-instituts nil nil nil 'LaTeX-lettre-instituts-hist))))
    ("internet" 1)
    ("lieu" 1)
    ("lettreselectlanguage" (TeX-arg-eval (lambda () (completing-read "Langue: "
								      LaTeX-lettre-languages nil t nil 'LaTeX-lettre-languages-hist "french"))))
    ("location" 1)
    ("makelabels" [1])
    ("mencl" 1)
    ("name" 1)
    ("nofax")
    ("noinfos")
    ("opening" (TeX-arg-eval (lambda () (completing-read "Apostrophe: " LaTeX-lettre-openings nil nil nil 'LaTeX-lettre-openings-hist))))
    ("ps" 2)
    ("secondsignature" 1)
    ("signature" 1)
    ("telepac" 1)
    ("telephone" 1)
    ("thirdsignature" 1)
    ("username" 1))))
     (apply 'TeX-add-symbols new-symbols)

     (LaTeX-add-environments
       '("letter" LaTeX-env-lettre-letter)
       '("telefax" LaTeX-env-lettre-fax))
     ;; Fontification
     (when (and (featurep 'font-latex)
		(eq TeX-install-font-lock 'font-latex-setup))
       (font-latex-add-keywords
	(delq nil
	      (mapcar
	       (lambda (x)
		      (list (car x) "{"))
	       new-symbols))
	'function))))
 LaTeX-dialect
 )


(defun LaTeX-lettre-origdate-to-date ()
  (interactive)
  (let ((odt-file (expand-file-name (concat (file-name-base) ".odt")))
	odt-visited-p
	odt-buf
	found
	(lettre 1)
	date-list
	beg end)
    (unless (file-exists-p odt-file)
      (error "Fichier non trouvé %s" odt-file))
    (let ((bl (buffer-list)) buf)
      (while bl
	(setq buf (pop bl))
	(and (string= (buffer-file-name buf) odt-file)
	     (setq bl nil
		   odt-visited-p t
		   odt-buf buf))))
    (setq odt-buf (or odt-buf
		      (save-excursion
			(find-file odt-file))))
    (save-excursion
      (with-current-buffer odt-buf
	(revert-buffer t t)
	(goto-char (point-min))
	(while (looking-at (format "^\\\\expandafter\\\\def\\\\csname origdate%d\\\\endcsname{\\([^}\n\r]+\\)}\r?$"
					  lettre))
	  (push (match-string 1) date-list)
	  (setq lettre (1+ lettre))
	  (beginning-of-line 2))))
    (unless odt-visited-p (kill-buffer odt-buf))
    (save-excursion
      (goto-char (point-max))
      (dolist (date date-list)
	(unless (re-search-backward "^ *\\\\end{letter}" nil t)
	  (error "Fin environnement letter non trouvée"))
	(setq end (point))
	(unless (re-search-backward "^ *\\\\begin{letter}" nil t)
	  (error "Début environnement letter non trouvée"))
	(forward-sexp 3)
	(setq beg (point) found nil)
	(if
	 (progn
	    (while (and (re-search-forward "\\\\date *{\\([^}]+\\)}\\|\\\\opening *{" end t)
			(if (TeX-in-comment) t (setq found t) nil)))
	    (unless found (goto-char beg))
	    found)
	  (if (match-string 1)
	      (unless (string= (match-string 1) date)
		(replace-match (concat "\\date{" date "}") t t))
	    (goto-char (match-beginning 0))
	    (insert (concat "\\date{" date "}\n"))
	    (LaTeX-indent-line))
	  (insert (concat "\\date{" date "}\n"))
	  (LaTeX-indent-line))))
    (save-excursion
      (goto-char (point-min))
      (when (re-search-forward "^\\( *\\\\documentclass\\[\\(?:[A-Za-z0-9 ,]*[A-Za-z0-9]+ *\\)?\\)\\(,\\)? *origdate *\\(,\\)?\\(\\(?: *[A-Za-z0-9]+[a-z0-9 ,]*\\)? *\\]{lettre}\\)" nil t)
	(cond
	 ((match-string 2)
	  (replace-match (concat (match-string 1) (match-string 3) (match-string 4)) t t))
	 ((match-string 3)
	  (replace-match (concat (match-string 1) (match-string 2) (match-string 4)) t t))
	 (t
	   (replace-match (concat (match-string 1) (match-string 4)) t t)))))))


;;;
;; Local Variables:
;; coding: utf-8
;; End: