SVN-fs-dump-format-version: 2

Revision-number: 1
Prop-content-length: 126
Content-length: 126

K 8
svn:date
V 27
2011-04-12T05:06:45.000000Z
K 7
svn:log
V 52
Standard project directories initialized by cvs2svn.
PROPS-END

Node-path: trunk
Node-kind: dir
Node-action: add


Node-path: branches
Node-kind: dir
Node-action: add


Node-path: tags
Node-kind: dir
Node-action: add


Revision-number: 2
Prop-content-length: 121
Content-length: 121

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2011-04-12T05:06:45.000000Z
K 7
svn:log
V 19
Creation du projet

PROPS-END

Node-path: trunk/lisp
Node-kind: dir
Node-action: add


Node-path: trunk/lisp/html-to-texinfo.el
Node-kind: file
Node-action: add
Prop-content-length: 10
Text-content-length: 42797
Text-content-md5: 137f25516c6e5bb3ddad23f452f53996
Content-length: 42807

PROPS-END
;;; html-to-texinfo.el --- -*- coding: iso-8859-1-unix -*-

;; Copyright 2010 Vincent Belaïche
;;
;; Author: Vincent Belaïche <vincent.b.1@hotmail.fr>
;; Version: $Id: html-to-texinfo.el,v 1.1.1.1 2011-04-12 05:06:45 Vincent Exp $
;; Keywords: 
;; X-URL: not distributed yet

;; 
;; This software is governed by the CeCILL license under French law and
;; abiding by the rules of distribution of free software.  You can  use, 
;; modify and/ or redistribute the software under the terms of the CeCILL
;; license as circulated by CEA, CNRS and INRIA at the following URL
;; "http://www.cecill.info". 
;; 
;; As a counterpart to the access to the source code and  rights to copy,
;; modify and redistribute granted by the license, users are provided only
;; with a limited warranty  and the software's author,  the holder of the
;; economic rights,  and the successive licensors  have only  limited
;; liability. 
;; 
;; In this respect, the user's attention is drawn to the risks associated
;; with loading,  using,  modifying and/or developing or reproducing the
;; software by the user in light of its specific status of free software,
;; that may mean  that it is complicated to manipulate,  and  that  also
;; therefore means  that it is reserved for developers  and  experienced
;; professionals having in-depth computer knowledge. Users are therefore
;; encouraged to load and test the software's suitability as regards their
;; requirements in conditions enabling the security of their systems and/or 
;; data to be ensured and,  more generally, to use and operate it in the 
;; same conditions as regards security. 
;; 
;; The fact that you are presently reading this means that you have had
;; knowledge of the CeCILL license and that you accept its terms.
;; 
;;; Commentary:

;; 

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'html-to-texinfo)

;;; Code:

(provide 'html-to-texinfo)
(eval-when-compile
  (require 'cl))
(require 'eieio)


;;;;##########################################################################
;;;;  User Options, Variables
;;;;##########################################################################

(defun html2texi-itemized (texi-itemize-mark html-itemize-mark)
  (let ((re1 (concat "^[ \t]*<" (regexp-quote html-itemize-mark) ">[ \t]*$"))
		(re2 (concat "[ \t]*<\\(/?\\)" (regexp-quote html-itemize-mark) ">[ \t]*$"))
		)
	(while (re-search-forward re1 nil t)
	  (let (end-mark 
			(p (point))
			(mb (match-beginning 0))
			(me (match-end 0)))
										; get matching </ol>
		(let ((level 1) (loop-again t) (found nil)
			  )
		  (while (and loop-again (re-search-forward re2  nil t))
			(cond
			 ((equal (match-string-no-properties 1) "")
			  (setq level (1+ level)))
			 ((and (= level 1) (equal (match-string-no-properties 1) "/"))
			  (setq level 0 loop-again nil found t))
			 (t
			  (setq level (1- level)))))
		  (when found
			(replace-match (concat "@end " texi-itemize-mark))
			(setq end-mark (point-marker))
			(delete-region mb me)
			(goto-char mb)
			(insert "@" texi-itemize-mark)
			(while (re-search-forward 
					"^\\([ \t]*\n\\)*[ \t]*<li>\\([ \t]*\n\\)*" 
					end-mark t)
			  (replace-match "@item\n")) ;
			(goto-char mb)
			(while (re-search-forward "</li>" end-mark t)
			  (replace-match ""));
			(set-marker end-mark nil)
			)))							;
	  )))


(defun html2texi-replace-paired-tag (html-tag texi-tag &optional env)
  (let ((p1b (- (point) (1+ (length html-tag))))
	(html-tag-re (regexp-quote html-tag))
	p1e
	p2)
    ;; vérification sanitaire
    (unless (string= (buffer-substring p1b (point)) (concat "<" html-tag))
      (error "Appel invalide à la fonction `html2texi-replace-paired-tag'"))
    (unless (re-search-forward ">" nil t)
      (error "Impossible de trouver le > closant <%s" html-tag))
    (delete-region p1b (point))
    (unless  (re-search-forward (concat "</" html-tag-re ">") nil t)
      (error "Impossible de trouver </%s>" html-tag))
    (if env
	(replace-match (concat "\n@end " html-tag "\n") t t)
	(replace-match "}"))
    (setq p2 (point-marker))
    (goto-char p1b)
    (insert "@" texi-tag (if env "\n" "{"))
    (goto-char p2)
    (set-marker p2 nil)))

(defun html2texi-process-comment ()
  (let* ((p1 (point))
	(p2 (save-excursion (if 
				(re-search-forward "-->" nil t) 
				(point)
			      (error "Error: fin de commentaire non trouvée"))))
	last-cr
	(text (split-string (buffer-substring p1 (- p2 3)) "\n")))
    (delete-region (- p1 4) p2)
    (setq last-cr (null (looking-at "\\s-*$")))
    (dolist (text-row text)
      (insert "@c " text-row "\n"))
    (unless last-cr
      (delete-region (point) (1- (point))))))


(defun html2texi-replace-unpaired-tag (html-tag texi-tag)
  (let ((p1b (- (point) (1+ (length html-tag))))
	(html-tag-re (regexp-quote html-tag))
	p1e
	p2)
    ;; vérification sanitaire
    (unless (string= (buffer-substring p1b (point)) (concat "<" html-tag))
      (error "Invalid call to html2texi-tag"))
    (unless (re-search-forward ">" nil t)
      (error "Can't find closing > of <%s" html-tag))
    (delete-region p1b (point))
    (insert "@" texi-tag)))
    
(defun html2texi-tag-convert ()
  (save-excursion
    ;; suppression des lignes vides superflues
    (save-match-data
      (goto-char (point-min))
      (while (re-search-forward "\n[ \t]*\n[ \t]*

" nil t)
	(replace-match "\n\n")))		;
    ;; traitement des balises
    (goto-char (point-min))
    (while (re-search-forward "<\\(/?[a-zA-Z0-9]+\\|!--\\)" nil t)
      (let ((tag (match-string-no-properties 1))
	    (p1 (match-beginning 0)))
	(cond
	 ((save-match-data (string-match "\\`h\\([1-4]\\)\\'" tag))
	  (let ((level  (1- (string-to-number (substring tag 1))))
		p2 title)
	    (unless (re-search-forward ">" nil t)
	      (error "Impossible de trouver la clôture de la balise <h"))
	    (delete-region p1 (point))
	    (cond
	     ((re-search-forward (concat "</h" (number-to-string (1+ level)) ">")
				 nil t)
	      (replace-match "")
	      (setq p2 (point)
		    title (mapconcat 'identity 
				     (split-string (buffer-substring p1 p2) "\n")
				     " "))
	      (delete-region p1 p2)
	      (if (looking-back "^\\s-*") 
		  (insert "\n")
		(if (looking-back "^\\s-+")
		    (replace-match "")))
	      (insert  "@" 
		       (aref ["chapter" "section" "subsection" "subsubsection"] level)
		       " "
		       title))
	     (t (error "Can't find title closure")))));
	 ((string= tag "ol")
	  (html2texi-itemized "enumerate" "ol"))
	 ((string= tag "ul")
	  (html2texi-itemized "itemize" "ul"));
	 ((and (string= tag "code")
	       (save-match-data (looking-at "[ \t\n]+class=\"file\"")))
	  (html2texi-replace-paired-tag "code" "file"));
	 ((and (string= tag "kbd")
	       (save-match-data (looking-at "[ \t\n]+class=\"kbd\"")))
	  (html2texi-replace-paired-tag "kbd" "kbd"));
	 ((and (string= tag "kbd")
	       (save-match-data (looking-at "[ \t\n]+class=\"menu\"")))
	  (html2texi-replace-paired-tag "kbd" "kbdmenu"));
	 ((and (string= tag "kbd")
	       (save-match-data (looking-at "[ \t\n]+class=\"key\"")))
	  (html2texi-replace-paired-tag "kbd" "key"));
	 ((and (string= tag "code")
	       (save-match-data (looking-at "[ \t\n]+class=\"lisp\"")))
	  (html2texi-replace-paired-tag "code" "command"));
	 ((and (string= tag "code")
	       (save-match-data (looking-at "[ \t\n]+class=\"tpl\"")))
	  (html2texi-replace-paired-tag "code" "codetpl"));
	 ((and (string= tag "code")
	       (save-match-data (looking-at "[ \t\n]+class=\"tpl\"")))
	  (html2texi-replace-paired-tag "code" "codetpl"));
	 ((string= tag "code")
	  (html2texi-replace-paired-tag "code" "code"));
	 ((and (string= tag "samp")
	       (save-match-data (looking-at "[ \t\n]+class=\"text\"")))
	  (html2texi-replace-paired-tag "samp" "samp"));
	 ((and (string= tag "pre")
	       (save-match-data (looking-at "[ \t\n]+class=\"emacs\"")))
	  (html2texi-replace-paired-tag "pre" "lisp" t));
	 ((string= tag "cite")
	  (html2texi-replace-paired-tag "cite" "cite"));
	 ((string= tag "strong")
	  (html2texi-replace-paired-tag "strong" "strong"));
	 ((string= tag "b")
	  (html2texi-replace-paired-tag "b" "strong"));
	 ((string= tag "em")
	  (html2texi-replace-paired-tag "em" "emph"));
	 ((string= tag "i")
	  (html2texi-replace-paired-tag "i" "emph"));
	 ((string= tag "dfn")
	  (html2texi-replace-paired-tag "dfn" "dfn"));
	 ((save-match-data (string-match "\\`/?p" tag))
	  (let ((end-par (= ?/ (aref tag 0))))
	    (delete-region p1
			   (if (re-search-forward ">" nil t)
			       (point)
			     (error "Impossible de trouver le > closant <%s" tag)))
	    (cond
	     ;; do nothing if preceded/followed by an empty line
	     ((string-match 
	       "\\`\\s-*\n\\s-*\\'" 
	       (if end-par
		   (buffer-substring 
		    (point)
		    (save-excursion
		      (beginning-of-line 2)
		      (point))
		    )
		 (buffer-substring 
		  (save-excursion
		    (beginning-of-line 0)
		    (point))
		  (point)))))
	     ;; do nothing if preceded/followed by blank
	     ((string-match 
	       "\\`\\s-*\\'" 
	       (if end-par
		   (buffer-substring 
		    (point)
		    (save-excursion
		      (end-of-line)
		      (point))
		    )
		 (buffer-substring 
		  (save-excursion
		    (beginning-of-line)
		    (point))
		  (point))))
	      (insert "\n"))
	     ;; insert 2 LF otherwise
	     (t (insert "\n\n")))));

	 ((string= tag "hr")
	  (html2texi-replace-unpaired-tag "hr" ""));

	 ((string= tag "br")
	  (html2texi-replace-unpaired-tag "br" "*"));
	 ((string= tag "!--")
	  (html2texi-process-comment))
	 )))

    (while (re-search-forward "&nbsp;" nil t)
      (replace-match "@tie{}"));
    (goto-char (point-min))
    (while (re-search-forward "&hellip;" nil t)
      (replace-match "@dots{}")); enddots?
    (goto-char (point-min))
    (while (re-search-forward "<\\(/\\)?p>" nil t)
      (goto-char (point-min))
      (while (re-search-forward "<br/?>" nil t)
	(replace-match "@*"));

      )))

(defconst html2texi-suspicious-html-tags
  '("meta" "br" "hr" "link" "img" "frame"))

(defconst html2texi-suspicious-html-tags-re
  (regexp-opt html2texi-suspicious-html-tags))

(defconst html2texi-non-recursive-tags
  '("p" "li"))

(defconst html2texi-non-recursive-tags-re
  (regexp-opt html2texi-non-recursive-tags))


(defclass html2texi-simple-markup ()
  ((class-dependant 
    :initarg :class-dependant
    :initform nil
    :custom '(repeat
	  (list 
	   (regexp :tag "clef")
	   (string :tag "prologue")
	   (string :tag "épilogue")
	   ))
    :documentation "\
Liste d'association dont les éléments sont de la forme 
 (CLEF PROLOGUE ÉPILOGUE) 

Supposons que l'objet décrit le traitement de la balise TAG,
alors lorsque le code HTML `<TAG class=\"CLEF\">CONTENU</TAG>'
est rencontré, alors il est convertie en le code Texinfo
`PROLOGUE TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU.")
   (preamble
    :initarg :preamble
    :type string
    :documentation "\
Prologue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (postamble
    :initarg :postamble
    :type string
    :documentation "\
Épilogue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   )
  :documentation "\
Un object de type `html2texi-simple-markup'
décrit le traitement d'une balise simple comme par exemple
<code>.")

(defmethod html2texi-handle-simple-markup 
  ((this html2texi-simple-markup) xml-expr)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe 
			(and class-attribute
			     (assoc-string (cdr class-attribute) 
					   (oref this :class-dependant))))
		      (list (oref this :preamble)
			    (oref this :postamble)))))
    (insert (car pre-post))
    (html2texi-process-xml-expr xml-expr)
    (insert (cadr pre-post))))


(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-i-simple-markup
  (html2texi-simple-markup "html2texi-i-simple-markup"
   :preamble "@emph{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-b-simple-markup
  (html2texi-simple-markup "html2texi-b-simple-markup"
   :preamble "@strong{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-kbd-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :preamble "@kbd{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-dfn-simple-markup
  (html2texi-simple-markup "html2texi-dfn-simple-markup"
   :preamble "@dfn{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-samp-simple-markup
  (html2texi-simple-markup "html2texi-samp-simple-markup"
   :preamble "@samp{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<samp class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-handle-two-columns-table-as-@table
  t
 "Si `nil' alors une table `<table>...</table>'
avec deux colonne sera gérée en texinfo par une `@table', si non
`nil', alors elle sera gérée par une `@multitable'."
  :type
  '(choice
    (const :tag "t pour @table" t)
    (const :tag "nil pour @multitable" nil))
  :group 'html2texi)


(defvar html2texi-document-information nil
  "Liste d'association pour mémoriser les informations (titre,
  auteurs, etc...) propres à un document.")

(defvar html2texi-xml-parsed nil
  "Résultat de l'analyse syntaxique d'un doc")

(defvar html2texi-xml-stack nil
  "Pile des expressions XML")

(defvar html2texi-keep-empty-strings nil
  "Non nil si les chaînes vides sont à conserver.")

(defvar html2texi-ignore-head nil
  "Non nil si on ignore le <head> (dans un fichier HTML lié).")

(defvar html2texi-directory-stack nil
  "Pile des chemins de répertoire.")

(defvar html2texi-files-doing-or-done nil
  "Liste des fichiers déjà traité, ou le fichier en cours de traitement.")

(defvar html2texi-files-to-do nil
  "Liste des fichiers non encore traité")

(defvar html2texi-directory-ref nil
  "Répertoire de référence")

(defmacro html2texi-make-simple-markup-handler (tag)
  `(defun ,(intern (concat "html2texi-tag-handler-" (symbol-name tag)))
     (xml-expr)
     (html2texi-handle-simple-markup  
      ,(intern (concat "html2texi-"  (symbol-name tag) "-simple-markup")) 
      xml-expr) ))

(defun html2texi-make-html-clean-xml (beg end)
  (let  ((end-arg end)
	 end)
    (if (markerp end-arg)
	(setq end end-arg)
      (goto-char end-arg)
      (setq end (point-marker)))
    ;; rend les balise implicitement auto-closante vraiment auto-closante
    (goto-char beg)
   (while (re-search-forward (concat "<\\(" html2texi-suspicious-html-tags-re "\\)\\>")
			      end t)
      (let ((tag (match-string-no-properties 1)))
	(unless (re-search-forward ">" nil t)
	  (error "Clôture non trouvé pour la balise %s" tag))
	(when (null (looking-back "/>"))
	  (backward-char)
	  (insert "/")
	  (forward-char))))
    ;; marque de paragraph et de ligne
    (goto-char beg)
    (let (tag-stack p1 tag is-closure self-closing)
      (while (re-search-forward "<\\(/\\)?\\([a-zA-Z]+\\)\\>" end t)
	(setq p1 (match-beginning 0)
	      tag (match-string-no-properties 2)
	      is-closure (match-string-no-properties 1))
	(unless (string= tag (downcase tag))
	  (replace-match (setq tag (downcase tag)) 2))
	(unless (re-search-forward ">" end t)
	  (error "`Soufflet de clôture non trouvé pour la balise %s" tag))
	(setq self-closing (looking-back "/>"))
	(cond
	 ((and self-closing  is-closure)
	  (error "balise %s à la fois de clôture et auto-closante" tag))

	 (self-closing
	  ;; do nothing
	  )

	 ((null is-closure)
	  (when (and
		 (string-match (concat "\\`" html2texi-non-recursive-tags-re "\\'") tag)
		 tag-stack
		 (string= tag (caar tag-stack)))
	    ;; clôture
	    (save-excursion
	      (goto-char p1)
	      (insert "</" tag "><!-- HTML2TEXI: repaired (1) -->"))
	    (pop tag-stack))
	  (push (list tag) tag-stack))

	 (is-closure
	      (if (and tag-stack
		       (string= (caar tag-stack) tag))
		  (pop tag-stack)
		(let ((first (assoc-string tag tag-stack)) rev)
		  (if first
		      (progn
			(while (and tag-stack (null (eq (car tag-stack) first)))
			  (push (pop tag-stack) rev))
			(pop tag-stack)
			(save-excursion
			  (goto-char p1)
			  (debug)
			  (dolist (c rev)
			    (insert  "</" (car c) "><!-- HTML2TEXI: repaired (2) -->" ))))
		    (error "Clôture de %s ne correspondant à aucune ouverture" tag)))))))

       
      (let (p-pos li-pos markup poss pos)
	(while (re-search-forward "<\\(/\\)?\\(p\\|li\\)\\>[^>]*>" end t)
	  (setq markup (match-string-no-properties 2)
		poss (intern (concat markup "-pos"))
		pos (symbol-value poss))
	  (if (match-string-no-properties 1)
	      (if  pos 
		  (if (= pos (match-beginning 0))
		      (set poss nil)
		    (error "Clôture de balise %s ne correspondant à aucune ouverture" (match-string-no-properties 0)))
		(save-excursion
		  (save-match-data
		    (unless  (re-search-forward 
			      (format "<\\(/\\)?\\(%s\\)\\>[^>]+>" markup) 
			      end t)
		      (error "Ouverture de balise <%s> sans clôture" markup))
		    (set poss (match-beginning 0))
		    (unless (match-string-no-properties 1)
		      (goto-char (match-beginning 0))
		      (insert (format "</%s>" markup))
		      (dolist (symb '(p-pos li-pos))
			(unless (or (null (symbol-value symb))
				 (eq symb poss))
			  (set symb (+ (length markup) 3 (symbol-value symb)))))))))))
	    ))
    ;; mise entre guillemets anglais des attributs entier sans guillemets
    (goto-char beg)
    (let (p1 p2 added-dquote-attributes p-start)
      ;; tant qu'on trouve potentiellement un attribut sans "..."
      (while (re-search-forward "\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([0-9]+\\)"
				nil end)
	(setq p1 (match-beginning 1)
	      p2 (match-end 0))
	(if
	    ;; si la position est bien entre < et >
	    (and (re-search-backward "[<>]" nil beg)
		 (string= (match-string-no-properties 0) "<")
		 (looking-at "<\\sw+")
		 (progn 
		   (goto-char (setq p-start (match-end 0)))
		   (re-search-forward "[<>]" nil beg)
		   (string= (match-string-no-properties 0) ">"))
		 (>= (point) p1))
	    ;; alors on fait la réparation
	    (progn
	      (goto-char p-start)
	      (while 
		  (progn
		    (while (looking-at "\\(?:\\s-\\|\n\\)*\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\"[^\"]*\"")
		      (goto-char (match-end 0)))
		    (cond
		     ((looking-at  "\\(?:\\s-\\|\n\\)*\\(\\sw+\\)\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([0-9]+\\)")
		      (push (match-string-no-properties 1) added-dquote-attributes)
		      (goto-char (match-beginning 2))
		      (insert ?\")
		      (goto-char (1+ (match-end 2)))
		      (insert ?\"))
		     ((looking-at "\\(?:\\s-\\|\n\\)*>") 
		      (goto-char (match-end 0))
		      (insert "<!-- HTML2TEXI inserted double quotes around values for attibutes" 
			      (mapconcat (lambda (x) (concat "`" x "'"))
					 added-dquote-attributes
					 ", ")
			      ">")
		      (debug)
		      nil)
		     (t (error "Attribut au format invalide: %s"
			       (match-substring-no-properties (point)
							      (+ p2 
								 (* 2 (length added-dquote-attributes))))))))))
	  ;; sinon on continue à chercher un attribut potentiel dont la valeur
	  ;; n'est pas entre "..."
	  (goto-char p2))))


    ;; un peu de ménage...
    (unless (markerp end-arg)
      (set-marker end nil)) ))

;;;==========================================================================
;;; définition des gestionnaires de balise
;;;--------------------------------------------------------------------------

(defun html2texi-tag-handler-a (xml-expr)
  (let (name href text)
    (dolist (attrib (cadr xml-expr))
      (cond
       ((eq (car attrib) 'href)
	(setq href (cdr attrib)))
       ((eq (car attrib) 'name)
	(setq name (cdr attrib))))
      (when (and (cddr xml-expr)
		 (stringp (caddr xml-expr)))
	(setq name (caddr xml-expr))))
    (when name
      (insert "\n@anchor{" (html2texi-make-anchor name) "}\n"))
    (when href
      (html2texi-process-url href text))))

(html2texi-make-simple-markup-handler b)

(defun html2texi-tag-handler-h1 (xml-expr)
  (insert "@chapter " (hmtl2texi-to-plain-text xml-expr t) ?\n))


(defun html2texi-tag-handler-h2 (xml-expr)
  (insert "@section " (hmtl2texi-to-plain-text xml-expr t) ?\n))

(defun html2texi-tag-handler-h3 (xml-expr)
  (insert "@subsection " (hmtl2texi-to-plain-text xml-expr t) ?\n))

(defun html2texi-tag-handler-h4 (xml-expr)
  (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr t) ?\n))

(defun html2texi-tag-handler-h5 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr t) ?\n))

(defun html2texi-tag-handler-h6 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr t) ?\n))

(html2texi-make-simple-markup-handler samp)


(defun html2texi-get-col-span (xml-expr)
  ;; xml-expr is <td> or <th>
  (let ((col-span (cdr-safe (assq 'colspan (nth 1 xml-expr)))))
    (setq col-span
	  (cond
	   ((integerp 
	       (setq col-span
		     (if (stringp col-span) 
			 (string-to-number col-span)
		       col-span)))
	      col-span)
	   ((null col-span) 1)
	   (t (error "colspan invalide"))))  ))

(defvar html2texi-col-number nil)
(defvar html2texi-row-number nil)
(defvar html2texi-head-on-row-0 nil)
(defvar html2texi-col-count nil)

(defun html2texi-tag-handler-table (xml-expr)
  (let (html2texi-col-count 
	(html2texi-row-number 0)
	html2texi-head-on-row-0
	html2texi-col-number)
    (dolist (xml-expr (cddr xml-expr))
      (cond
       ((and (consp xml-expr)
	       (eq (car xml-expr) 'tr))
	  (dolist  (xml-expr (cddr xml-expr))
	    (cond
	     ((consp xml-expr)
		(if (memq  (car xml-expr) '(th td))
		      (setq html2texi-col-count
			    (+ (or html2texi-col-count 0) (html2texi-get-col-span xml-expr)))
		  (error "balise inattendu dans une table")))
	     ((stringp xml-expr)
	      (unless (string-match 
		       "\\`\\s-*\\(\n\\s-*\\)*\\'" 
		       xml-expr)
		(error "Chaîne inattendue")))
	     (t (error "Élément inattendu")))))
       ((stringp xml-expr)
	(unless (string-match 
		 "\\`\\s-*\\(\n\\s-*\\)*\\'" 
		 xml-expr)
	  (error "Chaîne inattendue")))
       (t (error "Élément inattendu"))))
    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(insert "@multitable\n")
      (insert "@table\n"))

    (html2texi-process-xml-expr xml-expr)

    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(insert "@end multitable\n")
      (insert "@end table\n"))))


(defun html2texi-tag-handler-tr (xml-expr)
  (setq html2texi-col-number 0)
  (html2texi-process-xml-expr xml-expr)
  (setq html2texi-row-number (1+ html2texi-row-number)))

(setq toto 0)
(defun html2texi-tag-handler-th (xml-expr)
  (unless (< toto 2)
    (debug)
    (setq toto (1+ toto)))
  (if   (= 0 html2texi-col-number)
      (if (and (= 0 html2texi-row-number)
	       (null html2texi-handle-two-columns-table-as-@table))
	  (progn
	    (setq html2texi-head-on-row-0 t)
	    (insert "@headitem ")
	    (html2texi-process-xml-expr xml-expr))
	(insert "@item ")
	(html2texi-process-xml-expr xml-expr))
    (when (or (> html2texi-col-count 2)
	      (null html2texi-handle-two-columns-table-as-@table))
      (insert "@tab "))
    (html2texi-process-xml-expr xml-expr)
    (unless (and  (= 0 html2texi-row-number) html2texi-head-on-row-0)
	(insert "\n")))
  (setq html2texi-col-number (1+ html2texi-col-number)))

(defun html2texi-tag-handler-td (xml-expr)
  (if (= 0 html2texi-col-number)
      (progn
	(when (and (= 0 html2texi-row-number)
	       html2texi-head-on-row-0)
	  (insert ?\n))
	(insert "@item "))
    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
      (insert "@tab ")))
  (html2texi-process-xml-expr xml-expr)
  (insert "\n")
  (setq html2texi-col-number (1+ html2texi-col-number)))


(defun html2texi-cur-dir ()
  "Détermine le répertoire courant relativement au répertoire du
HTML racine de départ. La valeur retournée se termine par une oblique `/'"
  (let ((cur-dir  (nreverse (split-string (cdar html2texi-directory-stack) "/")))
	(ref-dir  (nreverse (split-string html2texi-directory-ref "/"))))
    (unless (and (string= (car cur-dir) "")
		 (string= (car ref-dir) ""))
      (error "Format invalide de répertoire"))
    (setq cur-dir (nreverse (cdr cur-dir))
	  ref-dir (cdr ref-dir))
    (if (or (string= (car cur-dir) "")
	    (string-match "\\`[a-z]:" (car cur-dir)))
	;; cur-dir est un chemin absolu
	(progn
	  (setq ref-dir (nreverse ref-dir))
	  (while (and cur-dir ref-dir (string= (car cur-dir) (car ref-dir)))
	    (setq cur-dir (cdr cur-dir)
		  ref-dir (cdr ref-dir)))
	  (while ref-dir
	    (push ".." cur-dir)
	    (setq ref-dir (cdr ref-dir)))
	  (concat (mapconcat 'identity cur-dir "/") "/"))
      (while (and cur-dir
		  (cond
		   ((string= (car cur-dir) "..")
		    (unless ref-dir
		      (error "Chemin invalide"))
		    (setq ref-dir (cdr ref-dir)
			  cur-dir (cdr cur-dir)))
		   ((string= (car cur-dir) ".")
		    (setq cur-dir (cdr cur-dir)))
		   (t nil))))
      (dolist (e cur-dir)
	(push e ref-dir))
      (mapconcat 'identity  (nreverse (cons "" ref-dir)) "/") )))

(defun html2texi-make-anchor (name)
  (concat (html2texi-cur-dir) name))

(defun html2texi-tag-handler-body (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))


(html2texi-make-simple-markup-handler code)
(html2texi-make-simple-markup-handler i)

(defun html2texi-tag-handler-br (xml-expr)
  (insert "@*\n"))

(defun html2texi-tag-handler-div (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(html2texi-make-simple-markup-handler dfn)

(defun html2texi-tag-handler-dl (xml-expr)
  (insert "@table @asis\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "@end table\n"))

(defun html2texi-tag-handler-dt (xml-expr)
  (insert "@item ")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(defun html2texi-tag-handler-dd (xml-expr)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(defun html2texi-tag-handler-frameset (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-frame (xml-expr)
  (let (url text)
    (dolist (x (cadr xml-expr))
      (cond 
       ((eq (car x) 'src)
	(setq url (cdr x)))
       ((eq (car x) 'name)
	(setq text (cdr x)))))
    (when url
      (html2texi-process-url url text))))

(defun html2texi-simple-markup-handle (xml-expr class-alist preamble postamble)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe 
			(and class-attribute
			     (assoc-string (cdr class-attribute) class-alist)))
		      (list preamble postamble))))
    (insert (car pre-post))
   (html2texi-process-xml-expr xml-expr)
   (insert (cadr pre-post))))

(defun html2texi-tag-handler-hr (xml-expr)
  (insert "@c <hr/>\n"))

(html2texi-make-simple-markup-handler kbd)

(defun html2texi-handle-string (str)
  (let (ret (pos0 0) pos1 (len (length str)))
    (while (and 
	    (< pos0 len)
	    (setq pos1 (string-match "[{}@]" str pos0)))
      (push (substring str pos0 pos1) ret)
      (push (concat "@" (match-string 0 str)) ret)
      (setq pos0 (1+ pos1)))
    (when (< pos0 len)
      (push (substring str pos0 pos1) ret))
    (apply 'concat (nreverse ret))))


(defun html2texi-error (format-str xml-expr &rest args)
  (apply 'error (concat format-str
			"
-----------------------------------------------------------------------------
xml-expr=%S
xml-stack=%S
-----------------------------------------------------------------------------")
	 `( ,@args ,xml-expr ,html2texi-xml-stack)))

(defun html2texi-process-url (url text)
  (let* ((parsed-url (url-generic-parse-url url))
	 (file-name (expand-file-name
		     (aref parsed-url 6)
		     (caar html2texi-directory-stack))))
    (if (and (eq (aref parsed-url 0) 
		 'cl-struct-url)
	     (null (aref parsed-url 1))
	     (member (file-name-extension (aref parsed-url 6)) '("html" "htm"))
	     (file-exists-p file-name))
	(unless (member file-name html2texi-files-doing-or-done)
	  (add-to-list 'html2texi-files-to-do file-name))
      (insert "@uref{" 
	      url
	      (if text 
		  (concat "," 
			  (html2texi-string-escape text)) 
		"") 
	      "}"))))

(html2texi-make-simple-markup-handler i)

(defun html2texi-tag-handler-li (xml-expr)
  (insert "\n@item\n")
  (unless (memq (caadr html2texi-xml-stack) '(ol ul))
    (html2texi-error "<li> était inattendu" xml-expr))
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-link (xml-expr)
  )

(defun html2texi-tag-handler-ol (xml-expr)
  (insert "\n@enumerate")
   (html2texi-process-xml-expr xml-expr)
  (insert "\n@end enumerate\n"))

(defun html2texi-tag-handler-p (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(defun html2texi-tag-handler-ul (xml-expr)
  (insert "\n@itemize")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n@end itemize\n"))




(defun html2texi-tag-handler-style (xml-expr)
  )


(defun html2texi-tag-handler-meta (xml-expr)
  (unless (and (nth 1 html2texi-xml-stack) 
	       (eq (caadr html2texi-xml-stack) 'head))
    (html2texi-error "<meta> inattendu." xml-expr))
  ;; traitement du meta...
  (let* ((attribute-list (nth 1 xml-expr))
	 (name (assq 'name attribute-list))
	 (content (assq 'content attribute-list)))
    (when (and (consp name) 
	       (consp content)
	       (progn
		 (setq name (cdr name)
		       content (cdr content))
		 (stringp name))
	       (stringp content))
      (cond
       ((string= name "author")
	(html2texi-set-doc-info 'author content))
       ((string= name "language")
	(when (string-match "\\`\\([a-z]\\{2\\}\\(-[A-Z]\\{2\\}\\)?\\)\\'" content)
	  (let ((language (match-string-no-properties 1 content)))
	    (when (= (length language) 5)
	      (aset language 2 ?_))
	    (html2texi-set-doc-info 'language language))))))))

(defun html2texi-tag-handler-pre (xml-expr)
  (let ((kes html2texi-keep-empty-strings))
    (setq html2texi-keep-empty-strings t)
    (html2texi-process-xml-exp xml-expr)
    (setq html2texi-keep-empty-strings kes)))


(defun hmtl2texi-to-plain-text (xml-expr &optional one-line)
  (let (ret)
    (dolist (xml-expr (cddr xml-expr))
      (cond
       ((stringp xml-expr)
	(push xml-expr ret))
       ((consp xml-expr)
	(push xml-expr html2texi-xml-stack)
	(let ((str  (hmtl2texi-to-plain-text xml-expr ret)))
	  (and (null (string= str ""))
	       (push str ret)))
	(pop html2texi-xml-stack))
       (t (html2texi-error "Expression XML inattendue." xml-expr))))
    (setq  ret (mapconcat 'identity (nreverse ret) " "))
    (if one-line
	(mapconcat 'identity (split-string ret "\n") " ")
      ret)))
	  

(defun html2texi-tag-handler-title (xml-expr)
  (unless (and  (nth 1 html2texi-xml-stack)
		(eq  (caadr html2texi-xml-stack) 'head))
    (html2texi-error "<title> inattendu." xml-expr))
  (setq xml-expr (cddr xml-expr))
  (let ((str  (hmtl2texi-to-plain-text xml-expr)))
    (setq str (split-string str "\n")
	  str (mapconcat 'identity str " "))
    (unless (string= str "")
      (html2texi-set-doc-info 'title str))))

(defun html2texi-string-escape (str)
  (with-temp-buffer
    (insert str)
    (goto-char (point-min))
    (while (re-search-forward "[,@{}]" nil t)
      (cond 
       ((string= (match-string-no-properties 0) ",")
	(replace-match "@comma{}"))
       ((member (match-string-no-properties 0) '("@" "{" "}"))
	(replace-match (concat "@" (match-string-no-properties 0))))))
    (buffer-substring (point-min) (point-max))))


(defun html2texi-tag-handler-img (xml-expr)
  (let (filename width height alttext extension)
    (dolist (x (cadr xml-expr))
      (cond
       ((eq (car x) 'src)
	(setq filename (cdr x)))
       ((eq (car x) 'alt)
	(setq alttext (cdr x)))))
    (unless filename
      (html2texi-error "src=... était attendu" xml-expr))
    (setq extension (file-name-extension filename)
	  filename (file-name-sans-extension filename))
    (when (member extension '("png" "jpg" "jpeg" "eps" "txt"))
      (setq extension nil))
    (insert "@image{" (html2texi-string-escape (concat (html2texi-cur-dir) filename)))
    (let ((remainder (list width height alttext extension)))
	(while remainder
	  (if (let (non-empty)
		(mapc (lambda (x) (setq non-empty (or non-empty (stringp x)))) 
		      remainder)
		non-empty)
	      (insert "," (or (pop remainder) ""))
	    (insert "}")
	    (setq remainder nil); rompt la boucle (while remainder...)
	    )))))

(defun html2texi-set-doc-info (tag val)
  (let ((info (assq tag html2texi-document-information)))
    (if info
	(setcdr info val)
      (push (cons tag val) html2texi-document-information))))

(defun html2texi-tag-handler-head (xml-expr)
  (unless html2texi-ignore-head
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-ignore-head t)))

(defun html2texi-tag-handler-noframes (xml-expr)
  )

(if (boundp 'html2texi-handler-hash-table)
    (makunbound 'html2texi-handler-hash-table))
	    
(defconst html2texi-handler-hash-table
  (let ((ht (make-hash-table)))
    (dolist (v '(a b body code dfn dl dt dd i kbd li p hr div ol ul pre
    head meta title frameset frame noframes table th tr td h1 h2
    h3 h4 h5 h5 link br img samp style ))
      (puthash v (symbol-function (intern (concat "html2texi-tag-handler-" (symbol-name v))))
	       ht))
    ht)
  "Table de hashage des traitement associé à chaque balise HTML"
  )

(defun html2texi-remove-empty-strings (xml-expr)
  (setq xml-expr (cdr xml-expr))
  (save-match-data
  (while (cdr xml-expr)
    (if (and (stringp (cadr xml-expr)) 
	     (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'" (cadr xml-expr)))
	(setcdr xml-expr (cddr xml-expr))
      (setq xml-expr (cdr xml-expr))))))

(defun html2texi-process-xml-expr (xml-expr)
  (push xml-expr html2texi-xml-stack)
  (dolist (xml-expr (cddr xml-expr))
    (cond
     ((consp xml-expr)
      (push xml-expr html2texi-xml-stack)
      (let ((handler (gethash (intern (downcase (symbol-name (car xml-expr))))
			      html2texi-handler-hash-table)))
	(if handler
	    (funcall handler  xml-expr)
	  (html2texi-default-handling xml-expr)))
      (pop html2texi-xml-stack))
     ((stringp xml-expr)
      (and (or html2texi-keep-empty-strings
	       (null (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'"  xml-expr)))
	   (insert (html2texi-handle-string xml-expr))))
     (t (error "Expression XML inattendue %S" xml-expr))))
  (pop html2texi-xml-stack))

(defun html2texi-default-handling (xml-expr)
  (let ((str (split-string (prin1-to-string xml-expr) "\n")))
    (dolist (str-line str)
      (insert "\n@c " str-line)))
    (insert "\n"))

(defun html2texi-process-region (beg end)
  (goto-char end)
  (let ((end (point-marker)) 
	xml-expr)

    ;; Suppression de tout ce qui est en dehors des balise <html> ... </html>
    (goto-char beg)
    (unless (re-search-forward "<html" end t)
      (error "Balise <html> non trouvée"))
    (delete-region beg (match-beginning 0))
    (unless (re-search-forward ">" end t)
      (error "Clôture de la balise <html> trouvéee"))
    (unless  (re-search-forward "</html" end t)
      (error "Balise </html> non trouvée trouvée"))
    (unless (re-search-forward ">" end t)
      (error "Clôture de la balise </html> trouvée"))
    (delete-region (match-end 0) end)
    
    (html2texi-make-html-clean-xml beg end)
    
    (setq xml-expr (xml-parse-region (point-min) (point-max)))
    (delete-region beg end)
    (set-marker end nil)
    xml-expr))

(defun html2texi-make-texi-buffer (&optional buffer )
  (let* ((start-buffer (or buffer (current-buffer)))
	 xml-expr
	 (start-filename  (or (buffer-file-name start-buffer) (buffer-name)))
	 (start-filename-ext (file-name-extension start-filename))
	 (texi-buffer-name 
	  (concat (concat  (file-name-sans-extension   (file-name-nondirectory start-filename)) 
			    ".texi")))
	 done-links-list
	 texi-buffer)
    (unless (or (member start-filename-ext '("html" "htm"))
		(y-or-n-p (format "le tampon %s n'a pas une extension html, continuer?"
				  start-filename)))
      (error "Fichier sans extension html"))
    (setq texi-buffer (get-buffer-create texi-buffer-name))
    (set-buffer texi-buffer)
    (erase-buffer)
    (insert (with-current-buffer start-buffer
	      (save-restriction
		(widen)
		(buffer-substring (point-min) (point-max)))))
    
    ;; collections des informations
    (dolist (var '(html2texi-document-information 
		   html2texi-keep-empty-strings
		   html2texi-xml-parsed 
		   html2texi-xml-stack 
		   html2texi-ignore-head
		   html2texi-directory-stack
		   html2texi-directory-ref
		   html2texi-files-doing-or-done
		   html2texi-files-to-do))
      (set (make-local-variable var) nil))
    (push (cons default-directory "./") html2texi-directory-stack)
    (setq html2texi-directory-ref default-directory)

    (setq xml-expr (html2texi-process-region (point-min) (point-max)))
    (unless (eq 'html (caar xml-expr))
      (error "Résultat d'analyse XML inattendu"))
    (setq xml-expr (car xml-expr))
    (html2texi-process-xml-expr xml-expr)
    (while html2texi-files-to-do
      (setq file-name (pop html2texi-files-to-do))
      (push file-name html2texi-files-doing-or-done) 
      (let* ((dir (file-name-as-directory
		   (file-name-directory file-name)))
	     (rel-dir   (let ((d
			       (file-name-directory
				(file-relative-name file-name html2texi-directory-ref))))
			  (if d (file-name-as-directory d)
			    "./"))))
	(push (cons dir rel-dir) html2texi-directory-stack)
	(;with-temp-buffer
	 with-current-buffer (get-buffer-create "*xxxx*") (erase-buffer)
	  (insert-file-contents file-name)
	  (html2texi-make-html-clean-xml (point-min) (point-max))
	  (setq xml-expr (html2texi-process-region (point-min) (point-max))))
	(unless (eq 'html (caar xml-expr))
	  (error "Résultat d'analyse XML inattendu"))
	(setq xml-expr (car xml-expr))
	(html2texi-process-xml-expr xml-expr)
	(pop html2texi-directory-stack)	))))

(defun html2texi-insert-doc-info ()
  (let ((author 
	 (html2texi-string-escape 
	  (or (cdr-safe (assq 'author html2texi-document-information)) "AUTHOR")))
	(title 	 (html2texi-string-escape 
		  (or (cdr-safe (assq 'title html2texi-document-information)) "TITLE")))
	(language 	 (html2texi-string-escape 
			  (or (cdr-safe (assq 'language html2texi-document-information)) "LANGUAGE"))))
    
    (goto-char (point-min))
    (insert "\\input texinfo   @c -*-texinfo-*-
@setfilename " (file-name-sans-extension (buffer-name)) ".info
@documentlanguage " language "
@copying
This manual is for PROGRAM, version VERSION.

Copyright @copyright{} YEARS COPYRIGHT-OWNER.

@quotation
Permission is granted to ...
@end quotation
@end copying

@titlepage
@title " title "@c NAME-OF-MANUAL-WHEN-PRINTED
@c @subtitle SUBTITLE-IF-ANY
@c @subtitle SECOND-SUBTITLE
@author " author "

@c  The following two commands
@c  start the copyright page.
@page
@vskip 0pt plus 1filll
@insertcopying

Published by ...
@end titlepage

@c So the toc is printed at the start.
@contents

@ifnottex
@node Top
@top TITLE

This manual is for PROGRAM, version VERSION.
@end ifnottex
")
    (goto-char (point-max))
    (insert "
@bye") ))

(defun html2texi-post-process ()
  "Remplace les double lignes vides en ligne vides simples."
  (goto-char (point-min))
  (while (re-search-forward "\\(^[ \t]*\n\\)\\{2,\\}" nil t)
    (replace-match "\n")))

(defun html2texi ()
  (interactive)
  (html2texi-make-texi-buffer)
;;  (html2texi-tag-convert)
  (html2texi-insert-doc-info)
  (html2texi-post-process))




;;; html-to-texinfo.el ends here


Revision-number: 3
Prop-content-length: 136
Content-length: 136

K 8
svn:date
V 27
2011-04-12T05:06:46.000000Z
K 7
svn:log
V 62
This commit was manufactured by cvs2svn to create tag 'start'.
PROPS-END

Node-path: tags/start
Node-kind: dir
Node-action: add
Node-copyfrom-rev: 2
Node-copyfrom-path: trunk

Revision-number: 4
Prop-content-length: 206
Content-length: 206

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2011-04-12T05:15:54.000000Z
K 7
svn:log
V 103
Petite mise à jour de rien du tout, juste pour voir si l'importation sous CVS s'est bien passée.

PROPS-END

Node-path: trunk/lisp/html-to-texinfo.el
Node-kind: file
Node-action: change
Text-content-length: 42922
Text-content-md5: bed9d8d39891ce564115c5d874101f06
Content-length: 42922

;;; html-to-texinfo.el --- -*- coding: iso-8859-1-unix -*-

;; Copyright 2010 Vincent Belaïche
;;
;; Author: Vincent Belaïche <vincent.b.1@hotmail.fr>
;; Version: $Id: html-to-texinfo.el,v 1.2 2011-04-12 05:15:54 Vincent Exp $
;; Keywords: 
;; X-URL: not distributed yet

;; 
;; This software is governed by the CeCILL license under French law and
;; abiding by the rules of distribution of free software.  You can  use, 
;; modify and/ or redistribute the software under the terms of the CeCILL
;; license as circulated by CEA, CNRS and INRIA at the following URL
;; "http://www.cecill.info". 
;; 
;; As a counterpart to the access to the source code and  rights to copy,
;; modify and redistribute granted by the license, users are provided only
;; with a limited warranty  and the software's author,  the holder of the
;; economic rights,  and the successive licensors  have only  limited
;; liability. 
;; 
;; In this respect, the user's attention is drawn to the risks associated
;; with loading,  using,  modifying and/or developing or reproducing the
;; software by the user in light of its specific status of free software,
;; that may mean  that it is complicated to manipulate,  and  that  also
;; therefore means  that it is reserved for developers  and  experienced
;; professionals having in-depth computer knowledge. Users are therefore
;; encouraged to load and test the software's suitability as regards their
;; requirements in conditions enabling the security of their systems and/or 
;; data to be ensured and,  more generally, to use and operate it in the 
;; same conditions as regards security. 
;; 
;; The fact that you are presently reading this means that you have had
;; knowledge of the CeCILL license and that you accept its terms.
;; 
;;; Commentary:

;; 

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'html-to-texinfo)

;;; Code:

(provide 'html-to-texinfo)
(eval-when-compile
  (require 'cl))
(require 'eieio)


;;;;##########################################################################
;;;;  User Options, Variables
;;;;##########################################################################

(defun html2texi-itemized (texi-itemize-mark html-itemize-mark)
  (let ((re1 (concat "^[ \t]*<" (regexp-quote html-itemize-mark) ">[ \t]*$"))
		(re2 (concat "[ \t]*<\\(/?\\)" (regexp-quote html-itemize-mark) ">[ \t]*$"))
		)
	(while (re-search-forward re1 nil t)
	  (let (end-mark 
			(p (point))
			(mb (match-beginning 0))
			(me (match-end 0)))
										; get matching </ol>
		(let ((level 1) (loop-again t) (found nil)
			  )
		  (while (and loop-again (re-search-forward re2  nil t))
			(cond
			 ((equal (match-string-no-properties 1) "")
			  (setq level (1+ level)))
			 ((and (= level 1) (equal (match-string-no-properties 1) "/"))
			  (setq level 0 loop-again nil found t))
			 (t
			  (setq level (1- level)))))
		  (when found
			(replace-match (concat "@end " texi-itemize-mark))
			(setq end-mark (point-marker))
			(delete-region mb me)
			(goto-char mb)
			(insert "@" texi-itemize-mark)
			(while (re-search-forward 
					"^\\([ \t]*\n\\)*[ \t]*<li>\\([ \t]*\n\\)*" 
					end-mark t)
			  (replace-match "@item\n")) ;
			(goto-char mb)
			(while (re-search-forward "</li>" end-mark t)
			  (replace-match ""));
			(set-marker end-mark nil)
			)))							;
	  )))


(defun html2texi-replace-paired-tag (html-tag texi-tag &optional env)
  (let ((p1b (- (point) (1+ (length html-tag))))
	(html-tag-re (regexp-quote html-tag))
	p1e
	p2)
    ;; vérification sanitaire
    (unless (string= (buffer-substring p1b (point)) (concat "<" html-tag))
      (error "Appel invalide à la fonction `html2texi-replace-paired-tag'"))
    (unless (re-search-forward ">" nil t)
      (error "Impossible de trouver le > closant <%s" html-tag))
    (delete-region p1b (point))
    (unless  (re-search-forward (concat "</" html-tag-re ">") nil t)
      (error "Impossible de trouver </%s>" html-tag))
    (if env
	(replace-match (concat "\n@end " html-tag "\n") t t)
	(replace-match "}"))
    (setq p2 (point-marker))
    (goto-char p1b)
    (insert "@" texi-tag (if env "\n" "{"))
    (goto-char p2)
    (set-marker p2 nil)))

(defun html2texi-process-comment ()
  (let* ((p1 (point))
	(p2 (save-excursion (if 
				(re-search-forward "-->" nil t) 
				(point)
			      (error "Error: fin de commentaire non trouvée"))))
	last-cr
	(text (split-string (buffer-substring p1 (- p2 3)) "\n")))
    (delete-region (- p1 4) p2)
    (setq last-cr (null (looking-at "\\s-*$")))
    (dolist (text-row text)
      (insert "@c " text-row "\n"))
    (unless last-cr
      (delete-region (point) (1- (point))))))


(defun html2texi-replace-unpaired-tag (html-tag texi-tag)
  (let ((p1b (- (point) (1+ (length html-tag))))
	(html-tag-re (regexp-quote html-tag))
	p1e
	p2)
    ;; vérification sanitaire
    (unless (string= (buffer-substring p1b (point)) (concat "<" html-tag))
      (error "Invalid call to html2texi-tag"))
    (unless (re-search-forward ">" nil t)
      (error "Can't find closing > of <%s" html-tag))
    (delete-region p1b (point))
    (insert "@" texi-tag)))
    
(defun html2texi-tag-convert ()
  (save-excursion
    ;; suppression des lignes vides superflues
    (save-match-data
      (goto-char (point-min))
      (while (re-search-forward "\n[ \t]*\n[ \t]*

" nil t)
	(replace-match "\n\n")))		;
    ;; traitement des balises
    (goto-char (point-min))
    (while (re-search-forward "<\\(/?[a-zA-Z0-9]+\\|!--\\)" nil t)
      (let ((tag (match-string-no-properties 1))
	    (p1 (match-beginning 0)))
	(cond
	 ((save-match-data (string-match "\\`h\\([1-4]\\)\\'" tag))
	  (let ((level  (1- (string-to-number (substring tag 1))))
		p2 title)
	    (unless (re-search-forward ">" nil t)
	      (error "Impossible de trouver la clôture de la balise <h"))
	    (delete-region p1 (point))
	    (cond
	     ((re-search-forward (concat "</h" (number-to-string (1+ level)) ">")
				 nil t)
	      (replace-match "")
	      (setq p2 (point)
		    title (mapconcat 'identity 
				     (split-string (buffer-substring p1 p2) "\n")
				     " "))
	      (delete-region p1 p2)
	      (if (looking-back "^\\s-*") 
		  (insert "\n")
		(if (looking-back "^\\s-+")
		    (replace-match "")))
	      (insert  "@" 
		       (aref ["chapter" "section" "subsection" "subsubsection"] level)
		       " "
		       title))
	     (t (error "Can't find title closure")))));
	 ((string= tag "ol")
	  (html2texi-itemized "enumerate" "ol"))
	 ((string= tag "ul")
	  (html2texi-itemized "itemize" "ul"));
	 ((and (string= tag "code")
	       (save-match-data (looking-at "[ \t\n]+class=\"file\"")))
	  (html2texi-replace-paired-tag "code" "file"));
	 ((and (string= tag "kbd")
	       (save-match-data (looking-at "[ \t\n]+class=\"kbd\"")))
	  (html2texi-replace-paired-tag "kbd" "kbd"));
	 ((and (string= tag "kbd")
	       (save-match-data (looking-at "[ \t\n]+class=\"menu\"")))
	  (html2texi-replace-paired-tag "kbd" "kbdmenu"));
	 ((and (string= tag "kbd")
	       (save-match-data (looking-at "[ \t\n]+class=\"key\"")))
	  (html2texi-replace-paired-tag "kbd" "key"));
	 ((and (string= tag "code")
	       (save-match-data (looking-at "[ \t\n]+class=\"lisp\"")))
	  (html2texi-replace-paired-tag "code" "command"));
	 ((and (string= tag "code")
	       (save-match-data (looking-at "[ \t\n]+class=\"tpl\"")))
	  (html2texi-replace-paired-tag "code" "codetpl"));
	 ((and (string= tag "code")
	       (save-match-data (looking-at "[ \t\n]+class=\"tpl\"")))
	  (html2texi-replace-paired-tag "code" "codetpl"));
	 ((string= tag "code")
	  (html2texi-replace-paired-tag "code" "code"));
	 ((and (string= tag "samp")
	       (save-match-data (looking-at "[ \t\n]+class=\"text\"")))
	  (html2texi-replace-paired-tag "samp" "samp"));
	 ((and (string= tag "pre")
	       (save-match-data (looking-at "[ \t\n]+class=\"emacs\"")))
	  (html2texi-replace-paired-tag "pre" "lisp" t));
	 ((string= tag "cite")
	  (html2texi-replace-paired-tag "cite" "cite"));
	 ((string= tag "strong")
	  (html2texi-replace-paired-tag "strong" "strong"));
	 ((string= tag "b")
	  (html2texi-replace-paired-tag "b" "strong"));
	 ((string= tag "em")
	  (html2texi-replace-paired-tag "em" "emph"));
	 ((string= tag "i")
	  (html2texi-replace-paired-tag "i" "emph"));
	 ((string= tag "dfn")
	  (html2texi-replace-paired-tag "dfn" "dfn"));
	 ((save-match-data (string-match "\\`/?p" tag))
	  (let ((end-par (= ?/ (aref tag 0))))
	    (delete-region p1
			   (if (re-search-forward ">" nil t)
			       (point)
			     (error "Impossible de trouver le > closant <%s" tag)))
	    (cond
	     ;; do nothing if preceded/followed by an empty line
	     ((string-match 
	       "\\`\\s-*\n\\s-*\\'" 
	       (if end-par
		   (buffer-substring 
		    (point)
		    (save-excursion
		      (beginning-of-line 2)
		      (point))
		    )
		 (buffer-substring 
		  (save-excursion
		    (beginning-of-line 0)
		    (point))
		  (point)))))
	     ;; do nothing if preceded/followed by blank
	     ((string-match 
	       "\\`\\s-*\\'" 
	       (if end-par
		   (buffer-substring 
		    (point)
		    (save-excursion
		      (end-of-line)
		      (point))
		    )
		 (buffer-substring 
		  (save-excursion
		    (beginning-of-line)
		    (point))
		  (point))))
	      (insert "\n"))
	     ;; insert 2 LF otherwise
	     (t (insert "\n\n")))));

	 ((string= tag "hr")
	  (html2texi-replace-unpaired-tag "hr" ""));

	 ((string= tag "br")
	  (html2texi-replace-unpaired-tag "br" "*"));
	 ((string= tag "!--")
	  (html2texi-process-comment))
	 )))

    (while (re-search-forward "&nbsp;" nil t)
      (replace-match "@tie{}"));
    (goto-char (point-min))
    (while (re-search-forward "&hellip;" nil t)
      (replace-match "@dots{}")); enddots?
    (goto-char (point-min))
    (while (re-search-forward "<\\(/\\)?p>" nil t)
      (goto-char (point-min))
      (while (re-search-forward "<br/?>" nil t)
	(replace-match "@*"));

      )))

(defconst html2texi-suspicious-html-tags
  '("meta" "br" "hr" "link" "img" "frame")
"Liste des balises pour lesquelles le HTML ne suit pas une
syntaxe strictement XML. Par exemple `<br>' est utilisé au lieu
de `<br/>'."  )

(defconst html2texi-suspicious-html-tags-re
  (regexp-opt html2texi-suspicious-html-tags))

(defconst html2texi-non-recursive-tags
  '("p" "li"))

(defconst html2texi-non-recursive-tags-re
  (regexp-opt html2texi-non-recursive-tags))


(defclass html2texi-simple-markup ()
  ((class-dependant 
    :initarg :class-dependant
    :initform nil
    :custom '(repeat
	  (list 
	   (regexp :tag "clef")
	   (string :tag "prologue")
	   (string :tag "épilogue")
	   ))
    :documentation "\
Liste d'association dont les éléments sont de la forme 
 (CLEF PROLOGUE ÉPILOGUE) 

Supposons que l'objet décrit le traitement de la balise TAG,
alors lorsque le code HTML `<TAG class=\"CLEF\">CONTENU</TAG>'
est rencontré, alors il est convertie en le code Texinfo
`PROLOGUE TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU.")
   (preamble
    :initarg :preamble
    :type string
    :documentation "\
Prologue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (postamble
    :initarg :postamble
    :type string
    :documentation "\
Épilogue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   )
  :documentation "\
Un object de type `html2texi-simple-markup'
décrit le traitement d'une balise simple comme par exemple
<code>.")

(defmethod html2texi-handle-simple-markup 
  ((this html2texi-simple-markup) xml-expr)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe 
			(and class-attribute
			     (assoc-string (cdr class-attribute) 
					   (oref this :class-dependant))))
		      (list (oref this :preamble)
			    (oref this :postamble)))))
    (insert (car pre-post))
    (html2texi-process-xml-expr xml-expr)
    (insert (cadr pre-post))))


(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-i-simple-markup
  (html2texi-simple-markup "html2texi-i-simple-markup"
   :preamble "@emph{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-b-simple-markup
  (html2texi-simple-markup "html2texi-b-simple-markup"
   :preamble "@strong{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-kbd-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :preamble "@kbd{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-dfn-simple-markup
  (html2texi-simple-markup "html2texi-dfn-simple-markup"
   :preamble "@dfn{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-samp-simple-markup
  (html2texi-simple-markup "html2texi-samp-simple-markup"
   :preamble "@samp{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<samp class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-handle-two-columns-table-as-@table
  t
 "Si `nil' alors une table `<table>...</table>'
avec deux colonne sera gérée en texinfo par une `@table', si non
`nil', alors elle sera gérée par une `@multitable'."
  :type
  '(choice
    (const :tag "t pour @table" t)
    (const :tag "nil pour @multitable" nil))
  :group 'html2texi)


(defvar html2texi-document-information nil
  "Liste d'association pour mémoriser les informations (titre,
  auteurs, etc...) propres à un document.")

(defvar html2texi-xml-parsed nil
  "Résultat de l'analyse syntaxique d'un doc")

(defvar html2texi-xml-stack nil
  "Pile des expressions XML")

(defvar html2texi-keep-empty-strings nil
  "Non nil si les chaînes vides sont à conserver.")

(defvar html2texi-ignore-head nil
  "Non nil si on ignore le <head> (dans un fichier HTML lié).")

(defvar html2texi-directory-stack nil
  "Pile des chemins de répertoire.")

(defvar html2texi-files-doing-or-done nil
  "Liste des fichiers déjà traité, ou le fichier en cours de traitement.")

(defvar html2texi-files-to-do nil
  "Liste des fichiers non encore traité")

(defvar html2texi-directory-ref nil
  "Répertoire de référence")

(defmacro html2texi-make-simple-markup-handler (tag)
  `(defun ,(intern (concat "html2texi-tag-handler-" (symbol-name tag)))
     (xml-expr)
     (html2texi-handle-simple-markup  
      ,(intern (concat "html2texi-"  (symbol-name tag) "-simple-markup")) 
      xml-expr) ))

(defun html2texi-make-html-clean-xml (beg end)
  (let  ((end-arg end)
	 end)
    (if (markerp end-arg)
	(setq end end-arg)
      (goto-char end-arg)
      (setq end (point-marker)))
    ;; rend les balise implicitement auto-closante vraiment auto-closante
    (goto-char beg)
   (while (re-search-forward (concat "<\\(" html2texi-suspicious-html-tags-re "\\)\\>")
			      end t)
      (let ((tag (match-string-no-properties 1)))
	(unless (re-search-forward ">" nil t)
	  (error "Clôture non trouvé pour la balise %s" tag))
	(when (null (looking-back "/>"))
	  (backward-char)
	  (insert "/")
	  (forward-char))))
    ;; marque de paragraph et de ligne
    (goto-char beg)
    (let (tag-stack p1 tag is-closure self-closing)
      (while (re-search-forward "<\\(/\\)?\\([a-zA-Z]+\\)\\>" end t)
	(setq p1 (match-beginning 0)
	      tag (match-string-no-properties 2)
	      is-closure (match-string-no-properties 1))
	(unless (string= tag (downcase tag))
	  (replace-match (setq tag (downcase tag)) 2))
	(unless (re-search-forward ">" end t)
	  (error "`Soufflet de clôture non trouvé pour la balise %s" tag))
	(setq self-closing (looking-back "/>"))
	(cond
	 ((and self-closing  is-closure)
	  (error "balise %s à la fois de clôture et auto-closante" tag))

	 (self-closing
	  ;; do nothing
	  )

	 ((null is-closure)
	  (when (and
		 (string-match (concat "\\`" html2texi-non-recursive-tags-re "\\'") tag)
		 tag-stack
		 (string= tag (caar tag-stack)))
	    ;; clôture
	    (save-excursion
	      (goto-char p1)
	      (insert "</" tag "><!-- HTML2TEXI: repaired (1) -->"))
	    (pop tag-stack))
	  (push (list tag) tag-stack))

	 (is-closure
	      (if (and tag-stack
		       (string= (caar tag-stack) tag))
		  (pop tag-stack)
		(let ((first (assoc-string tag tag-stack)) rev)
		  (if first
		      (progn
			(while (and tag-stack (null (eq (car tag-stack) first)))
			  (push (pop tag-stack) rev))
			(pop tag-stack)
			(save-excursion
			  (goto-char p1)
			  (debug)
			  (dolist (c rev)
			    (insert  "</" (car c) "><!-- HTML2TEXI: repaired (2) -->" ))))
		    (error "Clôture de %s ne correspondant à aucune ouverture" tag)))))))

       
      (let (p-pos li-pos markup poss pos)
	(while (re-search-forward "<\\(/\\)?\\(p\\|li\\)\\>[^>]*>" end t)
	  (setq markup (match-string-no-properties 2)
		poss (intern (concat markup "-pos"))
		pos (symbol-value poss))
	  (if (match-string-no-properties 1)
	      (if  pos 
		  (if (= pos (match-beginning 0))
		      (set poss nil)
		    (error "Clôture de balise %s ne correspondant à aucune ouverture" (match-string-no-properties 0)))
		(save-excursion
		  (save-match-data
		    (unless  (re-search-forward 
			      (format "<\\(/\\)?\\(%s\\)\\>[^>]+>" markup) 
			      end t)
		      (error "Ouverture de balise <%s> sans clôture" markup))
		    (set poss (match-beginning 0))
		    (unless (match-string-no-properties 1)
		      (goto-char (match-beginning 0))
		      (insert (format "</%s>" markup))
		      (dolist (symb '(p-pos li-pos))
			(unless (or (null (symbol-value symb))
				 (eq symb poss))
			  (set symb (+ (length markup) 3 (symbol-value symb)))))))))))
	    ))
    ;; mise entre guillemets anglais des attributs entier sans guillemets
    (goto-char beg)
    (let (p1 p2 added-dquote-attributes p-start)
      ;; tant qu'on trouve potentiellement un attribut sans "..."
      (while (re-search-forward "\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([0-9]+\\)"
				nil end)
	(setq p1 (match-beginning 1)
	      p2 (match-end 0))
	(if
	    ;; si la position est bien entre < et >
	    (and (re-search-backward "[<>]" nil beg)
		 (string= (match-string-no-properties 0) "<")
		 (looking-at "<\\sw+")
		 (progn 
		   (goto-char (setq p-start (match-end 0)))
		   (re-search-forward "[<>]" nil beg)
		   (string= (match-string-no-properties 0) ">"))
		 (>= (point) p1))
	    ;; alors on fait la réparation
	    (progn
	      (goto-char p-start)
	      (while 
		  (progn
		    (while (looking-at "\\(?:\\s-\\|\n\\)*\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\"[^\"]*\"")
		      (goto-char (match-end 0)))
		    (cond
		     ((looking-at  "\\(?:\\s-\\|\n\\)*\\(\\sw+\\)\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([0-9]+\\)")
		      (push (match-string-no-properties 1) added-dquote-attributes)
		      (goto-char (match-beginning 2))
		      (insert ?\")
		      (goto-char (1+ (match-end 2)))
		      (insert ?\"))
		     ((looking-at "\\(?:\\s-\\|\n\\)*>") 
		      (goto-char (match-end 0))
		      (insert "<!-- HTML2TEXI inserted double quotes around values for attibutes" 
			      (mapconcat (lambda (x) (concat "`" x "'"))
					 added-dquote-attributes
					 ", ")
			      ">")
		      (debug)
		      nil)
		     (t (error "Attribut au format invalide: %s"
			       (match-substring-no-properties (point)
							      (+ p2 
								 (* 2 (length added-dquote-attributes))))))))))
	  ;; sinon on continue à chercher un attribut potentiel dont la valeur
	  ;; n'est pas entre "..."
	  (goto-char p2))))


    ;; un peu de ménage...
    (unless (markerp end-arg)
      (set-marker end nil)) ))

;;;==========================================================================
;;; définition des gestionnaires de balise
;;;--------------------------------------------------------------------------

(defun html2texi-tag-handler-a (xml-expr)
  (let (name href text)
    (dolist (attrib (cadr xml-expr))
      (cond
       ((eq (car attrib) 'href)
	(setq href (cdr attrib)))
       ((eq (car attrib) 'name)
	(setq name (cdr attrib))))
      (when (and (cddr xml-expr)
		 (stringp (caddr xml-expr)))
	(setq name (caddr xml-expr))))
    (when name
      (insert "\n@anchor{" (html2texi-make-anchor name) "}\n"))
    (when href
      (html2texi-process-url href text))))

(html2texi-make-simple-markup-handler b)

(defun html2texi-tag-handler-h1 (xml-expr)
  (insert "@chapter " (hmtl2texi-to-plain-text xml-expr t) ?\n))


(defun html2texi-tag-handler-h2 (xml-expr)
  (insert "@section " (hmtl2texi-to-plain-text xml-expr t) ?\n))

(defun html2texi-tag-handler-h3 (xml-expr)
  (insert "@subsection " (hmtl2texi-to-plain-text xml-expr t) ?\n))

(defun html2texi-tag-handler-h4 (xml-expr)
  (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr t) ?\n))

(defun html2texi-tag-handler-h5 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr t) ?\n))

(defun html2texi-tag-handler-h6 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr t) ?\n))

(html2texi-make-simple-markup-handler samp)


(defun html2texi-get-col-span (xml-expr)
  ;; xml-expr is <td> or <th>
  (let ((col-span (cdr-safe (assq 'colspan (nth 1 xml-expr)))))
    (setq col-span
	  (cond
	   ((integerp 
	       (setq col-span
		     (if (stringp col-span) 
			 (string-to-number col-span)
		       col-span)))
	      col-span)
	   ((null col-span) 1)
	   (t (error "colspan invalide"))))  ))

(defvar html2texi-col-number nil)
(defvar html2texi-row-number nil)
(defvar html2texi-head-on-row-0 nil)
(defvar html2texi-col-count nil)

(defun html2texi-tag-handler-table (xml-expr)
  (let (html2texi-col-count 
	(html2texi-row-number 0)
	html2texi-head-on-row-0
	html2texi-col-number)
    (dolist (xml-expr (cddr xml-expr))
      (cond
       ((and (consp xml-expr)
	       (eq (car xml-expr) 'tr))
	  (dolist  (xml-expr (cddr xml-expr))
	    (cond
	     ((consp xml-expr)
		(if (memq  (car xml-expr) '(th td))
		      (setq html2texi-col-count
			    (+ (or html2texi-col-count 0) (html2texi-get-col-span xml-expr)))
		  (error "balise inattendu dans une table")))
	     ((stringp xml-expr)
	      (unless (string-match 
		       "\\`\\s-*\\(\n\\s-*\\)*\\'" 
		       xml-expr)
		(error "Chaîne inattendue")))
	     (t (error "Élément inattendu")))))
       ((stringp xml-expr)
	(unless (string-match 
		 "\\`\\s-*\\(\n\\s-*\\)*\\'" 
		 xml-expr)
	  (error "Chaîne inattendue")))
       (t (error "Élément inattendu"))))
    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(insert "@multitable\n")
      (insert "@table\n"))

    (html2texi-process-xml-expr xml-expr)

    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(insert "@end multitable\n")
      (insert "@end table\n"))))


(defun html2texi-tag-handler-tr (xml-expr)
  (setq html2texi-col-number 0)
  (html2texi-process-xml-expr xml-expr)
  (setq html2texi-row-number (1+ html2texi-row-number)))

(setq toto 0)
(defun html2texi-tag-handler-th (xml-expr)
  (unless (< toto 2)
    (debug)
    (setq toto (1+ toto)))
  (if   (= 0 html2texi-col-number)
      (if (and (= 0 html2texi-row-number)
	       (null html2texi-handle-two-columns-table-as-@table))
	  (progn
	    (setq html2texi-head-on-row-0 t)
	    (insert "@headitem ")
	    (html2texi-process-xml-expr xml-expr))
	(insert "@item ")
	(html2texi-process-xml-expr xml-expr))
    (when (or (> html2texi-col-count 2)
	      (null html2texi-handle-two-columns-table-as-@table))
      (insert "@tab "))
    (html2texi-process-xml-expr xml-expr)
    (unless (and  (= 0 html2texi-row-number) html2texi-head-on-row-0)
	(insert "\n")))
  (setq html2texi-col-number (1+ html2texi-col-number)))

(defun html2texi-tag-handler-td (xml-expr)
  (if (= 0 html2texi-col-number)
      (progn
	(when (and (= 0 html2texi-row-number)
	       html2texi-head-on-row-0)
	  (insert ?\n))
	(insert "@item "))
    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
      (insert "@tab ")))
  (html2texi-process-xml-expr xml-expr)
  (insert "\n")
  (setq html2texi-col-number (1+ html2texi-col-number)))


(defun html2texi-cur-dir ()
  "Détermine le répertoire courant relativement au répertoire du
HTML racine de départ. La valeur retournée se termine par une oblique `/'"
  (let ((cur-dir  (nreverse (split-string (cdar html2texi-directory-stack) "/")))
	(ref-dir  (nreverse (split-string html2texi-directory-ref "/"))))
    (unless (and (string= (car cur-dir) "")
		 (string= (car ref-dir) ""))
      (error "Format invalide de répertoire"))
    (setq cur-dir (nreverse (cdr cur-dir))
	  ref-dir (cdr ref-dir))
    (if (or (string= (car cur-dir) "")
	    (string-match "\\`[a-z]:" (car cur-dir)))
	;; cur-dir est un chemin absolu
	(progn
	  (setq ref-dir (nreverse ref-dir))
	  (while (and cur-dir ref-dir (string= (car cur-dir) (car ref-dir)))
	    (setq cur-dir (cdr cur-dir)
		  ref-dir (cdr ref-dir)))
	  (while ref-dir
	    (push ".." cur-dir)
	    (setq ref-dir (cdr ref-dir)))
	  (concat (mapconcat 'identity cur-dir "/") "/"))
      (while (and cur-dir
		  (cond
		   ((string= (car cur-dir) "..")
		    (unless ref-dir
		      (error "Chemin invalide"))
		    (setq ref-dir (cdr ref-dir)
			  cur-dir (cdr cur-dir)))
		   ((string= (car cur-dir) ".")
		    (setq cur-dir (cdr cur-dir)))
		   (t nil))))
      (dolist (e cur-dir)
	(push e ref-dir))
      (mapconcat 'identity  (nreverse (cons "" ref-dir)) "/") )))

(defun html2texi-make-anchor (name)
  (concat (html2texi-cur-dir) name))

(defun html2texi-tag-handler-body (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))


(html2texi-make-simple-markup-handler code)
(html2texi-make-simple-markup-handler i)

(defun html2texi-tag-handler-br (xml-expr)
  (insert "@*\n"))

(defun html2texi-tag-handler-div (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(html2texi-make-simple-markup-handler dfn)

(defun html2texi-tag-handler-dl (xml-expr)
  (insert "@table @asis\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "@end table\n"))

(defun html2texi-tag-handler-dt (xml-expr)
  (insert "@item ")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(defun html2texi-tag-handler-dd (xml-expr)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(defun html2texi-tag-handler-frameset (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-frame (xml-expr)
  (let (url text)
    (dolist (x (cadr xml-expr))
      (cond 
       ((eq (car x) 'src)
	(setq url (cdr x)))
       ((eq (car x) 'name)
	(setq text (cdr x)))))
    (when url
      (html2texi-process-url url text))))

(defun html2texi-simple-markup-handle (xml-expr class-alist preamble postamble)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe 
			(and class-attribute
			     (assoc-string (cdr class-attribute) class-alist)))
		      (list preamble postamble))))
    (insert (car pre-post))
   (html2texi-process-xml-expr xml-expr)
   (insert (cadr pre-post))))

(defun html2texi-tag-handler-hr (xml-expr)
  (insert "@c <hr/>\n"))

(html2texi-make-simple-markup-handler kbd)

(defun html2texi-handle-string (str)
  (let (ret (pos0 0) pos1 (len (length str)))
    (while (and 
	    (< pos0 len)
	    (setq pos1 (string-match "[{}@]" str pos0)))
      (push (substring str pos0 pos1) ret)
      (push (concat "@" (match-string 0 str)) ret)
      (setq pos0 (1+ pos1)))
    (when (< pos0 len)
      (push (substring str pos0 pos1) ret))
    (apply 'concat (nreverse ret))))


(defun html2texi-error (format-str xml-expr &rest args)
  (apply 'error (concat format-str
			"
-----------------------------------------------------------------------------
xml-expr=%S
xml-stack=%S
-----------------------------------------------------------------------------")
	 `( ,@args ,xml-expr ,html2texi-xml-stack)))

(defun html2texi-process-url (url text)
  (let* ((parsed-url (url-generic-parse-url url))
	 (file-name (expand-file-name
		     (aref parsed-url 6)
		     (caar html2texi-directory-stack))))
    (if (and (eq (aref parsed-url 0) 
		 'cl-struct-url)
	     (null (aref parsed-url 1))
	     (member (file-name-extension (aref parsed-url 6)) '("html" "htm"))
	     (file-exists-p file-name))
	(unless (member file-name html2texi-files-doing-or-done)
	  (add-to-list 'html2texi-files-to-do file-name))
      (insert "@uref{" 
	      url
	      (if text 
		  (concat "," 
			  (html2texi-string-escape text)) 
		"") 
	      "}"))))

(html2texi-make-simple-markup-handler i)

(defun html2texi-tag-handler-li (xml-expr)
  (insert "\n@item\n")
  (unless (memq (caadr html2texi-xml-stack) '(ol ul))
    (html2texi-error "<li> était inattendu" xml-expr))
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-link (xml-expr)
  )

(defun html2texi-tag-handler-ol (xml-expr)
  (insert "\n@enumerate")
   (html2texi-process-xml-expr xml-expr)
  (insert "\n@end enumerate\n"))

(defun html2texi-tag-handler-p (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(defun html2texi-tag-handler-ul (xml-expr)
  (insert "\n@itemize")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n@end itemize\n"))

(defun html2texi-tag-handler-style (xml-expr)
  )

(defun html2texi-tag-handler-meta (xml-expr)
  (unless (and (nth 1 html2texi-xml-stack) 
	       (eq (caadr html2texi-xml-stack) 'head))
    (html2texi-error "<meta> inattendu." xml-expr))
  ;; traitement du meta...
  (let* ((attribute-list (nth 1 xml-expr))
	 (name (assq 'name attribute-list))
	 (content (assq 'content attribute-list)))
    (when (and (consp name) 
	       (consp content)
	       (progn
		 (setq name (cdr name)
		       content (cdr content))
		 (stringp name))
	       (stringp content))
      (cond
       ((string= name "author")
	(html2texi-set-doc-info 'author content))
       ((string= name "language")
	(when (string-match "\\`\\([a-z]\\{2\\}\\(-[A-Z]\\{2\\}\\)?\\)\\'" content)
	  (let ((language (match-string-no-properties 1 content)))
	    (when (= (length language) 5)
	      (aset language 2 ?_))
	    (html2texi-set-doc-info 'language language))))))))

(defun html2texi-tag-handler-pre (xml-expr)
  (let ((kes html2texi-keep-empty-strings))
    (setq html2texi-keep-empty-strings t)
    (html2texi-process-xml-exp xml-expr)
    (setq html2texi-keep-empty-strings kes)))

(defun hmtl2texi-to-plain-text (xml-expr &optional one-line)
  (let (ret)
    (dolist (xml-expr (cddr xml-expr))
      (cond
       ((stringp xml-expr)
	(push xml-expr ret))
       ((consp xml-expr)
	(push xml-expr html2texi-xml-stack)
	(let ((str  (hmtl2texi-to-plain-text xml-expr ret)))
	  (and (null (string= str ""))
	       (push str ret)))
	(pop html2texi-xml-stack))
       (t (html2texi-error "Expression XML inattendue." xml-expr))))
    (setq  ret (mapconcat 'identity (nreverse ret) " "))
    (if one-line
	(mapconcat 'identity (split-string ret "\n") " ")
      ret)))
	  

(defun html2texi-tag-handler-title (xml-expr)
  (unless (and  (nth 1 html2texi-xml-stack)
		(eq  (caadr html2texi-xml-stack) 'head))
    (html2texi-error "<title> inattendu." xml-expr))
  (setq xml-expr (cddr xml-expr))
  (let ((str  (hmtl2texi-to-plain-text xml-expr)))
    (setq str (split-string str "\n")
	  str (mapconcat 'identity str " "))
    (unless (string= str "")
      (html2texi-set-doc-info 'title str))))

(defun html2texi-string-escape (str)
  (with-temp-buffer
    (insert str)
    (goto-char (point-min))
    (while (re-search-forward "[,@{}]" nil t)
      (cond 
       ((string= (match-string-no-properties 0) ",")
	(replace-match "@comma{}"))
       ((member (match-string-no-properties 0) '("@" "{" "}"))
	(replace-match (concat "@" (match-string-no-properties 0))))))
    (buffer-substring (point-min) (point-max))))

(defun html2texi-tag-handler-img (xml-expr)
  (let (filename width height alttext extension)
    (dolist (x (cadr xml-expr))
      (cond
       ((eq (car x) 'src)
	(setq filename (cdr x)))
       ((eq (car x) 'alt)
	(setq alttext (cdr x)))))
    (unless filename
      (html2texi-error "src=... était attendu" xml-expr))
    (setq extension (file-name-extension filename)
	  filename (file-name-sans-extension filename))
    (when (member extension '("png" "jpg" "jpeg" "eps" "txt"))
      (setq extension nil))
    (insert "@image{" (html2texi-string-escape (concat (html2texi-cur-dir) filename)))
    (let ((remainder (list width height alttext extension)))
	(while remainder
	  (if (let (non-empty)
		(mapc (lambda (x) (setq non-empty (or non-empty (stringp x)))) 
		      remainder)
		non-empty)
	      (insert "," (or (pop remainder) ""))
	    (insert "}")
	    (setq remainder nil); rompt la boucle (while remainder...)
	    )))))

(defun html2texi-set-doc-info (tag val)
  (let ((info (assq tag html2texi-document-information)))
    (if info
	(setcdr info val)
      (push (cons tag val) html2texi-document-information))))

(defun html2texi-tag-handler-head (xml-expr)
  (unless html2texi-ignore-head
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-ignore-head t)))

(defun html2texi-tag-handler-noframes (xml-expr)
  )

(if (boundp 'html2texi-handler-hash-table)
    (makunbound 'html2texi-handler-hash-table))
	    
(defconst html2texi-handler-hash-table
  (let ((ht (make-hash-table)))
    (dolist (v '(a b body code dfn dl dt dd i kbd li p hr div ol ul pre
    head meta title frameset frame noframes table th tr td h1 h2
    h3 h4 h5 h5 link br img samp style ))
      (puthash v (symbol-function (intern (concat "html2texi-tag-handler-" (symbol-name v))))
	       ht))
    ht)
  "Table de hashage des traitement associé à chaque balise HTML"
  )

(defun html2texi-remove-empty-strings (xml-expr)
  (setq xml-expr (cdr xml-expr))
  (save-match-data
  (while (cdr xml-expr)
    (if (and (stringp (cadr xml-expr)) 
	     (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'" (cadr xml-expr)))
	(setcdr xml-expr (cddr xml-expr))
      (setq xml-expr (cdr xml-expr))))))

(defun html2texi-process-xml-expr (xml-expr)
  (push xml-expr html2texi-xml-stack)
  (dolist (xml-expr (cddr xml-expr))
    (cond
     ((consp xml-expr)
      (push xml-expr html2texi-xml-stack)
      (let ((handler (gethash (intern (downcase (symbol-name (car xml-expr))))
			      html2texi-handler-hash-table)))
	(if handler
	    (funcall handler  xml-expr)
	  (html2texi-default-handling xml-expr)))
      (pop html2texi-xml-stack))
     ((stringp xml-expr)
      (and (or html2texi-keep-empty-strings
	       (null (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'"  xml-expr)))
	   (insert (html2texi-handle-string xml-expr))))
     (t (error "Expression XML inattendue %S" xml-expr))))
  (pop html2texi-xml-stack))

(defun html2texi-default-handling (xml-expr)
  (let ((str (split-string (prin1-to-string xml-expr) "\n")))
    (dolist (str-line str)
      (insert "\n@c " str-line)))
    (insert "\n"))

(defun html2texi-process-region (beg end)
  (goto-char end)
  (let ((end (point-marker)) 
	xml-expr)

    ;; Suppression de tout ce qui est en dehors des balise <html> ... </html>
    (goto-char beg)
    (unless (re-search-forward "<html" end t)
      (error "Balise <html> non trouvée"))
    (delete-region beg (match-beginning 0))
    (unless (re-search-forward ">" end t)
      (error "Clôture de la balise <html> trouvéee"))
    (unless  (re-search-forward "</html" end t)
      (error "Balise </html> non trouvée trouvée"))
    (unless (re-search-forward ">" end t)
      (error "Clôture de la balise </html> trouvée"))
    (delete-region (match-end 0) end)
    
    (html2texi-make-html-clean-xml beg end)
    
    (setq xml-expr (xml-parse-region (point-min) (point-max)))
    (delete-region beg end)
    (set-marker end nil)
    xml-expr))

(defun html2texi-make-texi-buffer (&optional buffer )
  (let* ((start-buffer (or buffer (current-buffer)))
	 xml-expr
	 (start-filename  (or (buffer-file-name start-buffer) (buffer-name)))
	 (start-filename-ext (file-name-extension start-filename))
	 (texi-buffer-name 
	  (concat (concat  (file-name-sans-extension   (file-name-nondirectory start-filename)) 
			    ".texi")))
	 done-links-list
	 texi-buffer)
    (unless (or (member start-filename-ext '("html" "htm"))
		(y-or-n-p (format "le tampon %s n'a pas une extension html, continuer?"
				  start-filename)))
      (error "Fichier sans extension html"))
    (setq texi-buffer (get-buffer-create texi-buffer-name))
    (set-buffer texi-buffer)
    (erase-buffer)
    (insert (with-current-buffer start-buffer
	      (save-restriction
		(widen)
		(buffer-substring (point-min) (point-max)))))
    
    ;; collections des informations
    (dolist (var '(html2texi-document-information 
		   html2texi-keep-empty-strings
		   html2texi-xml-parsed 
		   html2texi-xml-stack 
		   html2texi-ignore-head
		   html2texi-directory-stack
		   html2texi-directory-ref
		   html2texi-files-doing-or-done
		   html2texi-files-to-do))
      (set (make-local-variable var) nil))
    (push (cons default-directory "./") html2texi-directory-stack)
    (setq html2texi-directory-ref default-directory)

    (setq xml-expr (html2texi-process-region (point-min) (point-max)))
    (unless (eq 'html (caar xml-expr))
      (error "Résultat d'analyse XML inattendu"))
    (setq xml-expr (car xml-expr))
    (html2texi-process-xml-expr xml-expr)
    (while html2texi-files-to-do
      (setq file-name (pop html2texi-files-to-do))
      (push file-name html2texi-files-doing-or-done) 
      (let* ((dir (file-name-as-directory
		   (file-name-directory file-name)))
	     (rel-dir   (let ((d
			       (file-name-directory
				(file-relative-name file-name html2texi-directory-ref))))
			  (if d (file-name-as-directory d)
			    "./"))))
	(push (cons dir rel-dir) html2texi-directory-stack)
	(;with-temp-buffer
	 with-current-buffer (get-buffer-create "*xxxx*") (erase-buffer)
	  (insert-file-contents file-name)
	  (html2texi-make-html-clean-xml (point-min) (point-max))
	  (setq xml-expr (html2texi-process-region (point-min) (point-max))))
	(unless (eq 'html (caar xml-expr))
	  (error "Résultat d'analyse XML inattendu"))
	(setq xml-expr (car xml-expr))
	(html2texi-process-xml-expr xml-expr)
	(pop html2texi-directory-stack)	))))

(defun html2texi-insert-doc-info ()
  (let ((author 
	 (html2texi-string-escape 
	  (or (cdr-safe (assq 'author html2texi-document-information)) "AUTHOR")))
	(title 	 (html2texi-string-escape 
		  (or (cdr-safe (assq 'title html2texi-document-information)) "TITLE")))
	(language 	 (html2texi-string-escape 
			  (or (cdr-safe (assq 'language html2texi-document-information)) "LANGUAGE"))))
    
    (goto-char (point-min))
    (insert "\\input texinfo   @c -*-texinfo-*-
@setfilename " (file-name-sans-extension (buffer-name)) ".info
@documentlanguage " language "
@copying
This manual is for PROGRAM, version VERSION.

Copyright @copyright{} YEARS COPYRIGHT-OWNER.

@quotation
Permission is granted to ...
@end quotation
@end copying

@titlepage
@title " title "@c NAME-OF-MANUAL-WHEN-PRINTED
@c @subtitle SUBTITLE-IF-ANY
@c @subtitle SECOND-SUBTITLE
@author " author "

@c  The following two commands
@c  start the copyright page.
@page
@vskip 0pt plus 1filll
@insertcopying

Published by ...
@end titlepage

@c So the toc is printed at the start.
@contents

@ifnottex
@node Top
@top TITLE

This manual is for PROGRAM, version VERSION.
@end ifnottex
")
    (goto-char (point-max))
    (insert "
@bye") ))

(defun html2texi-post-process ()
  "Remplace les double lignes vides en ligne vides simples."
  (goto-char (point-min))
  (while (re-search-forward "\\(^[ \t]*\n\\)\\{2,\\}" nil t)
    (replace-match "\n")))

(defun html2texi ()
  (interactive)
  (html2texi-make-texi-buffer)
;;  (html2texi-tag-convert)
  (html2texi-insert-doc-info)
  (html2texi-post-process))

;;; html-to-texinfo.el ends here


Revision-number: 5
Prop-content-length: 232
Content-length: 232

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2011-04-18T06:44:19.000000Z
K 7
svn:log
V 129
Suppression de l'ancienne implémentation --- ne reposant pas sur le xml-file-parse.
Amélioration du traitement des tables.

PROPS-END

Node-path: trunk/lisp/html-to-texinfo.el
Node-kind: file
Node-action: change
Text-content-length: 35044
Text-content-md5: 7cfa095f3af42f6201fd3c46c164a3ab
Content-length: 35044

;;; html-to-texinfo.el --- -*- coding: iso-8859-1-unix -*-

;; Copyright 2010, 2011 Vincent Belaïche
;;
;; Author: Vincent Belaïche <vincent.b.1@hotmail.fr>
;; Version: $Id: html-to-texinfo.el,v 1.3 2011-04-18 06:44:19 Vincent Exp $
;; Keywords: 
;; X-URL: not distributed yet

;; 
;; This software is governed by the CeCILL license under French law and
;; abiding by the rules of distribution of free software.  You can  use, 
;; modify and/ or redistribute the software under the terms of the CeCILL
;; license as circulated by CEA, CNRS and INRIA at the following URL
;; "http://www.cecill.info". 
;; 
;; As a counterpart to the access to the source code and  rights to copy,
;; modify and redistribute granted by the license, users are provided only
;; with a limited warranty  and the software's author,  the holder of the
;; economic rights,  and the successive licensors  have only  limited
;; liability. 
;; 
;; In this respect, the user's attention is drawn to the risks associated
;; with loading,  using,  modifying and/or developing or reproducing the
;; software by the user in light of its specific status of free software,
;; that may mean  that it is complicated to manipulate,  and  that  also
;; therefore means  that it is reserved for developers  and  experienced
;; professionals having in-depth computer knowledge. Users are therefore
;; encouraged to load and test the software's suitability as regards their
;; requirements in conditions enabling the security of their systems and/or 
;; data to be ensured and,  more generally, to use and operate it in the 
;; same conditions as regards security. 
;; 
;; The fact that you are presently reading this means that you have had
;; knowledge of the CeCILL license and that you accept its terms.
;; 
;;; Commentary:

;; 

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'html-to-texinfo)

;;; Code:

(provide 'html-to-texinfo)
(eval-when-compile
  (require 'cl))
(require 'eieio)


;;;;##########################################################################
;;;;  User Options, Variables
;;;;##########################################################################

(defconst html2texi-suspicious-html-tags
  '("meta" "br" "hr" "link" "img" "frame")
"Liste des balises pour lesquelles le HTML ne suit pas une
syntaxe strictement XML. Par exemple `<br>' est utilisé au lieu
de `<br/>'."  )

(defconst html2texi-suspicious-html-tags-re
  (regexp-opt html2texi-suspicious-html-tags))

(defconst html2texi-non-recursive-tags
  '("p" "li"))

(defconst html2texi-non-recursive-tags-re
  (regexp-opt html2texi-non-recursive-tags))


(defclass html2texi-simple-markup ()
  ((class-dependant 
    :initarg :class-dependant
    :initform nil
    :custom '(repeat
	  (list 
	   (regexp :tag "clef")
	   (string :tag "prologue")
	   (string :tag "épilogue")
	   ))
    :documentation "\
Liste d'association dont les éléments sont de la forme 
 (CLEF PROLOGUE ÉPILOGUE) 

Supposons que l'objet décrit le traitement de la balise TAG,
alors lorsque le code HTML `<TAG class=\"CLEF\">CONTENU</TAG>'
est rencontré, alors il est convertie en le code Texinfo
`PROLOGUE TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU.")
   (preamble
    :initarg :preamble
    :type string
    :documentation "\
Prologue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (postamble
    :initarg :postamble
    :type string
    :documentation "\
Épilogue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   )
  :documentation "\
Un object de type `html2texi-simple-markup'
décrit le traitement d'une balise simple comme par exemple
<code>.")

(defmethod html2texi-handle-simple-markup 
  ((this html2texi-simple-markup) xml-expr)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe 
			(and class-attribute
			     (assoc-string (cdr class-attribute) 
					   (oref this :class-dependant))))
		      (list (oref this :preamble)
			    (oref this :postamble)))))
    (insert (car pre-post))
    (html2texi-process-xml-expr xml-expr)
    (insert (cadr pre-post))))


(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-i-simple-markup
  (html2texi-simple-markup "html2texi-i-simple-markup"
   :preamble "@emph{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-b-simple-markup
  (html2texi-simple-markup "html2texi-b-simple-markup"
   :preamble "@strong{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-kbd-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :preamble "@kbd{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-dfn-simple-markup
  (html2texi-simple-markup "html2texi-dfn-simple-markup"
   :preamble "@dfn{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-samp-simple-markup
  (html2texi-simple-markup "html2texi-samp-simple-markup"
   :preamble "@samp{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<samp class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-handle-two-columns-table-as-@table
  t
 "Si `nil' alors une table `<table>...</table>'
avec deux colonne sera gérée en texinfo par une `@table', si non
`nil', alors elle sera gérée par une `@multitable'."
  :type
  '(choice
    (const :tag "t pour @table" t)
    (const :tag "nil pour @multitable" nil))
  :group 'html2texi)


(defvar html2texi-document-information nil
  "Liste d'association pour mémoriser les informations (titre,
  auteurs, etc...) propres à un document.")

(defvar html2texi-xml-parsed nil
  "Résultat de l'analyse syntaxique d'un doc")

(defvar html2texi-xml-stack nil
  "Pile des expressions XML")

(defvar html2texi-keep-empty-strings nil
  "Non nil si les chaînes vides sont à conserver.")

(defvar html2texi-ignore-head nil
  "Non nil si on ignore le <head> (dans un fichier HTML lié).")

(defvar html2texi-directory-stack nil
  "Pile des chemins de répertoire.")

(defvar html2texi-files-doing-or-done nil
  "Liste des fichiers déjà traité, ou le fichier en cours de traitement.")

(defvar html2texi-files-to-do nil
  "Liste des fichiers non encore traité")

(defvar html2texi-directory-ref nil
  "Répertoire de référence")

(defmacro html2texi-make-simple-markup-handler (tag)
  `(defun ,(intern (concat "html2texi-tag-handler-" (symbol-name tag)))
     (xml-expr)
     (html2texi-handle-simple-markup  
      ,(intern (concat "html2texi-"  (symbol-name tag) "-simple-markup")) 
      xml-expr) ))

(defun html2texi-make-html-clean-xml (beg end)
  (let  ((end-arg end)
	 end)
    (if (markerp end-arg)
	(setq end end-arg)
      (goto-char end-arg)
      (setq end (point-marker)))
    ;; rend les balise implicitement auto-closante vraiment auto-closante
    (goto-char beg)
   (while (re-search-forward (concat "<\\(" html2texi-suspicious-html-tags-re "\\)\\>")
			      end t)
      (let ((tag (match-string-no-properties 1)))
	(unless (re-search-forward ">" nil t)
	  (error "Clôture non trouvé pour la balise %s" tag))
	(when (null (looking-back "/>"))
	  (backward-char)
	  (insert "/")
	  (forward-char))))
    ;; marque de paragraph et de ligne
    (goto-char beg)
    (let (tag-stack p1 tag is-closure self-closing)
      (while (re-search-forward "<\\(/\\)?\\([a-zA-Z]+\\)\\>" end t)
	(setq p1 (match-beginning 0)
	      tag (match-string-no-properties 2)
	      is-closure (match-string-no-properties 1))
	(unless (string= tag (downcase tag))
	  (replace-match (setq tag (downcase tag)) 2))
	(unless (re-search-forward ">" end t)
	  (error "`Soufflet de clôture non trouvé pour la balise %s" tag))
	(setq self-closing (looking-back "/>"))
	(cond
	 ((and self-closing  is-closure)
	  (error "balise %s à la fois de clôture et auto-closante" tag))

	 (self-closing
	  ;; do nothing
	  )

	 ((null is-closure)
	  (when (and
		 (string-match (concat "\\`" html2texi-non-recursive-tags-re "\\'") tag)
		 tag-stack
		 (string= tag (caar tag-stack)))
	    ;; clôture
	    (save-excursion
	      (goto-char p1)
	      (insert "</" tag "><!-- HTML2TEXI: repaired (1) -->"))
	    (pop tag-stack))
	  (push (list tag) tag-stack))

	 (is-closure
	      (if (and tag-stack
		       (string= (caar tag-stack) tag))
		  (pop tag-stack)
		(let ((first (assoc-string tag tag-stack)) rev)
		  (if first
		      (progn
			(while (and tag-stack (null (eq (car tag-stack) first)))
			  (push (pop tag-stack) rev))
			(pop tag-stack)
			(save-excursion
			  (goto-char p1)
			  (debug)
			  (dolist (c rev)
			    (insert  "</" (car c) "><!-- HTML2TEXI: repaired (2) -->" ))))
		    (error "Clôture de %s ne correspondant à aucune ouverture" tag)))))))

       
      (let (p-pos li-pos markup poss pos)
	(while (re-search-forward "<\\(/\\)?\\(p\\|li\\)\\>[^>]*>" end t)
	  (setq markup (match-string-no-properties 2)
		poss (intern (concat markup "-pos"))
		pos (symbol-value poss))
	  (if (match-string-no-properties 1)
	      (if  pos 
		  (if (= pos (match-beginning 0))
		      (set poss nil)
		    (error "Clôture de balise %s ne correspondant à aucune ouverture" (match-string-no-properties 0)))
		(save-excursion
		  (save-match-data
		    (unless  (re-search-forward 
			      (format "<\\(/\\)?\\(%s\\)\\>[^>]+>" markup) 
			      end t)
		      (error "Ouverture de balise <%s> sans clôture" markup))
		    (set poss (match-beginning 0))
		    (unless (match-string-no-properties 1)
		      (goto-char (match-beginning 0))
		      (insert (format "</%s>" markup))
		      (dolist (symb '(p-pos li-pos))
			(unless (or (null (symbol-value symb))
				 (eq symb poss))
			  (set symb (+ (length markup) 3 (symbol-value symb)))))))))))
	    ))
    ;; mise entre guillemets anglais des attributs entier sans guillemets
    (goto-char beg)
    (let (p1 p2 added-dquote-attributes p-start)
      ;; tant qu'on trouve potentiellement un attribut sans "..."
      (while (re-search-forward "\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([0-9]+\\)"
				nil end)
	(setq p1 (match-beginning 1)
	      p2 (match-end 0))
	(if
	    ;; si la position est bien entre < et >
	    (and (re-search-backward "[<>]" nil beg)
		 (string= (match-string-no-properties 0) "<")
		 (looking-at "<\\sw+")
		 (progn 
		   (goto-char (setq p-start (match-end 0)))
		   (re-search-forward "[<>]" nil beg)
		   (string= (match-string-no-properties 0) ">"))
		 (>= (point) p1))
	    ;; alors on fait la réparation
	    (progn
	      (goto-char p-start)
	      (while 
		  (progn
		    (while (looking-at "\\(?:\\s-\\|\n\\)*\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\"[^\"]*\"")
		      (goto-char (match-end 0)))
		    (cond
		     ((looking-at  "\\(?:\\s-\\|\n\\)*\\(\\sw+\\)\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([0-9]+\\)")
		      (push (match-string-no-properties 1) added-dquote-attributes)
		      (goto-char (match-beginning 2))
		      (insert ?\")
		      (goto-char (1+ (match-end 2)))
		      (insert ?\"))
		     ((looking-at "\\(?:\\s-\\|\n\\)*>") 
		      (goto-char (match-end 0))
		      (insert "<!-- HTML2TEXI inserted double quotes around values for attibutes" 
			      (mapconcat (lambda (x) (concat "`" x "'"))
					 added-dquote-attributes
					 ", ")
			      ">")
		      (debug)
		      nil)
		     (t (error "Attribut au format invalide: %s"
			       (match-substring-no-properties (point)
							      (+ p2 
								 (* 2 (length added-dquote-attributes))))))))))
	  ;; sinon on continue à chercher un attribut potentiel dont la valeur
	  ;; n'est pas entre "..."
	  (goto-char p2))))


    ;; un peu de ménage...
    (unless (markerp end-arg)
      (set-marker end nil)) ))

;;;==========================================================================
;;; définition des gestionnaires de balise
;;;--------------------------------------------------------------------------

(defun html2texi-tag-handler-a (xml-expr)
  (let (name href text)
    (dolist (attrib (cadr xml-expr))
      (cond
       ((eq (car attrib) 'href)
	(setq href (cdr attrib)))
       ((eq (car attrib) 'name)
	(setq name (cdr attrib))))
      (when (and (cddr xml-expr)
		 (stringp (caddr xml-expr)))
	(setq name (caddr xml-expr))))
    (when name
      (insert "\n@anchor{" (html2texi-make-anchor name) "}\n"))
    (when href
      (html2texi-process-url href text))))

(html2texi-make-simple-markup-handler b)

(defun html2texi-tag-handler-h1 (xml-expr)
  (insert "@chapter " (hmtl2texi-to-plain-text xml-expr t) ?\n))


(defun html2texi-tag-handler-h2 (xml-expr)
  (insert "@section " (hmtl2texi-to-plain-text xml-expr t) ?\n))

(defun html2texi-tag-handler-h3 (xml-expr)
  (insert "@subsection " (hmtl2texi-to-plain-text xml-expr t) ?\n))

(defun html2texi-tag-handler-h4 (xml-expr)
  (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr t) ?\n))

(defun html2texi-tag-handler-h5 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr t) ?\n))

(defun html2texi-tag-handler-h6 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr t) ?\n))

(html2texi-make-simple-markup-handler samp)


(defun html2texi-get-col-span (xml-expr)
  ;; xml-expr is <td> or <th>
  (let ((col-span (cdr-safe (assq 'colspan (nth 1 xml-expr)))))
    (setq col-span
	  (cond
	   ((integerp 
	       (setq col-span
		     (if (stringp col-span) 
			 (string-to-number col-span)
		       col-span)))
	      col-span)
	   ((null col-span) 1)
	   (t (error "colspan invalide"))))  ))

(defvar html2texi-col-number nil)
(defvar html2texi-row-number nil)
(defvar html2texi-head-on-row-0 nil)
(defvar html2texi-col-count nil)

(defun html2texi-tag-handler-table (xml-expr)
  (let (html2texi-col-count 
	(html2texi-row-number 0)
	html2texi-head-on-row-0
	html2texi-col-number)
    (dolist (xml-expr (cddr xml-expr))
      (cond
       ((and (consp xml-expr)
	       (eq (car xml-expr) 'tr))
	  (dolist  (xml-expr (cddr xml-expr))
	    (cond
	     ((consp xml-expr)
		(if (memq  (car xml-expr) '(th td))
		      (setq html2texi-col-count
			    (+ (or html2texi-col-count 0) (html2texi-get-col-span xml-expr)))
		  (error "balise inattendu dans une table")))
	     ((stringp xml-expr)
	      (unless (string-match 
		       "\\`\\s-*\\(\n\\s-*\\)*\\'" 
		       xml-expr)
		(error "Chaîne inattendue")))
	     (t (error "Élément inattendu")))))
       ((stringp xml-expr)
	(unless (string-match 
		 "\\`\\s-*\\(\n\\s-*\\)*\\'" 
		 xml-expr)
	  (error "Chaîne inattendue")))
       (t (error "Élément inattendu"))))
    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(insert "@multitable\n")
      (insert "@table\n"))

    (html2texi-process-xml-expr xml-expr)

    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(insert "@end multitable\n")
      (insert "@end table\n"))))


(defun html2texi-tag-handler-tr (xml-expr)
  (setq html2texi-col-number 0)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n")
  (setq html2texi-row-number (1+ html2texi-row-number)))

(setq toto 0)
(defun html2texi-tag-handler-th (xml-expr)
  (unless (< toto 2)
    (debug)
    (setq toto (1+ toto)))
  (if   (= 0 html2texi-col-number)
      (if (and (= 0 html2texi-row-number)
	       (null html2texi-handle-two-columns-table-as-@table))
	  (progn
	    (setq html2texi-head-on-row-0 t)
	    (insert "@headitem ")
	    (html2texi-process-xml-expr xml-expr))
	(insert "@item ")
	(html2texi-process-xml-expr xml-expr))
    (when (or (> html2texi-col-count 2)
	      (null html2texi-handle-two-columns-table-as-@table))
      (insert "@tab "))
    (html2texi-process-xml-expr xml-expr)
    (unless (and  (= 0 html2texi-row-number) html2texi-head-on-row-0)
	(insert "\n")))
  (setq html2texi-col-number (1+ html2texi-col-number)))

(defun html2texi-tag-handler-td (xml-expr)
  (if (= 0 html2texi-col-number)
	(insert "@item ")
    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
      (insert "@tab ")))
  (html2texi-process-xml-expr xml-expr)
  (insert "\n")
  (setq html2texi-col-number (1+ html2texi-col-number)))


(defun html2texi-cur-dir ()
  "Détermine le répertoire courant relativement au répertoire du
HTML racine de départ. La valeur retournée se termine par une oblique `/'"
  (let ((cur-dir  (nreverse (split-string (cdar html2texi-directory-stack) "/")))
	(ref-dir  (nreverse (split-string html2texi-directory-ref "/"))))
    (unless (and (string= (car cur-dir) "")
		 (string= (car ref-dir) ""))
      (error "Format invalide de répertoire"))
    (setq cur-dir (nreverse (cdr cur-dir))
	  ref-dir (cdr ref-dir))
    (if (or (string= (car cur-dir) "")
	    (string-match "\\`[a-z]:" (car cur-dir)))
	;; cur-dir est un chemin absolu
	(progn
	  (setq ref-dir (nreverse ref-dir))
	  (while (and cur-dir ref-dir (string= (car cur-dir) (car ref-dir)))
	    (setq cur-dir (cdr cur-dir)
		  ref-dir (cdr ref-dir)))
	  (while ref-dir
	    (push ".." cur-dir)
	    (setq ref-dir (cdr ref-dir)))
	  (concat (mapconcat 'identity cur-dir "/") "/"))
      (while (and cur-dir
		  (cond
		   ((string= (car cur-dir) "..")
		    (unless ref-dir
		      (error "Chemin invalide"))
		    (setq ref-dir (cdr ref-dir)
			  cur-dir (cdr cur-dir)))
		   ((string= (car cur-dir) ".")
		    (setq cur-dir (cdr cur-dir)))
		   (t nil))))
      (dolist (e cur-dir)
	(push e ref-dir))
      (mapconcat 'identity  (nreverse (cons "" ref-dir)) "/") )))

(defun html2texi-make-anchor (name)
  (concat (html2texi-cur-dir) name))

(defun html2texi-tag-handler-body (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))


(html2texi-make-simple-markup-handler code)
(html2texi-make-simple-markup-handler i)

(defun html2texi-tag-handler-br (xml-expr)
  (insert "@*\n"))

(defun html2texi-tag-handler-div (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(html2texi-make-simple-markup-handler dfn)

(defun html2texi-tag-handler-dl (xml-expr)
  (insert "@table @asis\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "@end table\n"))

(defun html2texi-tag-handler-dt (xml-expr)
  (insert "@item ")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(defun html2texi-tag-handler-dd (xml-expr)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(defun html2texi-tag-handler-frameset (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-frame (xml-expr)
  (let (url text)
    (dolist (x (cadr xml-expr))
      (cond 
       ((eq (car x) 'src)
	(setq url (cdr x)))
       ((eq (car x) 'name)
	(setq text (cdr x)))))
    (when url
      (html2texi-process-url url text))))

(defun html2texi-simple-markup-handle (xml-expr class-alist preamble postamble)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe 
			(and class-attribute
			     (assoc-string (cdr class-attribute) class-alist)))
		      (list preamble postamble))))
    (insert (car pre-post))
   (html2texi-process-xml-expr xml-expr)
   (insert (cadr pre-post))))

(defun html2texi-tag-handler-hr (xml-expr)
  (insert "@c <hr/>\n"))

(html2texi-make-simple-markup-handler kbd)

(defun html2texi-handle-string (str)
  (let (ret (pos0 0) pos1 (len (length str)))
    (while (and 
	    (< pos0 len)
	    (setq pos1 (string-match "[{}@]" str pos0)))
      (push (substring str pos0 pos1) ret)
      (push (concat "@" (match-string 0 str)) ret)
      (setq pos0 (1+ pos1)))
    (when (< pos0 len)
      (push (substring str pos0 pos1) ret))
    (apply 'concat (nreverse ret))))


(defun html2texi-error (format-str xml-expr &rest args)
  (apply 'error (concat format-str
			"
-----------------------------------------------------------------------------
xml-expr=%S
xml-stack=%S
-----------------------------------------------------------------------------")
	 `( ,@args ,xml-expr ,html2texi-xml-stack)))

(defun html2texi-process-url (url text)
  (let* ((parsed-url (url-generic-parse-url url))
	 (file-name (expand-file-name
		     (aref parsed-url 6)
		     (caar html2texi-directory-stack))))
    (if (and (eq (aref parsed-url 0) 
		 'cl-struct-url)
	     (null (aref parsed-url 1))
	     (member (file-name-extension (aref parsed-url 6)) '("html" "htm"))
	     (file-exists-p file-name))
	(unless (member file-name html2texi-files-doing-or-done)
	  (add-to-list 'html2texi-files-to-do file-name))
      (insert "@uref{" 
	      url
	      (if text 
		  (concat "," 
			  (html2texi-string-escape text)) 
		"") 
	      "}"))))

(html2texi-make-simple-markup-handler i)

(defun html2texi-tag-handler-li (xml-expr)
  (insert "\n@item\n")
  (unless (memq (caadr html2texi-xml-stack) '(ol ul))
    (html2texi-error "<li> était inattendu" xml-expr))
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-link (xml-expr)
  )

(defun html2texi-tag-handler-ol (xml-expr)
  (insert "\n@enumerate")
   (html2texi-process-xml-expr xml-expr)
  (insert "\n@end enumerate\n"))

(defun html2texi-tag-handler-p (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(defun html2texi-tag-handler-ul (xml-expr)
  (insert "\n@itemize")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n@end itemize\n"))

(defun html2texi-tag-handler-style (xml-expr)
  )

(defun html2texi-tag-handler-meta (xml-expr)
  (unless (and (nth 1 html2texi-xml-stack) 
	       (eq (caadr html2texi-xml-stack) 'head))
    (html2texi-error "<meta> inattendu." xml-expr))
  ;; traitement du meta...
  (let* ((attribute-list (nth 1 xml-expr))
	 (name (assq 'name attribute-list))
	 (content (assq 'content attribute-list)))
    (when (and (consp name) 
	       (consp content)
	       (progn
		 (setq name (cdr name)
		       content (cdr content))
		 (stringp name))
	       (stringp content))
      (cond
       ((string= name "author")
	(html2texi-set-doc-info 'author content))
       ((string= name "language")
	(when (string-match "\\`\\([a-z]\\{2\\}\\(-[A-Z]\\{2\\}\\)?\\)\\'" content)
	  (let ((language (match-string-no-properties 1 content)))
	    (when (= (length language) 5)
	      (aset language 2 ?_))
	    (html2texi-set-doc-info 'language language))))))))

(defun html2texi-tag-handler-pre (xml-expr)
  (let ((kes html2texi-keep-empty-strings))
    (setq html2texi-keep-empty-strings t)
    (html2texi-process-xml-exp xml-expr)
    (setq html2texi-keep-empty-strings kes)))

(defun hmtl2texi-to-plain-text (xml-expr &optional one-line)
  (let (ret)
    (dolist (xml-expr (cddr xml-expr))
      (cond
       ((stringp xml-expr)
	(push xml-expr ret))
       ((consp xml-expr)
	(push xml-expr html2texi-xml-stack)
	(let ((str  (hmtl2texi-to-plain-text xml-expr ret)))
	  (and (null (string= str ""))
	       (push str ret)))
	(pop html2texi-xml-stack))
       (t (html2texi-error "Expression XML inattendue." xml-expr))))
    (setq  ret (mapconcat 'identity (nreverse ret) " "))
    (if one-line
	(mapconcat 'identity (split-string ret "\n") " ")
      ret)))
	  

(defun html2texi-tag-handler-title (xml-expr)
  (unless (and  (nth 1 html2texi-xml-stack)
		(eq  (caadr html2texi-xml-stack) 'head))
    (html2texi-error "<title> inattendu." xml-expr))
  (setq xml-expr (cddr xml-expr))
  (let ((str  (hmtl2texi-to-plain-text xml-expr)))
    (setq str (split-string str "\n")
	  str (mapconcat 'identity str " "))
    (unless (string= str "")
      (html2texi-set-doc-info 'title str))))

(defun html2texi-string-escape (str)
  (with-temp-buffer
    (insert str)
    (goto-char (point-min))
    (while (re-search-forward "[,@{}]" nil t)
      (cond 
       ((string= (match-string-no-properties 0) ",")
	(replace-match "@comma{}"))
       ((member (match-string-no-properties 0) '("@" "{" "}"))
	(replace-match (concat "@" (match-string-no-properties 0))))))
    (buffer-substring (point-min) (point-max))))

(defun html2texi-tag-handler-img (xml-expr)
  (let (filename width height alttext extension)
    (dolist (x (cadr xml-expr))
      (cond
       ((eq (car x) 'src)
	(setq filename (cdr x)))
       ((eq (car x) 'alt)
	(setq alttext (cdr x)))))
    (unless filename
      (html2texi-error "src=... était attendu" xml-expr))
    (setq extension (file-name-extension filename)
	  filename (file-name-sans-extension filename))
    (when (member extension '("png" "jpg" "jpeg" "eps" "txt"))
      (setq extension nil))
    (insert "@image{" (html2texi-string-escape (concat (html2texi-cur-dir) filename)))
    (let ((remainder (list width height alttext extension)))
	(while remainder
	  (if (let (non-empty)
		(mapc (lambda (x) (setq non-empty (or non-empty (stringp x)))) 
		      remainder)
		non-empty)
	      (insert "," (or (pop remainder) ""))
	    (insert "}")
	    (setq remainder nil); rompt la boucle (while remainder...)
	    )))))

(defun html2texi-set-doc-info (tag val)
  (let ((info (assq tag html2texi-document-information)))
    (if info
	(setcdr info val)
      (push (cons tag val) html2texi-document-information))))

(defun html2texi-tag-handler-head (xml-expr)
  (unless html2texi-ignore-head
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-ignore-head t)))

(defun html2texi-tag-handler-noframes (xml-expr)
  )

(if (boundp 'html2texi-handler-hash-table)
    (makunbound 'html2texi-handler-hash-table))
	    
(defconst html2texi-handler-hash-table
  (let ((ht (make-hash-table)))
    (dolist (v '(a b body code dfn dl dt dd i kbd li p hr div ol ul pre
    head meta title frameset frame noframes table th tr td h1 h2
    h3 h4 h5 h5 link br img samp style ))
      (puthash v (symbol-function (intern (concat "html2texi-tag-handler-" (symbol-name v))))
	       ht))
    ht)
  "Table de hashage des traitement associé à chaque balise HTML"
  )

(defun html2texi-remove-empty-strings (xml-expr)
  (setq xml-expr (cdr xml-expr))
  (save-match-data
  (while (cdr xml-expr)
    (if (and (stringp (cadr xml-expr)) 
	     (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'" (cadr xml-expr)))
	(setcdr xml-expr (cddr xml-expr))
      (setq xml-expr (cdr xml-expr))))))

(defun html2texi-process-xml-expr (xml-expr)
  (push xml-expr html2texi-xml-stack)
  (dolist (xml-expr (cddr xml-expr))
    (cond
     ((consp xml-expr)
      (push xml-expr html2texi-xml-stack)
      (let ((handler (gethash (intern (downcase (symbol-name (car xml-expr))))
			      html2texi-handler-hash-table)))
	(if handler
	    (funcall handler  xml-expr)
	  (html2texi-default-handling xml-expr)))
      (pop html2texi-xml-stack))
     ((stringp xml-expr)
      (and (or html2texi-keep-empty-strings
	       (null (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'"  xml-expr)))
	   (insert (html2texi-handle-string xml-expr))))
     (t (error "Expression XML inattendue %S" xml-expr))))
  (pop html2texi-xml-stack))

(defun html2texi-default-handling (xml-expr)
  (let ((str (split-string (prin1-to-string xml-expr) "\n")))
    (dolist (str-line str)
      (insert "\n@c " str-line)))
    (insert "\n"))

(defun html2texi-process-region (beg end)
  (goto-char end)
  (let ((end (point-marker)) 
	xml-expr)

    ;; Suppression de tout ce qui est en dehors des balise <html> ... </html>
    (goto-char beg)
    (unless (re-search-forward "<html" end t)
      (error "Balise <html> non trouvée"))
    (delete-region beg (match-beginning 0))
    (unless (re-search-forward ">" end t)
      (error "Clôture de la balise <html> trouvéee"))
    (unless  (re-search-forward "</html" end t)
      (error "Balise </html> non trouvée trouvée"))
    (unless (re-search-forward ">" end t)
      (error "Clôture de la balise </html> trouvée"))
    (delete-region (match-end 0) end)
    
    (html2texi-make-html-clean-xml beg end)
    
    (setq xml-expr (xml-parse-region (point-min) (point-max)))
    (delete-region beg end)
    (set-marker end nil)
    xml-expr))

(defun html2texi-make-texi-buffer (&optional buffer )
  (let* ((start-buffer (or buffer (current-buffer)))
	 xml-expr
	 (start-filename  (or (buffer-file-name start-buffer) (buffer-name)))
	 (start-filename-ext (file-name-extension start-filename))
	 (texi-buffer-name 
	  (concat (concat  (file-name-sans-extension   (file-name-nondirectory start-filename)) 
			    ".texi")))
	 done-links-list
	 texi-buffer)
    (unless (or (member start-filename-ext '("html" "htm"))
		(y-or-n-p (format "le tampon %s n'a pas une extension html, continuer?"
				  start-filename)))
      (error "Fichier sans extension html"))
    (setq texi-buffer (get-buffer-create texi-buffer-name))
    (set-buffer texi-buffer)
    (erase-buffer)
    (insert (with-current-buffer start-buffer
	      (save-restriction
		(widen)
		(buffer-substring (point-min) (point-max)))))
    
    ;; collections des informations
    (dolist (var '(html2texi-document-information 
		   html2texi-keep-empty-strings
		   html2texi-xml-parsed 
		   html2texi-xml-stack 
		   html2texi-ignore-head
		   html2texi-directory-stack
		   html2texi-directory-ref
		   html2texi-files-doing-or-done
		   html2texi-files-to-do))
      (set (make-local-variable var) nil))
    (push (cons default-directory "./") html2texi-directory-stack)
    (setq html2texi-directory-ref default-directory)

    (setq xml-expr (html2texi-process-region (point-min) (point-max)))
    (unless (eq 'html (caar xml-expr))
      (error "Résultat d'analyse XML inattendu"))
    (setq xml-expr (car xml-expr))
    (html2texi-process-xml-expr xml-expr)
    (while html2texi-files-to-do
      (setq file-name (pop html2texi-files-to-do))
      (push file-name html2texi-files-doing-or-done) 
      (let* ((dir (file-name-as-directory
		   (file-name-directory file-name)))
	     (rel-dir   (let ((d
			       (file-name-directory
				(file-relative-name file-name html2texi-directory-ref))))
			  (if d (file-name-as-directory d)
			    "./"))))
	(push (cons dir rel-dir) html2texi-directory-stack)
	(;with-temp-buffer
	 with-current-buffer (get-buffer-create "*xxxx*") (erase-buffer)
	  (insert-file-contents file-name)
	  (html2texi-make-html-clean-xml (point-min) (point-max))
	  (setq xml-expr (html2texi-process-region (point-min) (point-max))))
	(unless (eq 'html (caar xml-expr))
	  (error "Résultat d'analyse XML inattendu"))
	(setq xml-expr (car xml-expr))
	(html2texi-process-xml-expr xml-expr)
	(pop html2texi-directory-stack)	))))

(defun html2texi-insert-doc-info ()
  (let ((author 
	 (html2texi-string-escape 
	  (or (cdr-safe (assq 'author html2texi-document-information)) "AUTHOR")))
	(title 	 (html2texi-string-escape 
		  (or (cdr-safe (assq 'title html2texi-document-information)) "TITLE")))
	(language 	 (html2texi-string-escape 
			  (or (cdr-safe (assq 'language html2texi-document-information)) "LANGUAGE"))))
    
    (goto-char (point-min))
    (insert "\\input texinfo   @c -*-texinfo-*-
@setfilename " (file-name-sans-extension (buffer-name)) ".info
@documentlanguage " language "
@copying
This manual is for PROGRAM, version VERSION.

Copyright @copyright{} YEARS COPYRIGHT-OWNER.

@quotation
Permission is granted to ...
@end quotation
@end copying

@titlepage
@title " title "@c NAME-OF-MANUAL-WHEN-PRINTED
@c @subtitle SUBTITLE-IF-ANY
@c @subtitle SECOND-SUBTITLE
@author " author "

@c  The following two commands
@c  start the copyright page.
@page
@vskip 0pt plus 1filll
@insertcopying

Published by ...
@end titlepage

@c So the toc is printed at the start.
@contents

@ifnottex
@node Top
@top TITLE

This manual is for PROGRAM, version VERSION.
@end ifnottex
")
    (goto-char (point-max))
    (insert "
@bye") ))

(defun html2texi-post-process ()
  "Remplace les double lignes vides en ligne vides simples."
  (goto-char (point-min))
  (while (re-search-forward "\\(^[ \t]*\n\\)\\{2,\\}" nil t)
    (replace-match "\n")))

(defun html2texi ()
  (interactive)
  (html2texi-make-texi-buffer)
  (html2texi-insert-doc-info)
  (html2texi-post-process))

;;; html-to-texinfo.el ends here


Revision-number: 6
Prop-content-length: 354
Content-length: 354

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2011-04-23T21:02:26.000000Z
K 7
svn:log
V 251
- @uref : échappement de l'adresse réticulaire

- @multitable : génération d'une ligne @columnfractions

- @image : clôture de la commande

- balise simple: suppression des retours chariots et espace multiple après
  retours chariot

PROPS-END

Node-path: trunk/lisp/html-to-texinfo.el
Node-kind: file
Node-action: change
Text-content-length: 37330
Text-content-md5: 00007545272d8c47915967396ba40629
Content-length: 37330

;;; html-to-texinfo.el --- -*- coding: iso-8859-1-unix -*-

;; Copyright 2010, 2011 Vincent Belaïche
;;
;; Author: Vincent Belaïche <vincent.b.1@hotmail.fr>
;; Version: $Id: html-to-texinfo.el,v 1.4 2011-04-23 21:02:26 Vincent Exp $
;; Keywords: 
;; X-URL: not distributed yet

;; 
;; This software is governed by the CeCILL license under French law and
;; abiding by the rules of distribution of free software.  You can  use, 
;; modify and/ or redistribute the software under the terms of the CeCILL
;; license as circulated by CEA, CNRS and INRIA at the following URL
;; "http://www.cecill.info". 
;; 
;; As a counterpart to the access to the source code and  rights to copy,
;; modify and redistribute granted by the license, users are provided only
;; with a limited warranty  and the software's author,  the holder of the
;; economic rights,  and the successive licensors  have only  limited
;; liability. 
;; 
;; In this respect, the user's attention is drawn to the risks associated
;; with loading,  using,  modifying and/or developing or reproducing the
;; software by the user in light of its specific status of free software,
;; that may mean  that it is complicated to manipulate,  and  that  also
;; therefore means  that it is reserved for developers  and  experienced
;; professionals having in-depth computer knowledge. Users are therefore
;; encouraged to load and test the software's suitability as regards their
;; requirements in conditions enabling the security of their systems and/or 
;; data to be ensured and,  more generally, to use and operate it in the 
;; same conditions as regards security. 
;; 
;; The fact that you are presently reading this means that you have had
;; knowledge of the CeCILL license and that you accept its terms.
;; 
;;; Commentary:

;; 

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'html-to-texinfo)

;;; Code:

(provide 'html-to-texinfo)
(eval-when-compile
  (require 'cl))
(require 'eieio)
(require 'calc-ext)


;;;;##########################################################################
;;;;  User Options, Variables
;;;;##########################################################################

(defconst html2texi-suspicious-html-tags
  '("meta" "br" "hr" "link" "img" "frame")
"Liste des balises pour lesquelles le HTML ne suit pas une
syntaxe strictement XML. Par exemple `<br>' est utilisé au lieu
de `<br/>'."  )

(defconst html2texi-suspicious-html-tags-re
  (regexp-opt html2texi-suspicious-html-tags))

(defconst html2texi-non-recursive-tags
  '("p" "li"))

(defconst html2texi-non-recursive-tags-re
  (regexp-opt html2texi-non-recursive-tags))


(defclass html2texi-simple-markup ()
  ((class-dependant 
    :initarg :class-dependant
    :initform nil
    :custom '(repeat
	  (list 
	   (regexp :tag "clef")
	   (string :tag "prologue")
	   (string :tag "épilogue")
	   (boolean :tag "conserver les espaces et retours chariot")
	   ))
    :documentation "\
Liste d'association dont les éléments sont de la forme 
 (CLEF PROLOGUE ÉPILOGUE) 

Supposons que l'objet décrit le traitement de la balise TAG,
alors lorsque le code HTML `<TAG class=\"CLEF\">CONTENU</TAG>'
est rencontré, alors il est convertie en le code Texinfo
`PROLOGUE TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU.")
   (preamble
    :initarg :preamble
    :type string
    :documentation "\
Prologue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (postamble
    :initarg :postamble
    :type string
    :documentation "\
Épilogue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (space-verb
    :initarg :space-verb
    :initform nil
    :type boolean
    :documentation "\
Vrai lorsque les espaces et retours chariot sont à conserver tels quels."
    ))
  :documentation "\
Un object de type `html2texi-simple-markup'
décrit le traitement d'une balise simple comme par exemple
<code>.")

(defun html2texi-texinfo-inside-comment-p ()
  "Renvoie non nil lorsque le point est dans un commentaire Texinfo."
  (save-match-data
    (save-excursion
      (let ((cur (point))
	    (end (progn (end-of-line) (point))))
	(beginning-of-line)
	(and (re-search-forward "\\(^\\|[^@]\\)@c\\(omment\\)\\_>" end t)
	     (<= (match-beginning 0) cur))))))

(defmethod html2texi-handle-simple-markup 
  ((this html2texi-simple-markup) xml-expr)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe 
			(and class-attribute
			     (assoc-string (cdr class-attribute) 
					   (oref this :class-dependant))))
		      (list (oref this :preamble)
			    (oref this :postamble)))))
    (insert (car pre-post))
    (let ((beg (point))
	  end)
      (html2texi-process-xml-expr xml-expr)
      (unless (oref this :space-verb)
	(setq end (point-marker))
	(goto-char beg)
	(while (re-search-forward "[\n\r]\\s-*" nil end)
	  (let ((replace-str " "))
	    (save-match-data
	      (cond
	       ((html2texi-texinfo-inside-comment-p)
		(setq replace-str nil))))
	      (and replace-str (replace-match replace-str t t)))))
	(goto-char end)
	(set-marker end nil))
    (insert (cadr pre-post))))


(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-i-simple-markup
  (html2texi-simple-markup "html2texi-i-simple-markup"
   :preamble "@emph{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-b-simple-markup
  (html2texi-simple-markup "html2texi-b-simple-markup"
   :preamble "@strong{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-kbd-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :preamble "@kbd{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-dfn-simple-markup
  (html2texi-simple-markup "html2texi-dfn-simple-markup"
   :preamble "@dfn{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-samp-simple-markup
  (html2texi-simple-markup "html2texi-samp-simple-markup"
   :preamble "@samp{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<samp class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-handle-two-columns-table-as-@table
  t
 "Si `nil' alors une table `<table>...</table>'
avec deux colonne sera gérée en texinfo par une `@table', si non
`nil', alors elle sera gérée par une `@multitable'."
  :type
  '(choice
    (const :tag "t pour @table" t)
    (const :tag "nil pour @multitable" nil))
  :group 'html2texi)


(defvar html2texi-document-information nil
  "Liste d'association pour mémoriser les informations (titre,
  auteurs, etc...) propres à un document.")

(defvar html2texi-xml-parsed nil
  "Résultat de l'analyse syntaxique d'un doc")

(defvar html2texi-xml-stack nil
  "Pile des expressions XML")

(defvar html2texi-keep-empty-strings nil
  "Non nil si les chaînes vides sont à conserver.")

(defvar html2texi-ignore-head nil
  "Non nil si on ignore le <head> (dans un fichier HTML lié).")

(defvar html2texi-directory-stack nil
  "Pile des chemins de répertoire.")

(defvar html2texi-files-doing-or-done nil
  "Liste des fichiers déjà traité, ou le fichier en cours de traitement.")

(defvar html2texi-files-to-do nil
  "Liste des fichiers non encore traité")

(defvar html2texi-directory-ref nil
  "Répertoire de référence")

(defmacro html2texi-make-simple-markup-handler (tag)
  `(defun ,(intern (concat "html2texi-tag-handler-" (symbol-name tag)))
     (xml-expr)
     (html2texi-handle-simple-markup  
      ,(intern (concat "html2texi-"  (symbol-name tag) "-simple-markup")) 
      xml-expr) ))

(defun html2texi-make-html-clean-xml (beg end)
  (let  ((end-arg end)
	 end)
    (if (markerp end-arg)
	(setq end end-arg)
      (goto-char end-arg)
      (setq end (point-marker)))
    ;; rend les balise implicitement auto-closante vraiment auto-closante
    (goto-char beg)
   (while (re-search-forward (concat "<\\(" html2texi-suspicious-html-tags-re "\\)\\>")
			      end t)
      (let ((tag (match-string-no-properties 1)))
	(unless (re-search-forward ">" nil t)
	  (error "Clôture non trouvé pour la balise %s" tag))
	(when (null (looking-back "/>"))
	  (backward-char)
	  (insert "/")
	  (forward-char))))
    ;; marque de paragraph et de ligne
    (goto-char beg)
    (let (tag-stack p1 tag is-closure self-closing)
      (while (re-search-forward "<\\(/\\)?\\([a-zA-Z]+\\)\\>" end t)
	(setq p1 (match-beginning 0)
	      tag (match-string-no-properties 2)
	      is-closure (match-string-no-properties 1))
	(unless (string= tag (downcase tag))
	  (replace-match (setq tag (downcase tag)) 2))
	(unless (re-search-forward ">" end t)
	  (error "`Soufflet de clôture non trouvé pour la balise %s" tag))
	(setq self-closing (looking-back "/>"))
	(cond
	 ((and self-closing  is-closure)
	  (error "balise %s à la fois de clôture et auto-closante" tag))

	 (self-closing
	  ;; do nothing
	  )

	 ((null is-closure)
	  (when (and
		 (string-match (concat "\\`" html2texi-non-recursive-tags-re "\\'") tag)
		 tag-stack
		 (string= tag (caar tag-stack)))
	    ;; clôture
	    (save-excursion
	      (goto-char p1)
	      (insert "</" tag "><!-- HTML2TEXI: repaired (1) -->"))
	    (pop tag-stack))
	  (push (list tag) tag-stack))

	 (is-closure
	      (if (and tag-stack
		       (string= (caar tag-stack) tag))
		  (pop tag-stack)
		(let ((first (assoc-string tag tag-stack)) rev)
		  (if first
		      (progn
			(while (and tag-stack (null (eq (car tag-stack) first)))
			  (push (pop tag-stack) rev))
			(pop tag-stack)
			(save-excursion
			  (goto-char p1)
			  (debug)
			  (dolist (c rev)
			    (insert  "</" (car c) "><!-- HTML2TEXI: repaired (2) -->" ))))
		    (error "Clôture de %s ne correspondant à aucune ouverture" tag)))))))

       
      (let (p-pos li-pos markup poss pos)
	(while (re-search-forward "<\\(/\\)?\\(p\\|li\\)\\>[^>]*>" end t)
	  (setq markup (match-string-no-properties 2)
		poss (intern (concat markup "-pos"))
		pos (symbol-value poss))
	  (if (match-string-no-properties 1)
	      (if  pos 
		  (if (= pos (match-beginning 0))
		      (set poss nil)
		    (error "Clôture de balise %s ne correspondant à aucune ouverture" (match-string-no-properties 0)))
		(save-excursion
		  (save-match-data
		    (unless  (re-search-forward 
			      (format "<\\(/\\)?\\(%s\\)\\>[^>]+>" markup) 
			      end t)
		      (error "Ouverture de balise <%s> sans clôture" markup))
		    (set poss (match-beginning 0))
		    (unless (match-string-no-properties 1)
		      (goto-char (match-beginning 0))
		      (insert (format "</%s>" markup))
		      (dolist (symb '(p-pos li-pos))
			(unless (or (null (symbol-value symb))
				 (eq symb poss))
			  (set symb (+ (length markup) 3 (symbol-value symb)))))))))))
	    ))
    ;; mise entre guillemets anglais des attributs entier sans guillemets
    (goto-char beg)
    (let (p1 p2 added-dquote-attributes p-start)
      ;; tant qu'on trouve potentiellement un attribut sans "..."
      (while (re-search-forward "\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([0-9]+\\)"
				nil end)
	(setq p1 (match-beginning 1)
	      p2 (match-end 0))
	(if
	    ;; si la position est bien entre < et >
	    (and (re-search-backward "[<>]" nil beg)
		 (string= (match-string-no-properties 0) "<")
		 (looking-at "<\\sw+")
		 (progn 
		   (goto-char (setq p-start (match-end 0)))
		   (re-search-forward "[<>]" nil beg)
		   (string= (match-string-no-properties 0) ">"))
		 (>= (point) p1))
	    ;; alors on fait la réparation
	    (progn
	      (goto-char p-start)
	      (while 
		  (progn
		    (while (looking-at "\\(?:\\s-\\|\n\\)*\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\"[^\"]*\"")
		      (goto-char (match-end 0)))
		    (cond
		     ((looking-at  "\\(?:\\s-\\|\n\\)*\\(\\sw+\\)\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([0-9]+\\)")
		      (push (match-string-no-properties 1) added-dquote-attributes)
		      (goto-char (match-beginning 2))
		      (insert ?\")
		      (goto-char (1+ (match-end 2)))
		      (insert ?\"))
		     ((looking-at "\\(?:\\s-\\|\n\\)*>") 
		      (goto-char (match-end 0))
		      (insert "<!-- HTML2TEXI inserted double quotes around values for attibutes" 
			      (mapconcat (lambda (x) (concat "`" x "'"))
					 added-dquote-attributes
					 ", ")
			      ">")
		      (debug)
		      nil)
		     (t (error "Attribut au format invalide: %s"
			       (match-substring-no-properties (point)
							      (+ p2 
								 (* 2 (length added-dquote-attributes))))))))))
	  ;; sinon on continue à chercher un attribut potentiel dont la valeur
	  ;; n'est pas entre "..."
	  (goto-char p2))))


    ;; un peu de ménage...
    (unless (markerp end-arg)
      (set-marker end nil)) ))

;;;==========================================================================
;;; définition des gestionnaires de balise
;;;--------------------------------------------------------------------------

(defun html2texi-tag-handler-a (xml-expr)
  (let (name href text)
    (dolist (attrib (cadr xml-expr))
      (cond
       ((eq (car attrib) 'href)
	(setq href (cdr attrib)))
       ((eq (car attrib) 'name)
	(setq name (cdr attrib))))
      (when (and (cddr xml-expr)
		 (stringp (caddr xml-expr)))
	(setq name (caddr xml-expr))))
    (when name
      (insert "\n@anchor{" (html2texi-make-anchor name) "}\n"))
    (when href
      (html2texi-process-url href text))))

(html2texi-make-simple-markup-handler b)

(defun html2texi-tag-handler-h1 (xml-expr)
  (insert "@chapter " (hmtl2texi-to-plain-text xml-expr t) ?\n))


(defun html2texi-tag-handler-h2 (xml-expr)
  (insert "@section " (hmtl2texi-to-plain-text xml-expr t) ?\n))

(defun html2texi-tag-handler-h3 (xml-expr)
  (insert "@subsection " (hmtl2texi-to-plain-text xml-expr t) ?\n))

(defun html2texi-tag-handler-h4 (xml-expr)
  (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr t) ?\n))

(defun html2texi-tag-handler-h5 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr t) ?\n))

(defun html2texi-tag-handler-h6 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr t) ?\n))

(html2texi-make-simple-markup-handler samp)


(defun html2texi-get-col-span (xml-expr)
  ;; xml-expr is <td> or <th>
  (let ((col-span (cdr-safe (assq 'colspan (nth 1 xml-expr)))))
    (setq col-span
	  (cond
	   ((integerp 
	       (setq col-span
		     (if (stringp col-span) 
			 (string-to-number col-span)
		       col-span)))
	      col-span)
	   ((null col-span) 1)
	   (t (error "colspan invalide"))))  ))

(defvar html2texi-col-number nil)
(defvar html2texi-row-number nil)
(defvar html2texi-head-on-row-0 nil)
(defvar html2texi-col-count nil)
(defvar html2texi-col-info-length nil)

(defun html2texi-tag-handler-table (xml-expr)
  (let* (html2texi-col-count 
	(html2texi-row-number 0)
	html2texi-head-on-row-0
	html2texi-col-number
	;; le premier élément ne correspond pas à une colonne mais servira à
	;; reduire le vecteur des informations sur chaque colonne
	(html2texi-col-info (list 0))
	(html2texi-col-info-last html2texi-col-info)
	(html2texi-col-info-length 0)
	(xml-items (cddr xml-expr)))
    (while xml-items
      (let ((xml-expr (pop xml-items)))
	(cond
	 ((and (consp xml-expr)
	       (eq (car xml-expr) 'tr))
	  ;; plus besoin de chercher une ligne: on compte les colonnes sur la
	  ;; première ligne trouvée
	  (setq xml-items nil)
	  (dolist  (xml-expr (cddr xml-expr))
	    (cond
	     ((consp xml-expr)
	      (if (memq  (car xml-expr) '(th td))
		  (progn
		    (setq html2texi-col-count
			  (+ (or html2texi-col-count 0) (html2texi-get-col-span xml-expr)))
		    (when (> html2texi-col-count html2texi-col-info-length)
		      (let ((l (make-list (- html2texi-col-count html2texi-col-info-length) '(abs 1))))
			(setcdr html2texi-col-info-last l)
			(setq html2texi-col-info-last (last l)
			      html2texi-col-info-length html2texi-col-count))))
		(error "balise inattendu dans une table")))
	     ((stringp xml-expr)
	      (unless (string-match 
		       "\\`\\s-*\\(\n\\s-*\\)*\\'" 
		       xml-expr)
		(error "Chaîne inattendue")))
	     (t (error "Élément inattendu")))))
	 ((stringp xml-expr)
	  (unless (string-match 
		   "\\`\\s-*\\(\n\\s-*\\)*\\'" 
		   xml-expr)
	    (error "Chaîne inattendue")))
	 (t (error "Élément inattendu")))))


    
    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(progn
	  (insert "@multitable @columnfractions ")
	  (let ((total-weight 
		  (math-reduce-vec 
		   (lambda (r x)
		     (+ r
			(cond 
			 ((eq (car x) 'abs) (cadr x))
			 ((eq (car x) 'rel) 
			  (setcar x 'abs)
			  (setcar (cdr x) (*  (cadr x) html2texi-col-info-length))
			  (cadr x)))))
		   (cons 'vec html2texi-col-info))))
		(insert (mapconcat 
			 (lambda (x)
			   (number-to-string
			    (/ (float (cadr x)) html2texi-col-info-length)))
			 (cdr html2texi-col-info)
			 " ")))
	  (insert "\n"))
      (insert "@table\n"))

    (html2texi-process-xml-expr xml-expr)

    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(insert "@end multitable\n")
      (insert "@end table\n"))))


(defun html2texi-tag-handler-tr (xml-expr)
  (setq html2texi-col-number 0)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n")
  (setq html2texi-row-number (1+ html2texi-row-number)))

(setq toto 0)
(defun html2texi-tag-handler-th (xml-expr)
  (unless (< toto 2)
    (debug)
    (setq toto (1+ toto)))
  (if   (= 0 html2texi-col-number)
      (if (and (= 0 html2texi-row-number)
	       (null html2texi-handle-two-columns-table-as-@table))
	  (progn
	    (setq html2texi-head-on-row-0 t)
	    (insert "@headitem ")
	    (html2texi-process-xml-expr xml-expr))
	(insert "@item ")
	(html2texi-process-xml-expr xml-expr))
    (when (or (> html2texi-col-count 2)
	      (null html2texi-handle-two-columns-table-as-@table))
      (insert "@tab "))
    (html2texi-process-xml-expr xml-expr)
    (unless (and  (= 0 html2texi-row-number) html2texi-head-on-row-0)
	(insert "\n")))
  (setq html2texi-col-number (1+ html2texi-col-number)))

(defun html2texi-tag-handler-td (xml-expr)
  (if (= 0 html2texi-col-number)
	(insert "@item ")
    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
      (insert "@tab ")))
  (html2texi-process-xml-expr xml-expr)
  (insert "\n")
  (setq html2texi-col-number (1+ html2texi-col-number)))


(defun html2texi-cur-dir ()
  "Détermine le répertoire courant relativement au répertoire du
HTML racine de départ. La valeur retournée se termine par une oblique `/'"
  (let ((cur-dir  (nreverse (split-string (cdar html2texi-directory-stack) "/")))
	(ref-dir  (nreverse (split-string html2texi-directory-ref "/"))))
    (unless (and (string= (car cur-dir) "")
		 (string= (car ref-dir) ""))
      (error "Format invalide de répertoire"))
    (setq cur-dir (nreverse (cdr cur-dir))
	  ref-dir (cdr ref-dir))
    (if (or (string= (car cur-dir) "")
	    (string-match "\\`[a-z]:" (car cur-dir)))
	;; cur-dir est un chemin absolu
	(progn
	  (setq ref-dir (nreverse ref-dir))
	  (while (and cur-dir ref-dir (string= (car cur-dir) (car ref-dir)))
	    (setq cur-dir (cdr cur-dir)
		  ref-dir (cdr ref-dir)))
	  (while ref-dir
	    (push ".." cur-dir)
	    (setq ref-dir (cdr ref-dir)))
	  (concat (mapconcat 'identity cur-dir "/") "/"))
      (while (and cur-dir
		  (cond
		   ((string= (car cur-dir) "..")
		    (unless ref-dir
		      (error "Chemin invalide"))
		    (setq ref-dir (cdr ref-dir)
			  cur-dir (cdr cur-dir)))
		   ((string= (car cur-dir) ".")
		    (setq cur-dir (cdr cur-dir)))
		   (t nil))))
      (dolist (e cur-dir)
	(push e ref-dir))
      (mapconcat 'identity  (nreverse (cons "" ref-dir)) "/") )))

(defun html2texi-make-anchor (name)
  (concat (html2texi-cur-dir) name))

(defun html2texi-tag-handler-body (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))


(html2texi-make-simple-markup-handler code)
(html2texi-make-simple-markup-handler i)

(defun html2texi-tag-handler-br (xml-expr)
  (insert "@*\n"))

(defun html2texi-tag-handler-div (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(html2texi-make-simple-markup-handler dfn)

(defun html2texi-tag-handler-dl (xml-expr)
  (insert "@table @asis\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "@end table\n"))

(defun html2texi-tag-handler-dt (xml-expr)
  (insert "@item ")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(defun html2texi-tag-handler-dd (xml-expr)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(defun html2texi-tag-handler-frameset (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-frame (xml-expr)
  (let (url text)
    (dolist (x (cadr xml-expr))
      (cond 
       ((eq (car x) 'src)
	(setq url (cdr x)))
       ((eq (car x) 'name)
	(setq text (cdr x)))))
    (when url
      (html2texi-process-url url text))))

(defun html2texi-simple-markup-handle (xml-expr class-alist preamble postamble)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe 
			(and class-attribute
			     (assoc-string (cdr class-attribute) class-alist)))
		      (list preamble postamble))))
    (insert (car pre-post))
   (html2texi-process-xml-expr xml-expr)
   (insert (cadr pre-post))))

(defun html2texi-tag-handler-hr (xml-expr)
  (insert "@c <hr/>\n"))

(html2texi-make-simple-markup-handler kbd)

(defun html2texi-handle-string (str)
  (let (ret (pos0 0) pos1 (len (length str)))
    (while (and 
	    (< pos0 len)
	    (setq pos1 (string-match "[{}@]" str pos0)))
      (push (substring str pos0 pos1) ret)
      (push (concat "@" (match-string 0 str)) ret)
      (setq pos0 (1+ pos1)))
    (when (< pos0 len)
      (push (substring str pos0 pos1) ret))
    (apply 'concat (nreverse ret))))


(defun html2texi-error (format-str xml-expr &rest args)
  (apply 'error (concat format-str
			"
-----------------------------------------------------------------------------
xml-expr=%S
xml-stack=%S
-----------------------------------------------------------------------------")
	 `( ,@args ,xml-expr ,html2texi-xml-stack)))

(defun html2texi-process-url (url text)
  (let* ((parsed-url (url-generic-parse-url url))
	 (file-name (expand-file-name
		     (aref parsed-url 6)
		     (caar html2texi-directory-stack))))
    (if (and (eq (aref parsed-url 0) 
		 'cl-struct-url)
	     (null (aref parsed-url 1))
	     (member (file-name-extension (aref parsed-url 6)) '("html" "htm"))
	     (file-exists-p file-name))
	(unless (member file-name html2texi-files-doing-or-done)
	  (add-to-list 'html2texi-files-to-do file-name))
      (insert "@uref{" 
	        (html2texi-string-escape url)
	      (if text 
		  (concat "," 
			  (html2texi-string-escape text)) 
		"") 
	      "}"))))

(html2texi-make-simple-markup-handler i)

(defun html2texi-tag-handler-li (xml-expr)
  (insert "\n@item\n")
  (unless (memq (caadr html2texi-xml-stack) '(ol ul))
    (html2texi-error "<li> était inattendu" xml-expr))
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-link (xml-expr)
  )

(defun html2texi-tag-handler-ol (xml-expr)
  (insert "\n@enumerate")
   (html2texi-process-xml-expr xml-expr)
  (insert "\n@end enumerate\n"))

(defun html2texi-tag-handler-p (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(defun html2texi-tag-handler-ul (xml-expr)
  (insert "\n@itemize")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n@end itemize\n"))

(defun html2texi-tag-handler-style (xml-expr)
  )

(defun html2texi-tag-handler-meta (xml-expr)
  (unless (and (nth 1 html2texi-xml-stack) 
	       (eq (caadr html2texi-xml-stack) 'head))
    (html2texi-error "<meta> inattendu." xml-expr))
  ;; traitement du meta...
  (let* ((attribute-list (nth 1 xml-expr))
	 (name (assq 'name attribute-list))
	 (content (assq 'content attribute-list)))
    (when (and (consp name) 
	       (consp content)
	       (progn
		 (setq name (cdr name)
		       content (cdr content))
		 (stringp name))
	       (stringp content))
      (cond
       ((string= name "author")
	(html2texi-set-doc-info 'author content))
       ((string= name "language")
	(when (string-match "\\`\\([a-z]\\{2\\}\\(-[A-Z]\\{2\\}\\)?\\)\\'" content)
	  (let ((language (match-string-no-properties 1 content)))
	    (when (= (length language) 5)
	      (aset language 2 ?_))
	    (html2texi-set-doc-info 'language language))))))))

(defun html2texi-tag-handler-pre (xml-expr)
  (let ((kes html2texi-keep-empty-strings))
    (setq html2texi-keep-empty-strings t)
    (html2texi-process-xml-exp xml-expr)
    (setq html2texi-keep-empty-strings kes)))

(defun hmtl2texi-to-plain-text (xml-expr &optional one-line)
  (let (ret)
    (dolist (xml-expr (cddr xml-expr))
      (cond
       ((stringp xml-expr)
	(push xml-expr ret))
       ((consp xml-expr)
	(push xml-expr html2texi-xml-stack)
	(let ((str  (hmtl2texi-to-plain-text xml-expr ret)))
	  (and (null (string= str ""))
	       (push str ret)))
	(pop html2texi-xml-stack))
       (t (html2texi-error "Expression XML inattendue." xml-expr))))
    (setq  ret (mapconcat 'identity (nreverse ret) " "))
    (if one-line
	(mapconcat 'identity (split-string ret "\n") " ")
      ret)))
	  

(defun html2texi-tag-handler-title (xml-expr)
  (unless (and  (nth 1 html2texi-xml-stack)
		(eq  (caadr html2texi-xml-stack) 'head))
    (html2texi-error "<title> inattendu." xml-expr))
  (setq xml-expr (cddr xml-expr))
  (let ((str  (hmtl2texi-to-plain-text xml-expr)))
    (setq str (split-string str "\n")
	  str (mapconcat 'identity str " "))
    (unless (string= str "")
      (html2texi-set-doc-info 'title str))))

(defun html2texi-string-escape (str)
  (with-temp-buffer
    (insert str)
    (goto-char (point-min))
    (while (re-search-forward "[,@{}]" nil t)
      (cond 
       ((string= (match-string-no-properties 0) ",")
	(replace-match "@comma{}"))
       ((member (match-string-no-properties 0) '("@" "{" "}"))
	(replace-match (concat "@" (match-string-no-properties 0))))))
    (buffer-substring (point-min) (point-max))))

(defun html2texi-tag-handler-img (xml-expr)
  (let (filename width height alttext extension)
    (dolist (x (cadr xml-expr))
      (cond
       ((eq (car x) 'src)
	(setq filename (cdr x)))
       ((eq (car x) 'alt)
	(setq alttext (cdr x)))))
    (unless filename
      (html2texi-error "src=... était attendu" xml-expr))
    (setq extension (file-name-extension filename)
	  filename (file-name-sans-extension filename))
    (when (member extension '("png" "jpg" "jpeg" "eps" "txt"))
      (setq extension nil))
    (insert "@image{" (html2texi-string-escape (concat (html2texi-cur-dir) filename)))
    (let ((remainder (list width height alttext extension)))
	(while remainder
	  (if (let (non-empty)
		(mapc (lambda (x) (setq non-empty (or non-empty (stringp x)))) 
		      remainder)
		non-empty)
	      (insert "," (or (pop remainder) "") )
	    (setq remainder nil); rompt la boucle (while remainder...)
	    ))
	(insert "}"))))

(defun html2texi-set-doc-info (tag val)
  (let ((info (assq tag html2texi-document-information)))
    (if info
	(setcdr info val)
      (push (cons tag val) html2texi-document-information))))

(defun html2texi-tag-handler-head (xml-expr)
  (unless html2texi-ignore-head
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-ignore-head t)))

(defun html2texi-tag-handler-noframes (xml-expr)
  )

(if (boundp 'html2texi-handler-hash-table)
    (makunbound 'html2texi-handler-hash-table))
	    
(defconst html2texi-handler-hash-table
  (let ((ht (make-hash-table)))
    (dolist (v '(a b body code dfn dl dt dd i kbd li p hr div ol ul pre
    head meta title frameset frame noframes table th tr td h1 h2
    h3 h4 h5 h5 link br img samp style ))
      (puthash v (symbol-function (intern (concat "html2texi-tag-handler-" (symbol-name v))))
	       ht))
    ht)
  "Table de hashage des traitement associé à chaque balise HTML"
  )

(defun html2texi-remove-empty-strings (xml-expr)
  (setq xml-expr (cdr xml-expr))
  (save-match-data
  (while (cdr xml-expr)
    (if (and (stringp (cadr xml-expr)) 
	     (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'" (cadr xml-expr)))
	(setcdr xml-expr (cddr xml-expr))
      (setq xml-expr (cdr xml-expr))))))

(defun html2texi-process-xml-expr (xml-expr)
  (push xml-expr html2texi-xml-stack)
  (dolist (xml-expr (cddr xml-expr))
    (cond
     ((consp xml-expr)
      (push xml-expr html2texi-xml-stack)
      (let ((handler (gethash (intern (downcase (symbol-name (car xml-expr))))
			      html2texi-handler-hash-table)))
	(if handler
	    (funcall handler  xml-expr)
	  (html2texi-default-handling xml-expr)))
      (pop html2texi-xml-stack))
     ((stringp xml-expr)
      (and (or html2texi-keep-empty-strings
	       (null (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'"  xml-expr)))
	   (insert (html2texi-handle-string xml-expr))))
     (t (error "Expression XML inattendue %S" xml-expr))))
  (pop html2texi-xml-stack))

(defun html2texi-default-handling (xml-expr)
  (let ((str (split-string (prin1-to-string xml-expr) "\n")))
    (dolist (str-line str)
      (insert "\n@c " str-line)))
    (insert "\n"))

(defun html2texi-process-region (beg end)
  (goto-char end)
  (let ((end (point-marker)) 
	xml-expr)

    ;; Suppression de tout ce qui est en dehors des balise <html> ... </html>
    (goto-char beg)
    (unless (re-search-forward "<html" end t)
      (error "Balise <html> non trouvée"))
    (delete-region beg (match-beginning 0))
    (unless (re-search-forward ">" end t)
      (error "Clôture de la balise <html> trouvéee"))
    (unless  (re-search-forward "</html" end t)
      (error "Balise </html> non trouvée trouvée"))
    (unless (re-search-forward ">" end t)
      (error "Clôture de la balise </html> trouvée"))
    (delete-region (match-end 0) end)
    
    (html2texi-make-html-clean-xml beg end)
    
    (setq xml-expr (xml-parse-region (point-min) (point-max)))
    (delete-region beg end)
    (set-marker end nil)
    xml-expr))

(defun html2texi-make-texi-buffer (&optional buffer )
  (let* ((start-buffer (or buffer (current-buffer)))
	 xml-expr
	 (start-filename  (or (buffer-file-name start-buffer) (buffer-name)))
	 (start-filename-ext (file-name-extension start-filename))
	 (texi-buffer-name 
	  (concat (concat  (file-name-sans-extension   (file-name-nondirectory start-filename)) 
			    ".texi")))
	 done-links-list
	 texi-buffer)
    (unless (or (member start-filename-ext '("html" "htm"))
		(y-or-n-p (format "le tampon %s n'a pas une extension html, continuer?"
				  start-filename)))
      (error "Fichier sans extension html"))
    (setq texi-buffer (get-buffer-create texi-buffer-name))
    (set-buffer texi-buffer)
    (erase-buffer)
    (insert (with-current-buffer start-buffer
	      (save-restriction
		(widen)
		(buffer-substring (point-min) (point-max)))))
    
    ;; collections des informations
    (dolist (var '(html2texi-document-information 
		   html2texi-keep-empty-strings
		   html2texi-xml-parsed 
		   html2texi-xml-stack 
		   html2texi-ignore-head
		   html2texi-directory-stack
		   html2texi-directory-ref
		   html2texi-files-doing-or-done
		   html2texi-files-to-do))
      (set (make-local-variable var) nil))
    (push (cons default-directory "./") html2texi-directory-stack)
    (setq html2texi-directory-ref default-directory)

    (setq xml-expr (html2texi-process-region (point-min) (point-max)))
    (unless (eq 'html (caar xml-expr))
      (error "Résultat d'analyse XML inattendu"))
    (setq xml-expr (car xml-expr))
    (html2texi-process-xml-expr xml-expr)
    (while html2texi-files-to-do
      (setq file-name (pop html2texi-files-to-do))
      (push file-name html2texi-files-doing-or-done) 
      (let* ((dir (file-name-as-directory
		   (file-name-directory file-name)))
	     (rel-dir   (let ((d
			       (file-name-directory
				(file-relative-name file-name html2texi-directory-ref))))
			  (if d (file-name-as-directory d)
			    "./"))))
	(push (cons dir rel-dir) html2texi-directory-stack)
	(;with-temp-buffer
	 with-current-buffer (get-buffer-create "*xxxx*") (erase-buffer)
	  (insert-file-contents file-name)
	  (html2texi-make-html-clean-xml (point-min) (point-max))
	  (setq xml-expr (html2texi-process-region (point-min) (point-max))))
	(unless (eq 'html (caar xml-expr))
	  (error "Résultat d'analyse XML inattendu"))
	(setq xml-expr (car xml-expr))
	(html2texi-process-xml-expr xml-expr)
	(pop html2texi-directory-stack)	))))

(defun html2texi-insert-doc-info ()
  (let ((author 
	 (html2texi-string-escape 
	  (or (cdr-safe (assq 'author html2texi-document-information)) "AUTHOR")))
	(title 	 (html2texi-string-escape 
		  (or (cdr-safe (assq 'title html2texi-document-information)) "TITLE")))
	(language 	 (html2texi-string-escape 
			  (or (cdr-safe (assq 'language html2texi-document-information)) "LANGUAGE"))))
    
    (goto-char (point-min))
    (insert "\\input texinfo   @c -*-texinfo-*-
@setfilename " (file-name-sans-extension (buffer-name)) ".info
@documentlanguage " language "
@copying
This manual is for PROGRAM, version VERSION.

Copyright @copyright{} YEARS COPYRIGHT-OWNER.

@quotation
Permission is granted to ...
@end quotation
@end copying

@titlepage
@title " title "@c NAME-OF-MANUAL-WHEN-PRINTED
@c @subtitle SUBTITLE-IF-ANY
@c @subtitle SECOND-SUBTITLE
@author " author "

@c  The following two commands
@c  start the copyright page.
@page
@vskip 0pt plus 1filll
@insertcopying

Published by ...
@end titlepage

@c So the toc is printed at the start.
@contents

@ifnottex
@node Top
@top TITLE

This manual is for PROGRAM, version VERSION.
@end ifnottex
")
    (goto-char (point-max))
    (insert "
@bye") ))

(defun html2texi-post-process ()
  "Remplace les double lignes vides en ligne vides simples."
  (goto-char (point-min))
  (while (re-search-forward "\\(^[ \t]*\n\\)\\{2,\\}" nil t)
    (replace-match "\n"))
  (normal-mode))

(defun html2texi ()
  (interactive)
  (html2texi-make-texi-buffer)
  (html2texi-insert-doc-info)
  (html2texi-post-process))

;;; html-to-texinfo.el ends here


Revision-number: 7
Prop-content-length: 114
Content-length: 114

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2011-05-02T10:47:29.000000Z
K 7
svn:log
V 12
Création

PROPS-END

Node-path: trunk/doc
Node-kind: dir
Node-action: add


Node-path: trunk/doc/html-to-texi.texi
Node-kind: file
Node-action: add
Prop-content-length: 10
Text-content-length: 3923
Text-content-md5: cfebb2512431d3e250198c50ceb2a8b3
Content-length: 3933

PROPS-END
\input texinfo   @c -*- mode: texinfo; coding: iso-8859-15-unix -*-
@c %**start of header
@setfilename html-to-texi.info
@documentencoding iso-8859-15
@documentlanguage fr
@set VERSION $Id: html-to-texi.texi,v 1.1 2011-05-02 10:47:29 Vincent Exp $
@set TEXINFO @acronym{Texinfo}
@set HTML-TO-TEXI @code{html-to-texi}
@set HTML-TO-TEXI-DOT-EL @code{html-to-texi}
@copying
Ceci est la documentation du paquetage  html-to-texi, version @value{VERSION}
Copyright @copyright{} 2011 Vincent Belaïche.

@quotation
La permission est donnée à ...
@end quotation
@end copying

@dircategory Emacs
@direntry
*  html-to-texi: (html-to-texi). Un paquetage @acronym{EMACS} pour convertir du code @acronym{HTML} en code @value{TEXINFO}.
@end direntry

@titlepage
@title @value{HTML-TO-TEXI}@comma{} un convertisseur de @acronym{HTML} en @value{TEXINFO}
@c @subtitle 
@author Vincent Belaïche

@c  The following two commands
@c  start the copyright page.
@page
@vskip 0pt plus 1filll
@insertcopying

Publié par ...
@end titlepage

@ifnottex
@c  --------------------------------------------------------------------------------
@node Top,,,(dir)top
@top N½ud chapeau.

Ceci est le manuel du paquetage html-to-texi d'Emacs.
@end ifnottex

@menu
* Vue d'ensemble:: Vue d'ensemble.
* Installation:: Comment installer le paquetage html-to-texi.
* Les Bases:: html-to-texi pour le débutant.
* Expérimenté:: html-to-texi pour l'utilisateur expérimenté.
* Indexes:: Indexes des concepts, commandes, et variables.
* Quoi d'neuf:: Ce qui est nouveau pour le paquetage html-to-texi.
* Remerciements:: .
@end menu

@node Vue d'ensemble, Installation,,                 Top
@chapter Vue d'ensemble

@value{HTML-TO-TEXI} permet de convertir un document @acronym{HTML} en un
document @value{TEXINFO}. Pour l'utiliser on procède comme cela :@*

@enumerate
@item
Lancer @acronym{EMACS}.
@item
Ouvrir dans @acronym{EMACS} le fichier @acronym{HTML} chapeau du
document @acronym{HTML}, ce fichier se nomme en général
@file{index.html}, ce que l'on suppose par la suite, et est la racine de
l'arbre des fichier @acronym{HTML} constitutif du document
@acronym{HTML} à convertir. Il se peut aussi que votre document
@acronym{HTML} ne soit constitué que d'un seul fichier pour tout le
document, dans ce cas c'est celui-ci qu'il faut ouvrir.
@item
S'assurer que le paquetage @value{HTML-TO-TEXI-DOT-EL} est chargé. Ceci
peut être déjà fait si le chargement est effectué automatiquement au
lancement d'@acronym{EMACS} ou à l'ouverture d'un fichier
@acronym{HTML}. Pour cela vous devez configurer convenablement votre
fichier d'init (@pxref{AutoLoad}).
@item
Alors que sous @acronym{EMACS} le tampon courant est @file{index.html},
lancer la commande @code{M-x html-to-texi}, cela créer un tampon
@file{index.texi} contenant le code @value{TEXINFO} résultant de la
conversion. Attention : si le tampon @file{index.texi} existait déjà,
alors il est effacé.
@item
Enregistrer le tampon @file{index.texi} en un fichier à votre
convenance.
@end enumerate


@node Installation,   Les Bases,     Vue d'ensemble, Top 
@chapter Comment installer le paquetage html-to-texi

@node Les Bases,      Expérimenté,   Installation,   Top 
@chapter  html-to-texi pour le débutant

@node Expérimenté, Indexes, Les Bases, Top
@chapter html-to-texi pour l'utilisateur expérimenté

@menu
* AutoLoad:: Charger automatiquement @value{HTML-TO-TEXI-DOT-EL}
@end menu

@node AutoLoad, , , Expérimenté
@comment  node-name,  next,  previous,  up
@section Charger automatiquement @value{HTML-TO-TEXI-DOT-EL}

@node Indexes,        Quoi d'neuf,   Expérimenté,    Top 
@chapter Indexes des concepts, commandes, et variables

@node Quoi d'neuf,    Remerciements, Indexes,        Top 
@chapter  Ce qui est nouveau pour le paquetage html-to-texi

@node Remerciements,,                Quoi d'neuf,    Top 
@chapter Remerciements



@bye



@c Local Variables: 
@c mode: texinfo
@c TeX-master: t
@c End: 


Revision-number: 8
Prop-content-length: 115
Content-length: 115

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2011-05-07T20:31:28.000000Z
K 7
svn:log
V 13
Création.

PROPS-END

Node-path: trunk/lisp/accents-dur-tex-html.el
Node-kind: file
Node-action: add
Prop-content-length: 10
Text-content-length: 15710
Text-content-md5: c29be0602e4b1cd26c8f04809c8fb9e9
Content-length: 15720

PROPS-END
;; -*- coding: utf-8 -*-
;; Copyright 2008 Vincent Belaïche
;; accents-tex : change les caractères accentués en accents tex
;; conserve les majuscules, sans demander confirmation.
;;
;; accents-de-tex : change les accents tex en caracteres accentués sans
;; demander confirmation.  les majuscules sont respectees.
;;
;; Ce logiciel est libre : vous pouvez le redistribuer et/ou le modifier
;; sous les termes de la licence CECILL disponible sous http://www.cecill.info/ 
;;

(require 'eieio)

(dolist (v '(accents-convertisseur-cache
	     accents-convertisseur-le-cache
	     accents-convertisseur-base
	     accents-convertisseur-simple
	     accents-convertisseur-inverse
	     accents-convertisseur-html
	     accents-convertisseur-de-html))
  (makunbound v))

(defclass accents-convertisseur-cache ()
  ((table-de-hashage
    :initarg :table-de-hashage)
   (expression-rationnelle
    :initarg :expression-rationnelle
    :documentation "Expression rationnelle s'accordant aux
    lettres accentuées à remplacer.")
   (id-convertisseur
    :initarg :id-convertisseur
    :initform nil
    :type symbol)
   (lecteur-clef
    :initarg :lecteur-clef
    :initform nil))
  "C'est la classe qui fait le boulot effectif de remplacement.")

(defvar accents-convertisseur-le-cache
  (make-instance 'accents-convertisseur-cache
		 :table-de-hashage (make-hash-table :test 'equal)))

(defmethod accents-conversion 
  ((this accents-convertisseur-cache) &optional beg end)
  (save-excursion
    (goto-char (or beg (point-min)))
    (setq end (if end 
		  (let ((m (make-marker))) 
		    (prog1 m 
		      (set-maker m end)))))
    (save-match-data
      (let ((case-fold-search nil)
	    (table-de-hashage (oref this :table-de-hashage))
	    (expression-rationnelle (oref this :expression-rationnelle))
	    (lecteur-clef (or (oref this :lecteur-clef) 
			      (function (lambda () (match-string-no-properties 0))))))

	(while (re-search-forward expression-rationnelle end t)
	  (let ((replacement  
		 (gethash  (funcall lecteur-clef)
		  table-de-hashage)))
	    (and replacement
		 (replace-match replacement t t)))))))
  (when end 
    (set-marker end nil)))

(defclass accents-convertisseur-base ()
  ((cache
    :allocation :class
    :documentation "État en cache du convertisseur"))
  "Classe de base pour un convertisseur"  )
(oset-default accents-convertisseur-base cache 
	      accents-convertisseur-le-cache)

(defclass accents-convertisseur-simple 
  (accents-convertisseur-base)
  ((id
    :initarg :id
    :documentation "Symbole d'itentification unique pour le
    cache.")
   (liste-de-remplacement
    :initarg :liste-de-remplacement
    :documentation "Liste d'association") )
  "")

(defmacro accents-definir-conversion
  (CLASS CAR CDR &optional LECTEUR-CLEF)
  `(defmethod accents-conversion 
     ((this ,CLASS) &optional beg end)

     (let ((cache (oref this cache))
	   (id (oref this :id)))
       (unless (eq (oref cache :id-convertisseur)
		   id)
	 (oset cache :id-convertisseur ,LECTEUR-CLEF)
	 (oset cache :lecteur-clef nil)
	 (let ((table-de-hashage (oref cache :table-de-hashage))
	       (liste-de-remplacement (oref this :liste-de-remplacement)))
	   (clrhash table-de-hashage)
	   (dolist (k liste-de-remplacement)
	     (puthash (,CAR k) (,CDR k) table-de-hashage))
	   (oset cache :expression-rationnelle
		 (regexp-opt (mapcar (quote ,CAR) liste-de-remplacement)))))
       (accents-conversion cache beg end))))

(accents-definir-conversion accents-convertisseur-simple car cdr)

(defclass accents-convertisseur-inverse
  (accents-convertisseur-simple)
  ()
  "Convertisseur pour effectuer la conversion inverse vis-à-vis
  de la liste de remplacement.")

(accents-definir-conversion accents-convertisseur-inverse cdr car)

(defun accents-moteur (liste-des-remplacements &optional convert-to-re)
  (save-excursion
	(save-match-data
	  (let ((case-fold-search nil)
		(re (if convert-to-re 
			(mapconcat 'identity 
				   (mapcar 'car liste-des-remplacements)
				   "\\|")
		      (regexp-opt  (mapcar 'car liste-des-remplacements)))))
	    (goto-char (point-min))
	    (while (re-search-forward re nil t)
	      (replace-match
	       (cdr 
		(if convert-to-re
		    (assoc-default (match-string 0) liste-des-remplacements 'string-match)
		  (assoc-string (match-string 0) liste-des-remplacements)))
	       t; fixed case
	       t; literal
	       ))))))

(defconst accents-converstisseur-tex
  (make-instance 
   'accents-convertisseur-simple
   :id 'accents-converstisseur-tex
   :liste-de-remplacement 
   '(("\�" . "\\'A")
     ("\À" . "\\`A")
     ("\Â" . "\\^A")
     ("\Ä" .  "\\\"A")
     ("\É" . "\\'E")
     ("\È" . "\\`E")
     ("\Ê" . "\\^E")
     ("\Ë" .  "\\\"E")
     ("\�" . "\\'I")
     ("\Ì" . "\\`I")
     ("\ÃŽ" . "\\^I")
     ("\�" .  "\\\"I")
     ("\0" . "\\'O")
     ("\Ã’" . "\\`O")
     ("\Ô" . "\\^O")
     ("\Ö" .  "\\\"O")
     ("\Ú" . "\\'U")
     ("\Ù" . "\\`U")
     ("\Û" . "\\^U")
     ("\Ü" .  "\\\"U")
     ("\Ç" . "\\c{C}")
     ("\á" . "\\'a")
     ("\à" . "\\`a")
     ("\â" . "\\^a")
     ("\ä"  .  "\\\"a")
     ("\é" . "\\'e")
     ("\è" . "\\`e")
     ("\ê" . "\\^e")
     ("\ë" .  "\\\"e")
     ("\í" .  "\\'\\i")
     ("\ì" .  "\\`\\i")
     ("\î" .  "\\^\\i")
     ("\ï" .  "\\\"\\i")
     ("\ó" . "\\'o")
     ("\ò" . "\\`o")
     ("\ô" . "\\^o")
     ("\ö" .  "\\\"o")
     ("\ú" . "\\'u")
     ("\ù" . "\\`u")
     ("\û" . "\\^u")
     ("\ü" .  "\\\"u")
     ("\ç" . "\\c{c}"))
   
   )
  "Convertisseur de lettres accentuées en séquence TeX
  équivalentes.")


(defun accents-tex ()
  (interactive)
  "change les caracteres accentues en accents tex"
  (accents-conversion accents-convertisseur-tex))

(defun accents-de-tex ()
  (interactive)
  "change les caracteres accentues en accents tex"
  (accents-moteur
   '(( "\\\\'[ \n\t]*A" . "\�")
     ( "\\\\`[ \n\t]*A" . "\À")
     ( "\\\\^[ \n\t]*A" . "\Â")
     ( "\\\\\"[ \n\t]*A" . "\Ä")
     ( "\\\\'[ \n\t]*E" . "\É")
     ( "\\\\`[ \n\t]*E" . "\È")
     ( "\\\\^[ \n\t]*E" . "\Ê" )
     ( "\\\\\"[ \n\t]*E" . "\Ë")
     ( "\\\\'[ \n\t]*I" . "\�")
     ( "\\\\`[ \n\t]*I" . "\Ì")
     ( "\\\\^[ \n\t]*I" . "\ÃŽ")
     ( "\\\\\"[ \n\t]*I" . "\�")
     ( "\\\\'[ \n\t]*O" . "\0")
     ( "\\\\`[ \n\t]*O" . "\Ã’")
     ( "\\\\^[ \n\t]*O" . "\Ô")
     ( "\\\\\"[ \n\t]*O" . "\Ö")
     ( "\\\\'[ \n\t]*U" . "\Ú")
     ( "\\\\`[ \n\t]*U" . "\Ù")
     ( "\\\\^[ \n\t]*U" . "\Û")
     ( "\\\\\"[ \n\t]*U" . "\Ü")
     ( "\\\\c[ \n\t]*{C}" . "\Ç")
     ( "\\\\'[ \n\t]*{A}" . "\�")
     ( "\\\\`[ \n\t]*{A}" . "\À")
     ( "\\\\^[ \n\t]*{A}" . "\Â")
     ( "\\\\\"[ \n\t]*{A}" . "\Ä")
     ( "\\\\'[ \n\t]*{E}" . "\É")
     ( "\\\\`[ \n\t]*{E}" . "\È")
     ( "\\\\^[ \n\t]*{E}" . "\Ê" )
     ( "\\\\\"[ \n\t]*{E}" . "\Ë")
     ( "\\\\'[ \n\t]*{I}" . "\�")
     ( "\\\\`[ \n\t]*{I}" . "\Ì")
     ( "\\\\^[ \n\t]*{I}" . "\ÃŽ")
     ( "\\\\\"[ \n\t]*{I}" . "\�")
     ( "\\\\'[ \n\t]*{O}" . "\0")
     ( "\\\\`[ \n\t]*{O}" . "\Ã’")
     ( "\\\\^[ \n\t]*{O}" . "\Ô")
     ( "\\\\\"[ \n\t]*{O}" . "\Ö")
     ( "\\\\'[ \n\t]*{U}" . "\Ú")
     ( "\\\\`[ \n\t]*{U}" . "\Ù")
     ( "\\\\^[ \n\t]*{U}" . "\Û")
     ( "\\\\'[ \n\t]*a" . "\á" )
     ( "\\\\`[ \n\t]*a" . "\à" )
     ( "\\\\^[ \n\t]*a" . "\â" )
     ( "\\\\\"[ \n\t]*a" . "\ä" )
     ( "\\\\'[ \n\t]*e" . "\é" )
     ( "\\\\`[ \n\t]*e" . "\è")
     ( "\\\\^[ \n\t]*e" . "\ê")
     ( "\\\\\"[ \n\t]*e" . "\ë")
     ( "\\\\'{\\\\i}" . "\í")
     ( "\\\\`{\\\\i}" . "\ì")
     ( "\\\\^{\\\\i}" . "\î")
     ( "\\\\\"{\\\\i}" . "\ï")
     ( "\\\\'\\\\[ \n\t]*i" . "\í")
     ( "\\\\`\\\\[ \n\t]*i" . "\ì")
     ( "\\\\^\\\\[ \n\t]*i" . "\î")
     ( "\\\\\"\\\\[ \n\t]*i" . "\ï")
     ( "\\\\'[ \n\t]*o" . "\ó")
     ( "\\\\`[ \n\t]*o" . "\ò")
     ( "\\\\^[ \n\t]*o" . "\ô")
     ( "\\\\\"[ \n\t]*o" . "\ö")
     (  "\\\\'[ \n\t]*u" . "\ú")
     ( "\\\\`[ \n\t]*u" . "\ù")
     ( "\\\\^[ \n\t]*u" . "\û")
     ( "\\\\\"[ \n\t]*u" . "\ü")
     ( "\\\\c[ \n\t]*{c}" . "\ç")
     ( "\\\\\"[ \n\t]*{u}" . "\ü")
     ( "\\\\'[ \n\t]*{a}" . "\á" )
     ( "\\\\`[ \n\t]*{a}" . "\à" )
     ( "\\\\^[ \n\t]*{a}" . "\â" )
     ( "\\\\\"[ \n\t]*{a}" . "\ä" )
     ( "\\\\'[ \n\t]*{e}" . "\é" )
     ( "\\\\`[ \n\t]*{e}" . "\è")
     ( "\\\\^[ \n\t]*{e}" . "\ê")
     ( "\\\\\"[ \n\t]*{e}" . "\ë")
     ( "\\\\'[ \n\t]*{o}" . "\ó")
     ( "\\\\`[ \n\t]*{o}" . "\ò")
     ( "\\\\^[ \n\t]*{o}" . "\ô")
     ( "\\\\\"[ \n\t]*{o}" . "\ö")
     (  "\\\\'[ \n\t]*{u}" . "\ú")
     ( "\\\\`[ \n\t]*{u}" . "\ù")
     ( "\\\\^[ \n\t]*{u}" . "\û")
     ( "\\\\\"[ \n\t]*{u}" . "\ü")
     )
   t ;; utilisation de d'expression régulière
   ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; accents-html : change les caracteres accentues en accents html
;; sans demander confirmation
;; les majuscules sont respectees
;;
;; html-accents : change les accents html en caracteres accentues
;; sans demander confirmation
;; les majuscules sont respectees

(defconst accents-convertisseur-html
  (make-instance 'accents-convertisseur-simple 
		 :id 'accents-convertisseur-html
		 :liste-de-remplacement
   '(
     ( "\∀" . "&forall;")
     ( "\∂" . "&part;")
     ( "\∃" . "&exist;")
     ( "\∅" . "&empty;")
     ( "\∇" . "&nabla;")
     ( "\∈" . "&isin;")
     ( "\∉" . "&notin;")
     ( "\∋" . "&ni;")
     ( "\�" . "&prod;")
     ( "\∑" . "&sum;")
     ( "\−" . "&minus;")
     ( "\∗" . "&lowast;")
     ( "\√" . "&radic;")
     ( "\�" . "&prop;")
     ( "\∞" . "&infin;")
     ( "\∠" . "&ang;")
     ( "\∧" . "&and;")
     ( "\∨" . "&or;")
     ( "\∩" . "&cap;")
     ( "\∪" . "&cup;")
     ( "\∫" . "&int;")
     ( "\∴" . "&there4;")
     ( "\∼" . "&sim;")
     ( "\≅" . "&cong;")
     ( "\≈" . "&asymp;")
     ( "\≠" . "&ne;")
     ( "\≡" . "&equiv;")
     ( "\≤" . "&le;")
     ( "\≥" . "&ge;")
     ( "\⊂" . "&sub;")
     ( "\⊃" . "&sup;")
     ( "\⊄" . "&nsub;")
     ( "\⊆" . "&sube;")
     ( "\⊇" . "&supe;")
     ( "\⊕" . "&oplus;")
     ( "\⊗" . "&otimes;")
     ( "\⊥" . "&perp;")
     ( "\â‹…" . "&sdot;")
     ( "\Α" . "&Alpha;")
     ( "\Î’" . "&Beta;")
     ( "\Γ" . "&Gamma;")
     ( "\Δ" . "&Delta;")
     ( "\Ε" . "&Epsilon;")
     ( "\Ζ" . "&Zeta;")
     ( "\Η" . "&Eta;")
     ( "\Θ" . "&Theta;")
     ( "\Ι" . "&Iota;")
     ( "\Κ" . "&Kappa;")
     ( "\Λ" . "&Lambda;")
     ( "\Μ" . "&Mu;")
     ( "\�" . "&Nu;")
     ( "\Ξ" . "&Xi;")
     ( "\Ο" . "&Omicron;")
     ( "\Π" . "&Pi;")
     ( "\Ρ" . "&Rho;")
     ( "\Σ" . "&Sigma;")
     ( "\Τ" . "&Tau;")
     ( "\Î¥" . "&Upsilon;")
     ( "\Φ" . "&Phi;")
     ( "\Χ" . "&Chi;")
     ( "\Ψ" . "&Psi;")
     ( "\Ω" . "&Omega;")
     ( "\α" . "&alpha;")
     ( "\β" . "&beta;")
     ( "\γ" . "&gamma;")
     ( "\δ" . "&delta;")
     ( "\ε" . "&epsilon;")
     ( "\ζ" . "&zeta;")
     ( "\η" . "&eta;")
     ( "\θ" . "&theta;")
     ( "\ι" . "&iota;")
     ( "\κ" . "&kappa;")
     ( "\λ" . "&lambda;")
     ( "\μ" . "&mu;")
     ( "\ν" . "&nu;")
     ( "\ξ" . "&xi;")
     ( "\ο" . "&omicron;")
     ( "\Ï€" . "&pi;")
     ( "\�" . "&rho;")
     ( "\Ï‚" . "&sigmaf;")
     ( "\σ" . "&sigma;")
     ( "\Ï„" . "&tau;")
     ( "\Ï…" . "&upsilon;")
     ( "\φ" . "&phi;")
     ( "\χ" . "&chi;")
     ( "\ψ" . "&psi;")
     ( "\ω" . "&omega;")
     ( "\Ï‘" . "&thetasym;")
     ( "\Ï’" . "&upsih;")
     ( "\Ï–" . "&piv;")
     ( "\Å’" . "&OElig;")
     ( "\Å“" . "&oelig;")
     ( "\Å " . "&Scaron;")
     ( "\Å¡" . "&scaron;")
     ( "\Ÿ" . "&Yuml;")
     ( "\Æ’" . "&fnof;")
     ( "\ˆ" . "&circ;")
     ( "\˜" . "&tilde;")
     ( "\ " . "&ensp;")
     ( "\ " . "&emsp;")
     ( "\ " . "&thinsp;")
     ( "\‌" . "&zwnj;")
     ( "\�" . "&zwj;")
     ( "\‎" . "&lrm;")
     ( "\�" . "&rlm;")
     ( "\–" . "&ndash;")
     ( "\—" . "&mdash;")
     ( "\‘" . "&lsquo;")
     ( "\’" . "&rsquo;")
     ( "\‚" . "&sbquo;")
     ( "\“" . "&ldquo;")
     ( "\�" . "&rdquo;")
     ( "\„" . "&bdquo;")
     ( "\†" . "&dagger;")
     ( "\‡" . "&Dagger;")
     ( "\•" . "&bull;")
     ( "\…" . "&hellip;")
     ( "\‰" . "&permil;")
     ( "\′" . "&prime;")
     ( "\″" . "&Prime;")
     ( "\‹" . "&lsaquo;")
     ( "\›" . "&rsaquo;")
     ( "\‾" . "&oline;")
     ( "\€" . "&euro;")
     ( "\â„¢" . "&trade;")
     ( "\�" . "&larr;")
     ( "\↑" . "&uarr;")
     ( "\→" . "&rarr;")
     ( "\↓" . "&darr;")
     ( "\↔" . "&harr;")
     ( "\↵" . "&crarr;")
     ( "\⌈" . "&lceil;")
     ( "\⌉" . "&rceil;")
     ( "\⌊" . "&lfloor;")
     ( "\⌋" . "&rfloor;")
     ( "\â—Š" . "&loz;")
     ( "\â™ " . "&spades;")
     ( "\♣" . "&clubs;")
     ( "\♥" . "&hearts;")
     ( "\♦" . "&diams;")
     ( "\�" . "&Aacute;")
     ( "\À" . "&Agrave;")
     ( "\Â" . "&Acirc;")
     ( "\Ä" . "&Auml;")
     ( "\É" . "&Eacute;")
     ( "È" . "&Egrave;")
     ( "\Ê" . "&Ecirc;")
     ( "\Ë" . "&Euml;")
     ( "\�" . "&Iacute;")
     ( "\Ì" . "&Igrave;")
     ( "\ÃŽ" . "&Icirc;")
     ( "\�" . "&Iuml;")
     ( "\Ó" . "&Oacute;")
     ( "\Ã’" . "&Ograve;")
     ( "\Ô" . "&Ocirc;")
     ( "\Ö" . "&Ouml;")
     ( "\Ú" . "&Uacute")
     ( "\Ù" . "&Ugrave;")
     ( "\Û" . "&Ucirc;")
     ( "\Ü" . "&Uuml;")
     ( "\Ç" . "&Ccedil;")
     ( "\á" . "&aacute;")
     ( "\à" . "&agrave;")
     ( "\â" . "&acirc;")
     ( "\ä" . "&auml;")
     ( "\é" . "&eacute;")
     ( "\è" . "&egrave;")
     ( "\ê" . "&ecirc;")
     ( "\ë" . "&euml;")
     ( "\…" . "&hellip;")
     ( "\í" . "&iacute;")
     ( "\ì" . "&igrave;")
     ( "\î" . "&icirc;")
     ( "\ "  . "&nbsp;")
     ( "\ï" . "&iuml;")
     ( "\ó" . "&oacute;")
     ( "\ò" . "&ograve;")
     ( "\Å“" . "&oelig;")
     ( "\ô" . "&ocirc;")
     ( "\ö" . "&ouml;")
     ( "\ú" . "&uacute")
     ( "\ù" . "&ugrave;")
     ( "\û" . "&ucirc;")
     ( "\ü" . "&uuml;")
     ( "\ç" . "&ccedil;")
     ("\«"  . "&laquo;")
     ("\»"  . "&raquo;")
     ) )
  "Converstisseur de lettres accentuées en entités HTML équivalentes")

(defconst accents-convertisseur-de-html
  (make-instance
   'accents-convertisseur-inverse
   :id 'accents-convertisseur-de-html
   :liste-de-remplacement (oref accents-convertisseur-html
				:liste-de-remplacement))
  "Converstisseur d'entités HTML en lettres accentuées équivalentes" )

(defun accents-html ()
  (interactive)
  "change les caractères accentués en entités HTML équivalentes."
  (accents-conversion accents-convertisseur-html))


(defun accents-de-html ()
  (interactive)
  "change les entités HTML en caractères accentués équivalents."
  (accents-conversion accents-convertisseur-de-html)
  (save-excursion
    (save-match-data 
      (goto-char (point-min))
      (while (re-search-forward "&#\\([0-9]+\\);" nil t)
	(replace-match (string (string-to-number (match-string 1))) t t)))))

;;---------------------------------------------------------------------------
(defconst accents-convertisseur-de-utf-8
  (make-instance 
   'accents-convertisseur-simple
   :id 'accents-convertisseur-de-utf-8
   :liste-de-remplacement 
   '(("ï" . "ï")
     ("é" . "é")
     ("â" . "â")
     ("û" . "û")
     ("è" . "è")
     ("ù" . "ù")
     ( "ç" . "ç")
     ("ê" . "ê")
     ("à" . "à")
     ("ô" . "ô")
     ))
  "Conversion de codage UTF-8 non reconue en caractères équivalents")

(defun accents-de-utf-8 ()
  (interactive)
  "change les séquence UTF-8 en caractères accentués équivalents."
  (accents-conversion accents-convertisseur-de-utf-8))
  


(provide 'accents-dur-tex-html)

Revision-number: 9
Prop-content-length: 156
Content-length: 156

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2011-05-09T20:13:09.000000Z
K 7
svn:log
V 54
Renommage accents-dur-tex-html.el en accents-ascii.el

PROPS-END

Node-path: trunk/lisp/accents-ascii.el
Node-kind: file
Node-action: add
Prop-content-length: 10
Text-content-length: 17229
Text-content-md5: 2a78bb1daa8643994f7a08124824b746
Content-length: 17239

PROPS-END
;; -*- coding: utf-8 -*-
;; Copyright 2008 Vincent Belaïche

;; Author: Vincent Belaïche <vincent.b.1@hotmail.fr>
;; Version: $Id: accents-ascii.el,v 1.1 2011-05-09 20:13:09 Vincent Exp $
;; Keywords: 
;; X-URL: not distributed yet

;; 
;; This software is governed by the CeCILL license under French law and
;; abiding by the rules of distribution of free software.  You can  use, 
;; modify and/ or redistribute the software under the terms of the CeCILL
;; license as circulated by CEA, CNRS and INRIA at the following URL
;; "http://www.cecill.info". 
;; 
;; As a counterpart to the access to the source code and  rights to copy,
;; modify and redistribute granted by the license, users are provided only
;; with a limited warranty  and the software's author,  the holder of the
;; economic rights,  and the successive licensors  have only  limited
;; liability. 
;; 
;; In this respect, the user's attention is drawn to the risks associated
;; with loading,  using,  modifying and/or developing or reproducing the
;; software by the user in light of its specific status of free software,
;; that may mean  that it is complicated to manipulate,  and  that  also
;; therefore means  that it is reserved for developers  and  experienced
;; professionals having in-depth computer knowledge. Users are therefore
;; encouraged to load and test the software's suitability as regards their
;; requirements in conditions enabling the security of their systems and/or 
;; data to be ensured and,  more generally, to use and operate it in the 
;; same conditions as regards security. 
;; 
;; The fact that you are presently reading this means that you have had
;; knowledge of the CeCILL license and that you accept its terms.
;; 
;;; Commentary:

;; accents-tex : change les caractères accentués en accents tex
;; conserve les majuscules, sans demander confirmation.
;;
;; accents-de-tex : change les accents tex en caracteres accentués sans
;; demander confirmation.  les majuscules sont respectees.
;;

(require 'eieio)

(dolist (v '(accents-convertisseur-cache
	     accents-convertisseur-le-cache
	     accents-convertisseur-base
	     accents-convertisseur-simple
	     accents-convertisseur-inverse
	     accents-convertisseur-html
	     accents-convertisseur-de-html))
  (makunbound v))

(defclass accents-convertisseur-cache ()
  ((table-de-hashage
    :initarg :table-de-hashage)
   (expression-rationnelle
    :initarg :expression-rationnelle
    :documentation "Expression rationnelle s'accordant aux
    lettres accentuées à remplacer.")
   (id-convertisseur
    :initarg :id-convertisseur
    :initform nil
    :type symbol)
   (lecteur-clef
    :initarg :lecteur-clef
    :initform nil))
  "C'est la classe qui fait le boulot effectif de remplacement.")

(defvar accents-convertisseur-le-cache
  (make-instance 'accents-convertisseur-cache
		 :table-de-hashage (make-hash-table :test 'equal)))

(defmethod accents-conversion 
  ((this accents-convertisseur-cache) &optional beg end)
  (save-excursion
    (goto-char (or beg (point-min)))
    (setq end (if end 
		  (let ((m (make-marker))) 
		    (prog1 m 
		      (set-maker m end)))))
    (save-match-data
      (let ((case-fold-search nil)
	    (table-de-hashage (oref this :table-de-hashage))
	    (expression-rationnelle (oref this :expression-rationnelle))
	    (lecteur-clef (or (oref this :lecteur-clef) 
			      (function (lambda () (match-string-no-properties 0))))))

	(while (re-search-forward expression-rationnelle end t)
	  (let ((replacement  
		 (gethash  (funcall lecteur-clef)
		  table-de-hashage)))
	    (and replacement
		 (replace-match replacement t t)))))))
  (when end 
    (set-marker end nil)))

(defclass accents-convertisseur-base ()
  ((cache
    :allocation :class
    :documentation "État en cache du convertisseur"))
  "Classe de base pour un convertisseur"  )
(oset-default accents-convertisseur-base cache 
	      accents-convertisseur-le-cache)

(defclass accents-convertisseur-simple 
  (accents-convertisseur-base)
  ((id
    :initarg :id
    :documentation "Symbole d'itentification unique pour le
    cache.")
   (liste-de-remplacement
    :initarg :liste-de-remplacement
    :documentation "Liste d'association") )
  "")

(defmacro accents-definir-conversion
  (CLASS CAR CDR &optional LECTEUR-CLEF)
  `(defmethod accents-conversion 
     ((this ,CLASS) &optional beg end)

     (let ((cache (oref this cache))
	   (id (oref this :id)))
       (unless (eq (oref cache :id-convertisseur)
		   id)
	 (oset cache :id-convertisseur ,LECTEUR-CLEF)
	 (oset cache :lecteur-clef nil)
	 (let ((table-de-hashage (oref cache :table-de-hashage))
	       (liste-de-remplacement (oref this :liste-de-remplacement)))
	   (clrhash table-de-hashage)
	   (dolist (k liste-de-remplacement)
	     (puthash (,CAR k) (,CDR k) table-de-hashage))
	   (oset cache :expression-rationnelle
		 (regexp-opt (mapcar (quote ,CAR) liste-de-remplacement)))))
       (accents-conversion cache beg end))))

(accents-definir-conversion accents-convertisseur-simple car cdr)

(defclass accents-convertisseur-inverse
  (accents-convertisseur-simple)
  ()
  "Convertisseur pour effectuer la conversion inverse vis-à-vis
  de la liste de remplacement.")

(accents-definir-conversion accents-convertisseur-inverse cdr car)

(defun accents-moteur (liste-des-remplacements &optional convert-to-re)
  (save-excursion
	(save-match-data
	  (let ((case-fold-search nil)
		(re (if convert-to-re 
			(mapconcat 'identity 
				   (mapcar 'car liste-des-remplacements)
				   "\\|")
		      (regexp-opt  (mapcar 'car liste-des-remplacements)))))
	    (goto-char (point-min))
	    (while (re-search-forward re nil t)
	      (replace-match
	       (cdr 
		(if convert-to-re
		    (assoc-default (match-string 0) liste-des-remplacements 'string-match)
		  (assoc-string (match-string 0) liste-des-remplacements)))
	       t; fixed case
	       t; literal
	       ))))))

(defconst accents-converstisseur-tex
  (make-instance 
   'accents-convertisseur-simple
   :id 'accents-converstisseur-tex
   :liste-de-remplacement 
   '(("\�" . "\\'A")
     ("\À" . "\\`A")
     ("\Â" . "\\^A")
     ("\Ä" .  "\\\"A")
     ("\É" . "\\'E")
     ("\È" . "\\`E")
     ("\Ê" . "\\^E")
     ("\Ë" .  "\\\"E")
     ("\�" . "\\'I")
     ("\Ì" . "\\`I")
     ("\ÃŽ" . "\\^I")
     ("\�" .  "\\\"I")
     ("\0" . "\\'O")
     ("\Ã’" . "\\`O")
     ("\Ô" . "\\^O")
     ("\Ö" .  "\\\"O")
     ("\Ú" . "\\'U")
     ("\Ù" . "\\`U")
     ("\Û" . "\\^U")
     ("\Ü" .  "\\\"U")
     ("\Ç" . "\\c{C}")
     ("\á" . "\\'a")
     ("\à" . "\\`a")
     ("\â" . "\\^a")
     ("\ä"  .  "\\\"a")
     ("\é" . "\\'e")
     ("\è" . "\\`e")
     ("\ê" . "\\^e")
     ("\ë" .  "\\\"e")
     ("\í" .  "\\'\\i")
     ("\ì" .  "\\`\\i")
     ("\î" .  "\\^\\i")
     ("\ï" .  "\\\"\\i")
     ("\ó" . "\\'o")
     ("\ò" . "\\`o")
     ("\ô" . "\\^o")
     ("\ö" .  "\\\"o")
     ("\ú" . "\\'u")
     ("\ù" . "\\`u")
     ("\û" . "\\^u")
     ("\ü" .  "\\\"u")
     ("\ç" . "\\c{c}"))
   
   )
  "Convertisseur de lettres accentuées en séquence TeX
  équivalentes.")


(defun accents-tex ()
  (interactive)
  "change les caracteres accentues en accents tex"
  (accents-conversion accents-convertisseur-tex))

(defun accents-de-tex ()
  (interactive)
  "change les caracteres accentues en accents tex"
  (accents-moteur
   '(( "\\\\'[ \n\t]*A" . "\�")
     ( "\\\\`[ \n\t]*A" . "\À")
     ( "\\\\^[ \n\t]*A" . "\Â")
     ( "\\\\\"[ \n\t]*A" . "\Ä")
     ( "\\\\'[ \n\t]*E" . "\É")
     ( "\\\\`[ \n\t]*E" . "\È")
     ( "\\\\^[ \n\t]*E" . "\Ê" )
     ( "\\\\\"[ \n\t]*E" . "\Ë")
     ( "\\\\'[ \n\t]*I" . "\�")
     ( "\\\\`[ \n\t]*I" . "\Ì")
     ( "\\\\^[ \n\t]*I" . "\ÃŽ")
     ( "\\\\\"[ \n\t]*I" . "\�")
     ( "\\\\'[ \n\t]*O" . "\0")
     ( "\\\\`[ \n\t]*O" . "\Ã’")
     ( "\\\\^[ \n\t]*O" . "\Ô")
     ( "\\\\\"[ \n\t]*O" . "\Ö")
     ( "\\\\'[ \n\t]*U" . "\Ú")
     ( "\\\\`[ \n\t]*U" . "\Ù")
     ( "\\\\^[ \n\t]*U" . "\Û")
     ( "\\\\\"[ \n\t]*U" . "\Ü")
     ( "\\\\c[ \n\t]*{C}" . "\Ç")
     ( "\\\\'[ \n\t]*{A}" . "\�")
     ( "\\\\`[ \n\t]*{A}" . "\À")
     ( "\\\\^[ \n\t]*{A}" . "\Â")
     ( "\\\\\"[ \n\t]*{A}" . "\Ä")
     ( "\\\\'[ \n\t]*{E}" . "\É")
     ( "\\\\`[ \n\t]*{E}" . "\È")
     ( "\\\\^[ \n\t]*{E}" . "\Ê" )
     ( "\\\\\"[ \n\t]*{E}" . "\Ë")
     ( "\\\\'[ \n\t]*{I}" . "\�")
     ( "\\\\`[ \n\t]*{I}" . "\Ì")
     ( "\\\\^[ \n\t]*{I}" . "\ÃŽ")
     ( "\\\\\"[ \n\t]*{I}" . "\�")
     ( "\\\\'[ \n\t]*{O}" . "\0")
     ( "\\\\`[ \n\t]*{O}" . "\Ã’")
     ( "\\\\^[ \n\t]*{O}" . "\Ô")
     ( "\\\\\"[ \n\t]*{O}" . "\Ö")
     ( "\\\\'[ \n\t]*{U}" . "\Ú")
     ( "\\\\`[ \n\t]*{U}" . "\Ù")
     ( "\\\\^[ \n\t]*{U}" . "\Û")
     ( "\\\\'[ \n\t]*a" . "\á" )
     ( "\\\\`[ \n\t]*a" . "\à" )
     ( "\\\\^[ \n\t]*a" . "\â" )
     ( "\\\\\"[ \n\t]*a" . "\ä" )
     ( "\\\\'[ \n\t]*e" . "\é" )
     ( "\\\\`[ \n\t]*e" . "\è")
     ( "\\\\^[ \n\t]*e" . "\ê")
     ( "\\\\\"[ \n\t]*e" . "\ë")
     ( "\\\\'{\\\\i}" . "\í")
     ( "\\\\`{\\\\i}" . "\ì")
     ( "\\\\^{\\\\i}" . "\î")
     ( "\\\\\"{\\\\i}" . "\ï")
     ( "\\\\'\\\\[ \n\t]*i" . "\í")
     ( "\\\\`\\\\[ \n\t]*i" . "\ì")
     ( "\\\\^\\\\[ \n\t]*i" . "\î")
     ( "\\\\\"\\\\[ \n\t]*i" . "\ï")
     ( "\\\\'[ \n\t]*o" . "\ó")
     ( "\\\\`[ \n\t]*o" . "\ò")
     ( "\\\\^[ \n\t]*o" . "\ô")
     ( "\\\\\"[ \n\t]*o" . "\ö")
     (  "\\\\'[ \n\t]*u" . "\ú")
     ( "\\\\`[ \n\t]*u" . "\ù")
     ( "\\\\^[ \n\t]*u" . "\û")
     ( "\\\\\"[ \n\t]*u" . "\ü")
     ( "\\\\c[ \n\t]*{c}" . "\ç")
     ( "\\\\\"[ \n\t]*{u}" . "\ü")
     ( "\\\\'[ \n\t]*{a}" . "\á" )
     ( "\\\\`[ \n\t]*{a}" . "\à" )
     ( "\\\\^[ \n\t]*{a}" . "\â" )
     ( "\\\\\"[ \n\t]*{a}" . "\ä" )
     ( "\\\\'[ \n\t]*{e}" . "\é" )
     ( "\\\\`[ \n\t]*{e}" . "\è")
     ( "\\\\^[ \n\t]*{e}" . "\ê")
     ( "\\\\\"[ \n\t]*{e}" . "\ë")
     ( "\\\\'[ \n\t]*{o}" . "\ó")
     ( "\\\\`[ \n\t]*{o}" . "\ò")
     ( "\\\\^[ \n\t]*{o}" . "\ô")
     ( "\\\\\"[ \n\t]*{o}" . "\ö")
     (  "\\\\'[ \n\t]*{u}" . "\ú")
     ( "\\\\`[ \n\t]*{u}" . "\ù")
     ( "\\\\^[ \n\t]*{u}" . "\û")
     ( "\\\\\"[ \n\t]*{u}" . "\ü")
     )
   t ;; utilisation de d'expression régulière
   ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; accents-html : change les caracteres accentues en accents html
;; sans demander confirmation
;; les majuscules sont respectees
;;
;; html-accents : change les accents html en caracteres accentues
;; sans demander confirmation
;; les majuscules sont respectees

(defconst accents-convertisseur-html
  (make-instance 'accents-convertisseur-simple 
		 :id 'accents-convertisseur-html
		 :liste-de-remplacement
   '(
     ( "\∀" . "&forall;")
     ( "\∂" . "&part;")
     ( "\∃" . "&exist;")
     ( "\∅" . "&empty;")
     ( "\∇" . "&nabla;")
     ( "\∈" . "&isin;")
     ( "\∉" . "&notin;")
     ( "\∋" . "&ni;")
     ( "\�" . "&prod;")
     ( "\∑" . "&sum;")
     ( "\−" . "&minus;")
     ( "\∗" . "&lowast;")
     ( "\√" . "&radic;")
     ( "\�" . "&prop;")
     ( "\∞" . "&infin;")
     ( "\∠" . "&ang;")
     ( "\∧" . "&and;")
     ( "\∨" . "&or;")
     ( "\∩" . "&cap;")
     ( "\∪" . "&cup;")
     ( "\∫" . "&int;")
     ( "\∴" . "&there4;")
     ( "\∼" . "&sim;")
     ( "\≅" . "&cong;")
     ( "\≈" . "&asymp;")
     ( "\≠" . "&ne;")
     ( "\≡" . "&equiv;")
     ( "\≤" . "&le;")
     ( "\≥" . "&ge;")
     ( "\⊂" . "&sub;")
     ( "\⊃" . "&sup;")
     ( "\⊄" . "&nsub;")
     ( "\⊆" . "&sube;")
     ( "\⊇" . "&supe;")
     ( "\⊕" . "&oplus;")
     ( "\⊗" . "&otimes;")
     ( "\⊥" . "&perp;")
     ( "\â‹…" . "&sdot;")
     ( "\Α" . "&Alpha;")
     ( "\Î’" . "&Beta;")
     ( "\Γ" . "&Gamma;")
     ( "\Δ" . "&Delta;")
     ( "\Ε" . "&Epsilon;")
     ( "\Ζ" . "&Zeta;")
     ( "\Η" . "&Eta;")
     ( "\Θ" . "&Theta;")
     ( "\Ι" . "&Iota;")
     ( "\Κ" . "&Kappa;")
     ( "\Λ" . "&Lambda;")
     ( "\Μ" . "&Mu;")
     ( "\�" . "&Nu;")
     ( "\Ξ" . "&Xi;")
     ( "\Ο" . "&Omicron;")
     ( "\Π" . "&Pi;")
     ( "\Ρ" . "&Rho;")
     ( "\Σ" . "&Sigma;")
     ( "\Τ" . "&Tau;")
     ( "\Î¥" . "&Upsilon;")
     ( "\Φ" . "&Phi;")
     ( "\Χ" . "&Chi;")
     ( "\Ψ" . "&Psi;")
     ( "\Ω" . "&Omega;")
     ( "\α" . "&alpha;")
     ( "\β" . "&beta;")
     ( "\γ" . "&gamma;")
     ( "\δ" . "&delta;")
     ( "\ε" . "&epsilon;")
     ( "\ζ" . "&zeta;")
     ( "\η" . "&eta;")
     ( "\θ" . "&theta;")
     ( "\ι" . "&iota;")
     ( "\κ" . "&kappa;")
     ( "\λ" . "&lambda;")
     ( "\μ" . "&mu;")
     ( "\ν" . "&nu;")
     ( "\ξ" . "&xi;")
     ( "\ο" . "&omicron;")
     ( "\Ï€" . "&pi;")
     ( "\�" . "&rho;")
     ( "\Ï‚" . "&sigmaf;")
     ( "\σ" . "&sigma;")
     ( "\Ï„" . "&tau;")
     ( "\Ï…" . "&upsilon;")
     ( "\φ" . "&phi;")
     ( "\χ" . "&chi;")
     ( "\ψ" . "&psi;")
     ( "\ω" . "&omega;")
     ( "\Ï‘" . "&thetasym;")
     ( "\Ï’" . "&upsih;")
     ( "\Ï–" . "&piv;")
     ( "\Å’" . "&OElig;")
     ( "\Å“" . "&oelig;")
     ( "\Å " . "&Scaron;")
     ( "\Å¡" . "&scaron;")
     ( "\Ÿ" . "&Yuml;")
     ( "\Æ’" . "&fnof;")
     ( "\ˆ" . "&circ;")
     ( "\˜" . "&tilde;")
     ( "\ " . "&ensp;")
     ( "\ " . "&emsp;")
     ( "\ " . "&thinsp;")
     ( "\‌" . "&zwnj;")
     ( "\�" . "&zwj;")
     ( "\‎" . "&lrm;")
     ( "\�" . "&rlm;")
     ( "\–" . "&ndash;")
     ( "\—" . "&mdash;")
     ( "\‘" . "&lsquo;")
     ( "\’" . "&rsquo;")
     ( "\‚" . "&sbquo;")
     ( "\“" . "&ldquo;")
     ( "\�" . "&rdquo;")
     ( "\„" . "&bdquo;")
     ( "\†" . "&dagger;")
     ( "\‡" . "&Dagger;")
     ( "\•" . "&bull;")
     ( "\…" . "&hellip;")
     ( "\‰" . "&permil;")
     ( "\′" . "&prime;")
     ( "\″" . "&Prime;")
     ( "\‹" . "&lsaquo;")
     ( "\›" . "&rsaquo;")
     ( "\‾" . "&oline;")
     ( "\€" . "&euro;")
     ( "\â„¢" . "&trade;")
     ( "\�" . "&larr;")
     ( "\↑" . "&uarr;")
     ( "\→" . "&rarr;")
     ( "\↓" . "&darr;")
     ( "\↔" . "&harr;")
     ( "\↵" . "&crarr;")
     ( "\⌈" . "&lceil;")
     ( "\⌉" . "&rceil;")
     ( "\⌊" . "&lfloor;")
     ( "\⌋" . "&rfloor;")
     ( "\â—Š" . "&loz;")
     ( "\â™ " . "&spades;")
     ( "\♣" . "&clubs;")
     ( "\♥" . "&hearts;")
     ( "\♦" . "&diams;")
     ( "\�" . "&Aacute;")
     ( "\À" . "&Agrave;")
     ( "\Â" . "&Acirc;")
     ( "\Ä" . "&Auml;")
     ( "\É" . "&Eacute;")
     ( "È" . "&Egrave;")
     ( "\Ê" . "&Ecirc;")
     ( "\Ë" . "&Euml;")
     ( "\�" . "&Iacute;")
     ( "\Ì" . "&Igrave;")
     ( "\ÃŽ" . "&Icirc;")
     ( "\�" . "&Iuml;")
     ( "\Ó" . "&Oacute;")
     ( "\Ã’" . "&Ograve;")
     ( "\Ô" . "&Ocirc;")
     ( "\Ö" . "&Ouml;")
     ( "\Ú" . "&Uacute")
     ( "\Ù" . "&Ugrave;")
     ( "\Û" . "&Ucirc;")
     ( "\Ü" . "&Uuml;")
     ( "\Ç" . "&Ccedil;")
     ( "\á" . "&aacute;")
     ( "\à" . "&agrave;")
     ( "\â" . "&acirc;")
     ( "\ä" . "&auml;")
     ( "\é" . "&eacute;")
     ( "\è" . "&egrave;")
     ( "\ê" . "&ecirc;")
     ( "\ë" . "&euml;")
     ( "\…" . "&hellip;")
     ( "\í" . "&iacute;")
     ( "\ì" . "&igrave;")
     ( "\î" . "&icirc;")
     ( "\ "  . "&nbsp;")
     ( "\ï" . "&iuml;")
     ( "\ó" . "&oacute;")
     ( "\ò" . "&ograve;")
     ( "\Å“" . "&oelig;")
     ( "\ô" . "&ocirc;")
     ( "\ö" . "&ouml;")
     ( "\ú" . "&uacute")
     ( "\ù" . "&ugrave;")
     ( "\û" . "&ucirc;")
     ( "\ü" . "&uuml;")
     ( "\ç" . "&ccedil;")
     ("\«"  . "&laquo;")
     ("\»"  . "&raquo;")
     ) )
  "Converstisseur de lettres accentuées en entités HTML équivalentes")

(defconst accents-convertisseur-de-html
  (make-instance
   'accents-convertisseur-inverse
   :id 'accents-convertisseur-de-html
   :liste-de-remplacement (oref accents-convertisseur-html
				:liste-de-remplacement))
  "Converstisseur d'entités HTML en lettres accentuées équivalentes" )

(defun accents-html ()
  (interactive)
  "change les caractères accentués en entités HTML équivalentes."
  (accents-conversion accents-convertisseur-html))


(defun accents-de-html ()
  (interactive)
  "change les entités HTML en caractères accentués équivalents."
  (accents-conversion accents-convertisseur-de-html)
  (save-excursion
    (save-match-data 
      (goto-char (point-min))
      (while (re-search-forward "&#\\([0-9]+\\);" nil t)
	(replace-match (string (string-to-number (match-string 1))) t t)))))

;;---------------------------------------------------------------------------
(defconst accents-convertisseur-de-utf-8
  (make-instance 
   'accents-convertisseur-simple
   :id 'accents-convertisseur-de-utf-8
   :liste-de-remplacement 
   '(("ï" . "ï")
     ("é" . "é")
     ("â" . "â")
     ("û" . "û")
     ("è" . "è")
     ("ù" . "ù")
     ( "ç" . "ç")
     ("ê" . "ê")
     ("à" . "à")
     ("ô" . "ô")
     ))
  "Conversion de codage UTF-8 non reconue en caractères équivalents")

(defun accents-de-utf-8 ()
  (interactive)
  "change les séquence UTF-8 en caractères accentués équivalents."
  (accents-conversion accents-convertisseur-de-utf-8))
  


(provide 'accents-ascii)

Revision-number: 10
Prop-content-length: 340
Content-length: 340

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2011-05-16T20:40:53.000000Z
K 7
svn:log
V 237
- Ajout des balises span, sub, sup
- Meilleur traitement des liens interne, notamment lorsqu'une ancre apparaît dans un titre
- ajout accents-de-html
- amélioration html2texi-make-html-clean-xml
- declaration autoload de html2texi

PROPS-END

Node-path: trunk/lisp/html-to-texinfo.el
Node-kind: file
Node-action: change
Text-content-length: 43256
Text-content-md5: f120bc7976289643691241bca7a64c01
Content-length: 43256

;;; html-to-texinfo.el --- -*- coding: iso-8859-1-unix -*-

;; Copyright 2010, 2011 Vincent Belaïche
;;
;; Author: Vincent Belaïche <vincent.b.1@hotmail.fr>
;; Version: $Id: html-to-texinfo.el,v 1.5 2011-05-16 20:40:53 Vincent Exp $
;; Keywords: 
;; X-URL: not distributed yet

;; 
;; This software is governed by the CeCILL license under French law and
;; abiding by the rules of distribution of free software.  You can  use, 
;; modify and/ or redistribute the software under the terms of the CeCILL
;; license as circulated by CEA, CNRS and INRIA at the following URL
;; "http://www.cecill.info". 
;; 
;; As a counterpart to the access to the source code and  rights to copy,
;; modify and redistribute granted by the license, users are provided only
;; with a limited warranty  and the software's author,  the holder of the
;; economic rights,  and the successive licensors  have only  limited
;; liability. 
;; 
;; In this respect, the user's attention is drawn to the risks associated
;; with loading,  using,  modifying and/or developing or reproducing the
;; software by the user in light of its specific status of free software,
;; that may mean  that it is complicated to manipulate,  and  that  also
;; therefore means  that it is reserved for developers  and  experienced
;; professionals having in-depth computer knowledge. Users are therefore
;; encouraged to load and test the software's suitability as regards their
;; requirements in conditions enabling the security of their systems and/or 
;; data to be ensured and,  more generally, to use and operate it in the 
;; same conditions as regards security. 
;; 
;; The fact that you are presently reading this means that you have had
;; knowledge of the CeCILL license and that you accept its terms.
;; 
;;; Commentary:

;; 

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'html-to-texinfo)

;;; Code:

(provide 'html-to-texinfo)
(eval-when-compile
  (require 'cl))
(require 'eieio)
(require 'calc-ext)
(require 'accents-ascii)

;;;;##########################################################################
;;;;  User Options, Variables
;;;;##########################################################################

(defconst html2texi-suspicious-html-tags
  '("meta" "br" "hr" "link" "img" "frame")
"Liste des balises pour lesquelles le HTML ne suit pas une
syntaxe strictement XML. Par exemple `<br>' est utilisé au lieu
de `<br/>'."  )

(defconst html2texi-suspicious-html-tags-re
  (regexp-opt html2texi-suspicious-html-tags))

(defconst html2texi-non-recursive-tags
  '("p" "li"))

(defconst html2texi-non-recursive-tags-re
  (regexp-opt html2texi-non-recursive-tags))


(defclass html2texi-simple-markup ()
  ((class-dependant 
    :initarg :class-dependant
    :initform nil
    :custom '(repeat
	  (list 
	   (regexp :tag "clef")
	   (string :tag "prologue")
	   (string :tag "épilogue")
	   (boolean :tag "conserver les espaces et retours chariot")
	   ))
    :documentation "\
Liste d'association dont les éléments sont de la forme 
 (CLEF PROLOGUE ÉPILOGUE) 

Supposons que l'objet décrit le traitement de la balise TAG,
alors lorsque le code HTML `<TAG class=\"CLEF\">CONTENU</TAG>'
est rencontré, alors il est convertie en le code Texinfo
`PROLOGUE TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU.")
   (preamble
    :initarg :preamble
    :type string
    :documentation "\
Prologue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (postamble
    :initarg :postamble
    :type string
    :documentation "\
Épilogue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (space-verb
    :initarg :space-verb
    :initform nil
    :type boolean
    :documentation "\
Vrai lorsque les espaces et retours chariot sont à conserver tels quels."
    ))
  :documentation "\
Un object de type `html2texi-simple-markup'
décrit le traitement d'une balise simple comme par exemple
<code>.")

(defun html2texi-texinfo-inside-comment-p ()
  "Renvoie non nil lorsque le point est dans un commentaire Texinfo."
  (save-match-data
    (save-excursion
      (let ((cur (point))
	    (end (progn (end-of-line) (point))))
	(beginning-of-line)
	(and (re-search-forward "\\(^\\|[^@]\\)@c\\(omment\\)\\_>" end t)
	     (<= (match-beginning 0) cur))))))

(defmethod html2texi-handle-simple-markup 
  ((this html2texi-simple-markup) xml-expr)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe 
			(and class-attribute
			     (assoc-string (cdr class-attribute) 
					   (oref this :class-dependant))))
		      (list (oref this :preamble)
			    (oref this :postamble)))))
    (insert (car pre-post))
    (let ((beg (point))
	  end)
      (html2texi-process-xml-expr xml-expr)
      (unless (oref this :space-verb)
	(setq end (point-marker))
	(goto-char beg)
	(while (re-search-forward "[\n\r]\\s-*" nil end)
	  (let ((replace-str " "))
	    (save-match-data
	      (cond
	       ((html2texi-texinfo-inside-comment-p)
		(setq replace-str nil))))
	      (and replace-str (replace-match replace-str t t)))))
	(goto-char end)
	(set-marker end nil))
    (insert (cadr pre-post))))


(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-i-simple-markup
  (html2texi-simple-markup "html2texi-i-simple-markup"
   :preamble "@emph{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-b-simple-markup
  (html2texi-simple-markup "html2texi-b-simple-markup"
   :preamble "@strong{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-kbd-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :preamble "@kbd{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-dfn-simple-markup
  (html2texi-simple-markup "html2texi-dfn-simple-markup"
   :preamble "@dfn{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-sub-simple-markup
  (html2texi-simple-markup "html2texi-sub-simple-markup"
   :preamble ""
   :postamble "")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<sub class=\"CLEF\">CONTENU</sub>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-sup-simple-markup
  (html2texi-simple-markup "html2texi-sup-simple-markup"
   :preamble ""
   :postamble "")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<sup class=\"CLEF\">CONTENU</sup>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-samp-simple-markup
  (html2texi-simple-markup "html2texi-samp-simple-markup"
   :preamble "@samp{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<samp class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-handle-two-columns-table-as-@table
  t
 "Si `nil' alors une table `<table>...</table>'
avec deux colonne sera gérée en texinfo par une `@table', si non
`nil', alors elle sera gérée par une `@multitable'."
  :type
  '(choice
    (const :tag "t pour @table" t)
    (const :tag "nil pour @multitable" nil))
  :group 'html2texi)


(defvar html2texi-document-information nil
  "Liste d'association pour mémoriser les informations (titre,
  auteurs, etc...) propres à un document.")

(defvar html2texi-xml-parsed nil
  "Résultat de l'analyse syntaxique d'un doc")

(defvar html2texi-xml-stack nil
  "Pile des expressions XML")

(defvar html2texi-keep-empty-strings nil
  "Non nil si les chaînes vides sont à conserver.")

(defvar html2texi-ignore-head nil
  "Non nil si on ignore le <head> (dans un fichier HTML lié).")

(defvar html2texi-directory-stack nil
  "Pile des chemins de répertoire.")

(defvar html2texi-files-doing-or-done nil
  "Liste des fichiers déjà traités, ou le fichier en cours de traitement.
Le fichier en cours de traitement est en première position dans cette liste.")

(defvar html2texi-files-to-do nil
  "Liste des fichiers non encore traités")

(defvar html2texi-flushable-anchors nil
  "Liste de nom d'ancrage de lien dont l'insertion a été remise à
  plus tard." )

(defvar html2texi-postpone-output nil
  "Non `nil' lorsque l'insertion du code est remise à plus tard")


(defvar html2texi-directory-ref nil
  "Répertoire de référence")

(defmacro html2texi-make-simple-markup-handler (tag)
  `(defun ,(intern (concat "html2texi-tag-handler-" (symbol-name tag)))
     (xml-expr)
     (html2texi-handle-simple-markup  
      ,(intern (concat "html2texi-"  (symbol-name tag) "-simple-markup")) 
      xml-expr) ))

(defun html2texi-make-html-clean-xml (beg end)
  (let  ((end-arg end)
	 end)
    (if (markerp end-arg)
	(setq end end-arg)
      (goto-char end-arg)
      (setq end (point-marker)))
    ;; rend les balise implicitement auto-closante vraiment auto-closante
    (goto-char beg)
   (while (re-search-forward (concat "<\\(" html2texi-suspicious-html-tags-re "\\)\\>")
			      end t)
      (let ((tag (match-string-no-properties 1)))
	(unless (re-search-forward ">" nil t)
	  (error "Clôture non trouvé pour la balise %s" tag))
	(when (null (looking-back "/>"))
	  (backward-char)
	  (insert "/")
	  (forward-char))))
    ;; marque de paragraph et de ligne
    (goto-char beg)
    (let (tag-stack p1 tag is-closure self-closing)
      (while (re-search-forward "<\\(/\\)?\\([a-zA-Z]+\\)\\>" end t)
	(setq p1 (match-beginning 0)
	      tag (match-string-no-properties 2)
	      is-closure (match-string-no-properties 1))
	(unless (string= tag (downcase tag))
	  (replace-match (setq tag (downcase tag)) 2))
	(unless (re-search-forward ">" end t)
	  (error "`Soufflet de clôture non trouvé pour la balise %s" tag))
	(setq self-closing (looking-back "/>"))
	(cond
	 ((and self-closing  is-closure)
	  (error "balise %s à la fois de clôture et auto-closante" tag))

	 (self-closing
	  ;; do nothing
	  )

	 ((null is-closure)
	  (when (and
		 (string-match (concat "\\`" html2texi-non-recursive-tags-re "\\'") tag)
		 tag-stack
		 (string= tag (caar tag-stack)))
	    ;; clôture
	    (save-excursion
	      (goto-char p1)
	      (insert "</" tag "><!-- HTML2TEXI: repaired (1) -->")
	      (warn "Fichier `%s', ligne %d ajout clôture `</%s>'"
		    (car html2texi-files-doing-or-done)
		    (line-number-at-pos)
		    tag))
	    (pop tag-stack))
	  (push (list tag) tag-stack))

	 (is-closure
	      (if (and tag-stack
		       (string= (caar tag-stack) tag))
		  (pop tag-stack)
		(let ((first (assoc-string tag tag-stack)) rev)
		  (if first
		      (progn
			(while (and tag-stack (null (eq (car tag-stack) first)))
			  (push (pop tag-stack) rev))
			(pop tag-stack)
			(save-excursion
			  (goto-char p1)
			  (dolist (c rev)
			    (insert  "</" (car c) "><!-- HTML2TEXI: repaired (2) -->" )
			     (warn "Fichier `%s', ligne %d ajout clôture `</%s>'"
				   (car html2texi-files-doing-or-done)
				   (line-number-at-pos)
				   tag))))
		    (error "Clôture de %s ne correspondant à aucune ouverture" tag)))))))

       
      (let (p-pos li-pos markup poss pos)
	(while (re-search-forward "<\\(/\\)?\\(p\\|li\\)\\>[^>]*>" end t)
	  (setq markup (match-string-no-properties 2)
		poss (intern (concat markup "-pos"))
		pos (symbol-value poss))
	  (if (match-string-no-properties 1)
	      (if  pos 
		  (if (= pos (match-beginning 0))
		      (set poss nil)
		    (error "Clôture de balise %s ne correspondant à aucune ouverture" (match-string-no-properties 0)))
		(save-excursion
		  (save-match-data
		    (unless  (re-search-forward 
			      (format "<\\(/\\)?\\(%s\\)\\>[^>]+>" markup) 
			      end t)
		      (error "Ouverture de balise <%s> sans clôture" markup))
		    (set poss (match-beginning 0))
		    (unless (match-string-no-properties 1)
		      (goto-char (match-beginning 0))
		      (insert (format "</%s>" markup))
		      (dolist (symb '(p-pos li-pos))
			(unless (or (null (symbol-value symb))
				 (eq symb poss))
			  (set symb (+ (length markup) 3 (symbol-value symb)))))))))))
	    ))
    ;; mise entre guillemets anglais des attributs entier sans guillemets
    (goto-char beg)
    (let (p1 p2 added-dquote-attributes p-start)
      ;; tant qu'on trouve potentiellement un attribut sans "..."
      (while (re-search-forward "\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([0-9]+\\)"
				nil end)
	(setq p1 (match-beginning 1)
	      p2 (match-end 0))
	(if
	    ;; si la position est bien entre < et >
	    (and (re-search-backward "[<>]" nil beg)
		 (string= (match-string-no-properties 0) "<")
		 (looking-at "<\\sw+")
		 (progn 
		   (goto-char (setq p-start (match-end 0)))
		   (re-search-forward "[<>]" nil beg)
		   (string= (match-string-no-properties 0) ">"))
		 (>= (point) p1))
	    ;; alors on fait la réparation
	    (progn
	      (goto-char p-start)
	      (while 
		  (progn
		    (while (looking-at "\\(?:\\s-\\|\n\\)*\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\"[^\"]*\"")
		      (goto-char (match-end 0)))
		    (cond
		     ((looking-at  "\\(?:\\s-\\|\n\\)*\\(\\sw+\\)\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([0-9]+\\)")
		      (push (match-string-no-properties 1) added-dquote-attributes)
		      (goto-char (match-beginning 2))
		      (insert ?\")
		      (goto-char (1+ (match-end 2)))
		      (insert ?\"))
		     ((looking-at "\\(?:\\s-\\|\n\\)*>") 
		      (goto-char (match-end 0))
		      (insert "<!-- HTML2TEXI inserted double quotes around values for attibutes" 
			      (mapconcat (lambda (x) (concat "`" x "'"))
					 added-dquote-attributes
					 ", ")
			      ">")
		      nil)
		     (t (error "Attribut au format invalide: %s"
			       (match-string-no-properties (point)
							      (+ p2 
								 (* 2 (length added-dquote-attributes))))))))))
	  ;; sinon on continue à chercher un attribut potentiel dont la valeur
	  ;; n'est pas entre "..."
	  (goto-char p2))))

    ;; un peu de ménage...
    (unless (markerp end-arg)
      (set-marker end nil)) ))

;;;==========================================================================
;;; définition des gestionnaires de balise
;;;--------------------------------------------------------------------------

(defun html2texi-tag-handler-a (xml-expr)
  (let (name href text (xml-expr-length (length xml-expr)))
    (dolist (attrib (cadr xml-expr))
      (cond
       ((eq (car attrib) 'href)
	(setq href (cdr attrib)))
       ((eq (car attrib) 'name)
	(setq name (cdr attrib)))))
    (and (cddr xml-expr)
	 (setq text (caddr xml-expr)))
    (cond
     (href (html2texi-process-url href text))
     ((= xml-expr-length 3)
      (cond 
       ((stringp text)
	(insert (html2texi-string-escape text t)))
       ((consp text) (html2texi-process-xml-expr text))
       (t (error "Le format du text de la balise <a> était inattendu"))))
     ((> xml-expr-length 3)
      (html2texi-process-xml-expr `(div nil ,@(cddr xml-expr)))))
    (and name
      (insert "\n@anchor{" (html2texi-make-anchor (concat "#" name)) "}\n"))))

(html2texi-make-simple-markup-handler b)

(defun html2texi-flush-anchors ()
  (while html2texi-flushable-anchors
    (insert "@anchor{" (pop html2texi-flushable-anchors) "}\n")))


(defun html2texi-tag-handler-h1 (xml-expr)
  (insert "@chapter " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))


(defun html2texi-tag-handler-h2 (xml-expr)
  (insert "@section " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))

(defun html2texi-tag-handler-h3 (xml-expr)
  (insert "@subsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
    (html2texi-flush-anchors))

(defun html2texi-tag-handler-h4 (xml-expr)
  (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))

(defun html2texi-tag-handler-h5 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
     (html2texi-flush-anchors))

(defun html2texi-tag-handler-h6 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
   (html2texi-flush-anchors))

(html2texi-make-simple-markup-handler samp)


(defun html2texi-get-col-span (xml-expr)
  ;; xml-expr is <td> or <th>
  (let ((col-span (cdr-safe (assq 'colspan (nth 1 xml-expr)))))
    (setq col-span
	  (cond
	   ((integerp 
	       (setq col-span
		     (if (stringp col-span) 
			 (string-to-number col-span)
		       col-span)))
	      col-span)
	   ((null col-span) 1)
	   (t (error "colspan invalide"))))  ))

(html2texi-make-simple-markup-handler sub)
(html2texi-make-simple-markup-handler sup)

(defvar html2texi-col-number nil)
(defvar html2texi-row-number nil)
(defvar html2texi-head-on-row-0 nil)
(defvar html2texi-col-count nil)
(defvar html2texi-col-info-length nil)

(defun html2texi-tag-handler-table (xml-expr)
  (let* (html2texi-col-count 
	(html2texi-row-number 0)
	html2texi-head-on-row-0
	html2texi-col-number
	;; le premier élément ne correspond pas à une colonne mais servira à
	;; reduire le vecteur des informations sur chaque colonne
	(html2texi-col-info (list 0))
	(html2texi-col-info-last html2texi-col-info)
	(html2texi-col-info-length 0)
	(xml-items (cddr xml-expr)))
    (while xml-items
      (let ((xml-expr (pop xml-items)))
	(cond
	 ((and (consp xml-expr)
	       (eq (car xml-expr) 'tr))
	  ;; plus besoin de chercher une ligne: on compte les colonnes sur la
	  ;; première ligne trouvée
	  (setq xml-items nil)
	  (dolist  (xml-expr (cddr xml-expr))
	    (cond
	     ((consp xml-expr)
	      (if (memq  (car xml-expr) '(th td))
		  (progn
		    (setq html2texi-col-count
			  (+ (or html2texi-col-count 0) (html2texi-get-col-span xml-expr)))
		    (when (> html2texi-col-count html2texi-col-info-length)
		      (let ((l (make-list (- html2texi-col-count html2texi-col-info-length) '(abs 1))))
			(setcdr html2texi-col-info-last l)
			(setq html2texi-col-info-last (last l)
			      html2texi-col-info-length html2texi-col-count))))
		(error "balise inattendu dans une table")))
	     ((stringp xml-expr)
	      (unless (string-match 
		       "\\`\\s-*\\(\n\\s-*\\)*\\'" 
		       xml-expr)
		(error "Chaîne inattendue")))
	     (t (error "Élément inattendu")))))
	 ((stringp xml-expr)
	  (unless (string-match 
		   "\\`\\s-*\\(\n\\s-*\\)*\\'" 
		   xml-expr)
	    (error "Chaîne inattendue")))
	 (t (error "Élément inattendu")))))


    
    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(progn
	  (insert "@multitable @columnfractions ")
	  (let ((total-weight 
		  (math-reduce-vec 
		   (lambda (r x)
		     (+ r
			(cond 
			 ((eq (car x) 'abs) (cadr x))
			 ((eq (car x) 'rel) 
			  (setcar x 'abs)
			  (setcar (cdr x) (*  (cadr x) html2texi-col-info-length))
			  (cadr x)))))
		   (cons 'vec html2texi-col-info))))
		(insert (mapconcat 
			 (lambda (x)
			   (number-to-string
			    (/ (float (cadr x)) html2texi-col-info-length)))
			 (cdr html2texi-col-info)
			 " ")))
	  (insert "\n"))
      (insert "@table\n"))

    (html2texi-process-xml-expr xml-expr)

    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(insert "@end multitable\n")
      (insert "@end table\n"))))


(defun html2texi-tag-handler-tr (xml-expr)
  (setq html2texi-col-number 0)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n")
  (setq html2texi-row-number (1+ html2texi-row-number)))

(defun html2texi-tag-handler-th (xml-expr)
  (if   (= 0 html2texi-col-number)
      (if (and (= 0 html2texi-row-number)
	       (null html2texi-handle-two-columns-table-as-@table))
	  (progn
	    (setq html2texi-head-on-row-0 t)
	    (insert "@headitem ")
	    (html2texi-process-xml-expr xml-expr))
	(insert "@item ")
	(html2texi-process-xml-expr xml-expr))
    (when (or (> html2texi-col-count 2)
	      (null html2texi-handle-two-columns-table-as-@table))
      (insert "@tab "))
    (html2texi-process-xml-expr xml-expr)
    (unless (and  (= 0 html2texi-row-number) html2texi-head-on-row-0)
	(insert "\n")))
  (setq html2texi-col-number (1+ html2texi-col-number)))

(defun html2texi-tag-handler-td (xml-expr)
  (if (= 0 html2texi-col-number)
	(insert "@item ")
    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
      (insert "@tab ")))
  (html2texi-process-xml-expr xml-expr)
  (insert "\n")
  (setq html2texi-col-number (1+ html2texi-col-number)))


(defun html2texi-cur-dir ()
  "Détermine le répertoire courant relativement au répertoire du
HTML racine de départ. La valeur retournée se termine par une oblique `/'"
  (let ((cur-dir  (nreverse (split-string (cdar html2texi-directory-stack) "/")))
	(ref-dir  (nreverse (split-string html2texi-directory-ref "/"))))
    (unless (and (string= (car cur-dir) "")
		 (string= (car ref-dir) ""))
      (error "Format invalide de répertoire"))
    (setq cur-dir (nreverse (cdr cur-dir))
	  ref-dir (cdr ref-dir))
    (if (or (string= (car cur-dir) "")
	    (string-match "\\`[a-z]:" (car cur-dir)))
	;; cur-dir est un chemin absolu
	(progn
	  (setq ref-dir (nreverse ref-dir))
	  (while (and cur-dir ref-dir (string= (car cur-dir) (car ref-dir)))
	    (setq cur-dir (cdr cur-dir)
		  ref-dir (cdr ref-dir)))
	  (while ref-dir
	    (push ".." cur-dir)
	    (setq ref-dir (cdr ref-dir)))
	  (concat (mapconcat 'identity cur-dir "/") "/"))
      (while (and cur-dir
		  (cond
		   ((string= (car cur-dir) "..")
		    (unless ref-dir
		      (error "Chemin invalide"))
		    (setq ref-dir (cdr ref-dir)
			  cur-dir (cdr cur-dir)))
		   ((string= (car cur-dir) ".")
		    (setq cur-dir (cdr cur-dir)))
		   (t nil))))
      (dolist (e cur-dir)
	(push e ref-dir))
      (mapconcat 'identity  (nreverse (cons "" ref-dir)) "/") )))

(defun html2texi-anchor-escape (anchor)
  (let (ret)
    (setq anchor
	  (mapconcat 
	   'identity 
	   (split-string anchor "-") "--"))
    (mapc 
     (lambda (x) 
       (if
	(or (and (>= x ?a) (<= x ?z))
	     (and (>= x ?A) (<= x ?Z))
	     (and (>= x ?0) (<= x ?9))
	     (member x '(?_ ?- ?/)))
	   (push (string x) ret)
	 (push (format "-%04x" x) ret)))
     anchor)
    (apply 'concat (nreverse ret))))

(defun html2texi-make-anchor (name)
  (let* ((anchor (expand-file-name (concat (html2texi-cur-dir) name)))
	 (l-a (length anchor))
	 (l-r (length html2texi-directory-ref))
	 (l (min l-a l-r))
	 (start 0)
	 (i -1))
    (while (and
	    (< (setq i (1+ i)) l)
	    (prog1
		(= (aref anchor i) (aref html2texi-directory-ref i))
	      (and (= (aref anchor i) ?/)
		   (setq start (1+ i))))))
    (setq anchor (list (substring anchor start)))
    (dotimes (i (length (split-string (substring html2texi-directory-ref start))))
      (push "../" anchor))
    (html2texi-string-escape (mapconcat 'html2texi-anchor-escape anchor ""))))

(defun html2texi-tag-handler-body (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))


(html2texi-make-simple-markup-handler code)

(defun html2texi-tag-handler-br (xml-expr)
  (insert "@*\n"))

(defun html2texi-tag-handler-div (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(html2texi-make-simple-markup-handler dfn)

(defun html2texi-tag-handler-dl (xml-expr)
  (insert "@table @asis\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "@end table\n"))

(defun html2texi-tag-handler-dt (xml-expr)
  (insert "@item ")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(defun html2texi-tag-handler-dd (xml-expr)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(defun html2texi-tag-handler-frameset (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-frame (xml-expr)
  (let (url text)
    (dolist (x (cadr xml-expr))
      (cond 
       ((eq (car x) 'src)
	(setq url (cdr x)))
       ((eq (car x) 'name)
	(setq text (cdr x)))))
    (when url
      (html2texi-process-url url text))))

(defun html2texi-simple-markup-handle (xml-expr class-alist preamble postamble)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe 
			(and class-attribute
			     (assoc-string (cdr class-attribute) class-alist)))
		      (list preamble postamble))))
    (insert (car pre-post))
   (html2texi-process-xml-expr xml-expr)
   (insert (cadr pre-post))))

(defun html2texi-tag-handler-hr (xml-expr)
  (insert "@c <hr/>\n"))

(html2texi-make-simple-markup-handler kbd)

(defun html2texi-handle-string (str)
  (let (ret (pos0 0) pos1 (len (length str)))
    (while (and 
	    (< pos0 len)
	    (setq pos1 (string-match "[{}@]" str pos0)))
      (push (substring str pos0 pos1) ret)
      (push (concat "@" (match-string 0 str)) ret)
      (setq pos0 (1+ pos1)))
    (when (< pos0 len)
      (push (substring str pos0 pos1) ret))
    (apply 'concat (nreverse ret))))


(defun html2texi-error (format-str xml-expr &rest args)
  (apply 'error (concat format-str
			"
-----------------------------------------------------------------------------
xml-expr=%S
xml-stack=%S
-----------------------------------------------------------------------------")
	 `( ,@args ,xml-expr ,html2texi-xml-stack)))

(defun html2texi-process-url (url text)
  (let* ((parsed-url (url-generic-parse-url url))
	 url-list
	 i file-name locator)
    ;; petit hack parce que url-generic-parse-url ne fait pas complètement le
    ;; boulot
    (when (and
	   (null  (aref parsed-url 1))
	   (setq i (string-match "#" (aref parsed-url 6)))
	   (null (aref parsed-url 7)))
      (aset parsed-url 7 (substring (aref parsed-url 6) (1+ i)))
      (aset parsed-url 6 (substring (aref parsed-url 6) 0 i)))

    (push "@uref{" url-list) ; ça peut être défait ensuite
    ;; URL
    (if (and (eq (aref parsed-url 0) 
		 'cl-struct-url)
	     (null (aref parsed-url 1)))
	;; cas où il n'y a pas de protocole
	(cond
	 ;; on point vers un fichier HTML, ce n'est donc pas une URL interne
	 ;; => cas suspect
	 ((member (file-name-extension 
		   (setq file-name (aref parsed-url 6)))
		  '("html" "htm"))
	  (setq file-name (expand-file-name
			   file-name
			   (file-name-directory (car html2texi-files-doing-or-done))))
	  (unless (member file-name html2texi-files-doing-or-done)
	    (add-to-list 'html2texi-files-to-do file-name))
	  (when (aref parsed-url 7)
	    (setq file-name (concat file-name "#" (aref parsed-url 7))))
	  (push (html2texi-string-escape file-name) url-list))
	 
	 ;; cas d'une URL interne
	 ((and (string= "" file-name) 
	       (setq locator (aref parsed-url 7)))
	  (pop url-list)
	  (push "@ref{" url-list)
	  (push (html2texi-make-anchor (concat "#" locator)) url-list))

	  (t 
	    (push (html2texi-string-escape url) url-list)))
        (push (html2texi-string-escape url) url-list))
     ;; Text
     (when text 
       (push "," url-list)
       (push (html2texi-string-escape text) url-list)) 
     (push "}" url-list)
     (apply 'insert (nreverse url-list))))


(html2texi-make-simple-markup-handler i)

(defun html2texi-tag-handler-li (xml-expr)
  (insert "\n@item\n")
  (unless (memq (caadr html2texi-xml-stack) '(ol ul))
    (html2texi-error "<li> était inattendu" xml-expr))
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-link (xml-expr)
  )

(defun html2texi-tag-handler-ol (xml-expr)
  (insert "\n@enumerate")
   (html2texi-process-xml-expr xml-expr)
  (insert "\n@end enumerate\n"))

(defun html2texi-tag-handler-p (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(defun html2texi-tag-handler-ul (xml-expr)
  (insert "\n@itemize")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n@end itemize\n"))

(defun html2texi-tag-handler-span (xml-expr)
  (insert "@c span: (<span #1>#2</span> => #2.")
  (html2texi-default-handling xml-expr "span: ")
  (html2texi-process-xml-expr xml-expr)
  (insert "@c span: )\n"))

(defun html2texi-tag-handler-style (xml-expr)
  )

(defun html2texi-tag-handler-meta (xml-expr)
  (unless (and (nth 1 html2texi-xml-stack) 
	       (eq (caadr html2texi-xml-stack) 'head))
    (html2texi-error "<meta> inattendu." xml-expr))
  ;; traitement du meta...
  (let* ((attribute-list (nth 1 xml-expr))
	 (name (assq 'name attribute-list))
	 (content (assq 'content attribute-list)))
    (when (and (consp name) 
	       (consp content)
	       (progn
		 (setq name (cdr name)
		       content (cdr content))
		 (stringp name))
	       (stringp content))
      (cond
       ((string= name "author")
	(html2texi-set-doc-info 'author content))
       ((string= name "language")
	(when (string-match "\\`\\([a-z]\\{2\\}\\(-[A-Z]\\{2\\}\\)?\\)\\'" content)
	  (let ((language (match-string-no-properties 1 content)))
	    (when (= (length language) 5)
	      (aset language 2 ?_))
	    (html2texi-set-doc-info 'language language))))))))

(defun html2texi-tag-handler-pre (xml-expr)
  (let ((kes html2texi-keep-empty-strings))
    (setq html2texi-keep-empty-strings t)
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-keep-empty-strings kes)))

(defun hmtl2texi-to-plain-text (xml-expr &rest flags)
  (let (ret anchor)
    (dolist (xml-expr (cddr xml-expr))
      (cond
       ((stringp xml-expr)
	(push xml-expr ret))
       ((consp xml-expr)
	(push xml-expr html2texi-xml-stack)
	(cond
	 ((and (eq (car xml-expr) 'a)
	       (setq anchor (assq 'name (nth 1 xml-expr))))
	  (push (html2texi-make-anchor (concat "#" (cdr anchor))) 
		html2texi-flushable-anchors) ))
	(let ((str  (hmtl2texi-to-plain-text xml-expr)))
	  (and (null (string= str ""))
	       (push str ret)))
	(pop html2texi-xml-stack))
       (t (html2texi-error "Expression XML inattendue." xml-expr))))
    (setq  ret (mapconcat 'identity (nreverse ret) " "))
    (if (memq :one-line flags)
	(mapconcat 'identity (split-string ret "\n") " ")
      ret)))


(defun html2texi-tag-handler-title (xml-expr)
  (unless (and  (nth 1 html2texi-xml-stack)
		(eq  (caadr html2texi-xml-stack) 'head))
    (html2texi-error "<title> inattendu." xml-expr))
  (setq xml-expr (cddr xml-expr))
  (let ((str  (hmtl2texi-to-plain-text xml-expr)))
    (setq str (split-string str "\n")
	  str (mapconcat 'identity str " "))
    (unless (string= str "")
      (html2texi-set-doc-info 'title str))))

(defun html2texi-string-escape (str &optional flatten)
  (cond
   ((stringp str)
    (with-temp-buffer
      (insert str)
      (goto-char (point-min))
      (while (re-search-forward "[,@{}]" nil t)
	(cond 
	 ((string= (match-string-no-properties 0) ",")
	  (replace-match "@comma{}"))
	 ((member (match-string-no-properties 0) '("@" "{" "}"))
	  (replace-match (concat "@" (match-string-no-properties 0))))))
      (when flatten
	(goto-char (point-min))
	(while (re-search-forward "\n\\(\\s-*\\)" nil t)
	  (replace-match (if (> 0 (length (match-string 1))) " " "") t t)))      
      (buffer-substring (point-min) (point-max))))
   ((and (consp str) (car-safe str))
    (cond
     ((eq (car str) 'span)
      (with-temp-buffer 
	(insert "@c span: (<span #1>#2</span> => string-escape of #2.")
	(html2texi-default-handling str "span: ")
	(insert (html2texi-string-escape  (nth 2 str) flatten))
	(insert "@c span: )\n")
	(buffer-substring (point-min) (point-max))))
     (t (html2texi-error "Un chaîne était attendue" str))))
   (t  (html2texi-error "Un chaîne était attendue" str))))

(defun html2texi-tag-handler-img (xml-expr)
  (let (filename width height alttext extension)
    (dolist (x (cadr xml-expr))
      (cond
       ((eq (car x) 'src)
	(setq filename (cdr x)))
       ((eq (car x) 'alt)
	(setq alttext (cdr x)))))
    (unless filename
      (html2texi-error "src=... était attendu" xml-expr))
    (setq extension (file-name-extension filename)
	  filename (file-name-sans-extension filename))
    (when (member extension '("png" "jpg" "jpeg" "eps" "txt"))
      (setq extension nil))
    (insert "@image{" (html2texi-make-anchor filename))
    (let ((remainder (list width height alttext extension)))
	(while remainder
	  (if (let (non-empty)
		(mapc (lambda (x) (setq non-empty (or non-empty (stringp x)))) 
		      remainder)
		non-empty)
	      (insert "," (or (pop remainder) "") )
	    (setq remainder nil); rompt la boucle (while remainder...)
	    ))
	(insert "}"))))

(defun html2texi-set-doc-info (tag val)
  (let ((info (assq tag html2texi-document-information)))
    (if info
	(setcdr info val)
      (push (cons tag val) html2texi-document-information))))

(defun html2texi-tag-handler-head (xml-expr)
  (unless html2texi-ignore-head
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-ignore-head t)))

(defun html2texi-tag-handler-noframes (xml-expr)
  )

(if (boundp 'html2texi-handler-hash-table)
    (makunbound 'html2texi-handler-hash-table))
	    
(defconst html2texi-handler-hash-table
  (let ((ht (make-hash-table)))
    (dolist (v '(a b body code dfn dl dt dd i kbd li p hr div ol ul pre
    head meta title frameset frame noframes span table th tr td h1 h2
    h3 h4 h5 h5 link br img samp style sup sub))
      (puthash v (symbol-function (intern (concat "html2texi-tag-handler-" (symbol-name v))))
	       ht))
    ht)
  "Table de hashage des traitement associé à chaque balise HTML"
  )

(defun html2texi-remove-empty-strings (xml-expr)
  (setq xml-expr (cdr xml-expr))
  (save-match-data
  (while (cdr xml-expr)
    (if (and (stringp (cadr xml-expr)) 
	     (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'" (cadr xml-expr)))
	(setcdr xml-expr (cddr xml-expr))
      (setq xml-expr (cdr xml-expr))))))

(defun html2texi-process-xml-expr (xml-expr)
  (push xml-expr html2texi-xml-stack)
  (dolist (xml-expr (cddr xml-expr))
    (cond
     ((consp xml-expr)
      (push xml-expr html2texi-xml-stack)
      (let ((handler (gethash (intern (downcase (symbol-name (car xml-expr))))
			      html2texi-handler-hash-table)))
	(if handler
	    (funcall handler  xml-expr)
	  (html2texi-default-handling xml-expr)))
      (pop html2texi-xml-stack))
     ((stringp xml-expr)
      (and (or html2texi-keep-empty-strings
	       (null (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'"  xml-expr)))
	   (insert (html2texi-handle-string xml-expr))))
     (t (error "Expression XML inattendue %S" xml-expr))))
  (pop html2texi-xml-stack))

(defun html2texi-default-handling (xml-expr &optional prompt)
  (let ((str (split-string (prin1-to-string xml-expr) "\n")))
    (dolist (str-line str)
      (insert "\n@c " (or prompt "") str-line)))
    (insert "\n"))

(defun html2texi-process-region (beg end)
  (goto-char end)
  (let ((end (point-marker)) 
	xml-expr)

    ;; Suppression de tout ce qui est en dehors des balise <html> ... </html>
    (goto-char beg)
    (unless (re-search-forward "<html" end t)
      (error "Balise <html> non trouvée"))
    (delete-region beg (match-beginning 0))
    (unless (re-search-forward ">" end t)
      (error "Clôture de la balise <html> trouvéee"))
    (unless  (re-search-forward "</html" end t)
      (error "Balise </html> non trouvée trouvée"))
    (unless (re-search-forward ">" end t)
      (error "Clôture de la balise </html> trouvée"))
    (delete-region (match-end 0) end)
    
    (html2texi-make-html-clean-xml beg end)
    
    (setq xml-expr (xml-parse-region (point-min) (point-max)))
    (delete-region beg end)
    (set-marker end nil)
    xml-expr))

(if t
;; plus partique pour déboguer qu'un vrai tampon temporaire
    (defmacro html2texi-with-temp-buffer (&rest body)
      (let ((cur-buff (make-symbol "cur-buff")))
	`(with-current-buffer 
	       (let (( ,cur-buff (get-buffer "*HTML2TEXI Temp*")))
		 (and ,cur-buff (kill-buffer ,cur-buff))
		 (get-buffer-create "*HTML2TEXI Temp*"))
       (erase-buffer) 
       ,@body)))
  ;;
  (defmacro html2texi-with-temp-buffer (&rest body) 
    `(with-temp-buffer ,@body)))



(defun html2texi-make-texi-buffer (&optional buffer )
  (let* ((start-buffer (or buffer (current-buffer)))
	 xml-expr
	 (start-filename  (or (buffer-file-name start-buffer) (buffer-name)))
	 (start-filename-ext (file-name-extension start-filename))
	 (texi-buffer-name 
	  (concat (concat  (file-name-sans-extension   (file-name-nondirectory start-filename)) 
			    ".texi")))
	 done-links-list
	 texi-buffer

	 html2texi-document-information 
	 html2texi-keep-empty-strings
	 html2texi-xml-parsed 
	 html2texi-xml-stack 
	 html2texi-ignore-head
	 html2texi-directory-stack
	 html2texi-flushable-anchors
	 html2texi-directory-ref
	 html2texi-files-doing-or-done
	 html2texi-files-to-do)
    (unless (or (member start-filename-ext '("html" "htm"))
		(y-or-n-p (format "le tampon %s n'a pas une extension html, continuer?"
				  start-filename)))
      (error "Fichier sans extension html"))
    (setq texi-buffer (get-buffer-create texi-buffer-name))
    (set-buffer texi-buffer)
    (erase-buffer)
    (insert (with-current-buffer start-buffer
	      (save-restriction
		(widen)
		(buffer-substring (point-min) (point-max)))))
    (accents-de-html)
    (push (cons default-directory "./") html2texi-directory-stack)
    (push start-filename html2texi-files-doing-or-done)
    (setq html2texi-directory-ref default-directory)
    
    (setq xml-expr (html2texi-process-region (point-min) (point-max)))
    (unless (eq 'html (caar xml-expr))
      (error "Résultat d'analyse XML inattendu"))
    (setq xml-expr (car xml-expr))
    (html2texi-process-xml-expr xml-expr)
    (while html2texi-files-to-do
      (setq file-name (pop html2texi-files-to-do))
      (if (file-exists-p file-name)
	  (progn
	    (push file-name html2texi-files-doing-or-done) 
	    (let* ((dir (file-name-as-directory
			 (file-name-directory file-name)))
		   (rel-dir   (let ((d
				     (file-name-directory
				      (file-relative-name file-name html2texi-directory-ref))))
				(if d (file-name-as-directory d)
				  "./"))))
	      (push (cons dir rel-dir) html2texi-directory-stack)
	      (html2texi-with-temp-buffer
	       (insert-file-contents file-name)
	       (accents-de-html)
	       (html2texi-make-html-clean-xml (point-min) (point-max))
	       (setq xml-expr (html2texi-process-region (point-min) (point-max))))
	      (unless (eq 'html (caar xml-expr))
		(error "Résultat d'analyse XML inattendu"))
	      (setq xml-expr (car xml-expr))
	      (html2texi-process-xml-expr xml-expr)
	      (pop html2texi-directory-stack)	))
	(warn "Le fichier `%s' n'existe pas!" file-name)))))

(defun html2texi-insert-doc-info ()
  (let ((author 
	 (html2texi-string-escape 
	  (or (cdr-safe (assq 'author html2texi-document-information)) "AUTHOR")))
	(title 	 (html2texi-string-escape 
		  (or (cdr-safe (assq 'title html2texi-document-information)) "TITLE")))
	(language 	 (html2texi-string-escape 
			  (or (cdr-safe (assq 'language html2texi-document-information)) "LANGUAGE"))))
    
    (goto-char (point-min))
    (insert "\\input texinfo   @c -*-texinfo-*-
@setfilename " (file-name-sans-extension (buffer-name)) ".info
@documentlanguage " language "
@copying
This manual is for PROGRAM, version VERSION.

Copyright @copyright{} YEARS COPYRIGHT-OWNER.

@quotation
Permission is granted to ...
@end quotation
@end copying

@titlepage
@title " title "@c NAME-OF-MANUAL-WHEN-PRINTED
@c @subtitle SUBTITLE-IF-ANY
@c @subtitle SECOND-SUBTITLE
@author " author "

@c  The following two commands
@c  start the copyright page.
@page
@vskip 0pt plus 1filll
@insertcopying

Published by ...
@end titlepage

@c So the toc is printed at the start.
@contents

@ifnottex
@node Top
@top TITLE

This manual is for PROGRAM, version VERSION.
@end ifnottex
")
    (goto-char (point-max))
    (insert "
@bye") ))

(defun html2texi-post-process ()
  "Remplace les double lignes vides en ligne vides simples."
  (goto-char (point-min))
  (while (re-search-forward "\\(^[ \t]*\n\\)\\{2,\\}" nil t)
    (replace-match "\n"))
  (normal-mode))

;;;###autoload
(defun html2texi ()
  (interactive)
  (html2texi-make-texi-buffer)
  (html2texi-insert-doc-info)
  (html2texi-post-process))

;;; html-to-texinfo.el ends here


Revision-number: 11
Prop-content-length: 228
Content-length: 228

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2011-05-16T20:43:29.000000Z
K 7
svn:log
V 125
- Ajout d'info sur l'installation, notamment le chargement en mémoire de html-to-texi
- Ajout remerciement à S. Ruette

PROPS-END

Node-path: trunk/doc/html-to-texi.texi
Node-kind: file
Node-action: change
Text-content-length: 6365
Text-content-md5: 7761625f74d471c7801bb0fa45f1551b
Content-length: 6365

\input texinfo   @c -*- mode: texinfo; coding: iso-8859-15-unix -*-
@c %**start of header
@setfilename html-to-texi.info
@set VERSION $Id: html-to-texi.texi,v 1.2 2011-05-16 20:43:29 Vincent Exp $
@set TEXINFO @acronym{Texinfo}
@set HTML-TO-TEXI @code{html-to-texi}
@set HTML-TO-TEXI-DOT-EL @code{html-to-texi}
@set HTML-TO-TEXI-FILE @file{html-to-texi.el}
@set ACCENTS-ASCII-FILE @file{accents-ascii.el}
@settitle @value{HTML-TO-TEXI}@comma{} un convertisseur de HTML en @value{TEXINFO} pour EMACS
@documentencoding ISO-8859-15
@documentlanguage fr
@c %**end of header
@copying
Ceci est la documentation du paquetage  html-to-texi, version @value{VERSION}
Copyright @copyright{} 2011 Vincent Belaïche.


L'utilisation de @value{HTML-TO-TEXI} est permise selon les termes de la
license CeCILL v2.
@end copying

@dircategory Emacs
@direntry
*  html-to-texi: (html-to-texi). Un paquetage @acronym{EMACS} pour convertir du code @acronym{HTML} en code @value{TEXINFO}.
@end direntry

@titlepage
@title @value{HTML-TO-TEXI}, manuel d'utilisation
@subtitle @value{HTML-TO-TEXI}@comma{} un convertisseur de @acronym{HTML} en @value{TEXINFO} pour @acronym{EMACS}
@author Vincent Belaïche

@c  The following two commands
@c  start the copyright page.
@page
@vskip 0pt plus 1filll
@insertcopying
@c Publié par Vincent Belaïche
@end titlepage

@c Production de la table des matières
@contents

@ifnottex
@c --------------------------------------------------------------------------------
@node Top,,,(dir)top
@top N½ud chapeau.

Ceci est le manuel du paquetage html-to-texi d'Emacs.
@end ifnottex

@menu
* Vue d'ensemble:: Vue d'ensemble.
* Installation:: Comment installer le paquetage html-to-texi.
* Les Bases:: html-to-texi pour le débutant.
* Expérimenté:: html-to-texi pour l'utilisateur expérimenté.
* Indexes:: Indexes des concepts, commandes, et variables.
* Quoi d'neuf:: Ce qui est nouveau pour le paquetage html-to-texi.
* Remerciements:: .
@end menu

@node Vue d'ensemble, Installation,,                 Top
@chapter Vue d'ensemble

@value{HTML-TO-TEXI} permet de convertir un document @acronym{HTML} en un
document @value{TEXINFO}. Pour l'utiliser on procède comme cela :@*

@enumerate
@item
Lancer @acronym{EMACS}.
@item
Ouvrir dans @acronym{EMACS} le fichier @acronym{HTML} chapeau du
document @acronym{HTML}, ce fichier se nomme en général
@file{index.html}, ce que l'on suppose par la suite, et est la racine de
l'arbre des fichier @acronym{HTML} constitutif du document
@acronym{HTML} à convertir. Il se peut aussi que votre document
@acronym{HTML} ne soit constitué que d'un seul fichier pour tout le
document, dans ce cas c'est celui-ci qu'il faut ouvrir.
@item
S'assurer que le paquetage @value{HTML-TO-TEXI-DOT-EL} est chargé, ou se
chargera. Ceci peut être déjà fait si le chargement est effectué
automatiquement au lancement d'@acronym{EMACS} ou à l'ouverture d'un
fichier @acronym{HTML}, ou encore si le paquetage
@value{HTML-TO-TEXI-DOT-EL} est en chargment automatique
(@pxref{LoadLisp}).
@item
Alors que sous @acronym{EMACS} le tampon courant est @file{index.html},
lancer la commande @code{M-x html2texi}, cela crée un tampon
@file{index.texi} contenant le code @value{TEXINFO} résultant de la
conversion. Attention : si le tampon @file{index.texi} existait déjà,
alors il est effacé.
@item
Enregistrer le tampon @file{index.texi} en un fichier à votre
convenance.
@end enumerate


@node Installation, Les Bases, Vue d'ensemble, Top
@chapter Comment installer le paquetage @value{HTML-TO-TEXI}

@menu
* InstallDoc:: Installation de la documentation
* InstallLisp:: Installation des fichiers Lisp
* LoadLisp:: chargement du code Lisp en mémoire
@end menu

@node InstallDoc, InstallLisp, , Installation
@section Installation de la documentation
@comment  node-name,  next,  previous,  up

@node InstallLisp, LoadLisp, InstallDoc,  Installation
@section Installation du code lisp
@comment  node-name,  next,  previous,  up

Le paquetage @value{HTML-TO-TEXI} comprend deux fichiers en langage
emacs-lisp, respectivement @value{HTML-TO-TEXI-FILE} et
@value{ACCENTS-ASCII-FILE}. La première chose à faire est de placer ces
fichiers, ou une copie de ces fichiers dans un répertoire où
@acronym{EMACS} saura les trouver, c'est à dire un répertoire déclaré
dans la variable @code{load-path}. Inversement, vous pouvez rajouter
dans cette variable un nouveau chemin de répertoire pour le répertoire
où se trouvent ces fichiers.

@node LoadLisp, , InstallLisp, Installation
@comment  node-name,  next,  previous,  up
@section Chargement du code lisp

Pour que la commande @code{M-x html2texi} puisse s'exécuter il faut que
le code Lisp correspondant soit chargé en mémoire. Pour obtenir ce
résultat il y a plusieurs façon de faire, chacune ayant ses avantage est
ses inconvénients.

@menu
* InitLoad:: Chargement systématique au lancement d'@acronym{EMACS}
* HTMLLoad:: Chargement à l'ouverture d'un fichier en mode @code{HTML}
* AutoLoad:: Chargement à l'appel de @code{M-x html2texi}
@end menu

@node InitLoad, HTMLLoad, LoadLisp, LoadLisp
@comment  node-name,  next,  previous,  up
@subsection  Chargement systématique au lancement d'@acronym{EMACS}

@node HTMLLoad, AutoLoad, InitLoad, LoadLisp
@comment  node-name,  next,  previous,  up
@subsection  Chargement à l'ouverture d'un fichier en mode @code{HTML}

@node AutoLoad,  , HTMLLoad, LoadLisp
@comment  node-name,  next,  previous,  up
@subsection  Chargement à l'appel de @code{M-x html2texi}

@node Les Bases,      Expérimenté,   Installation,   Top 
@chapter  html-to-texi pour le débutant

@node Expérimenté, Indexes, Les Bases, Top
@chapter html-to-texi pour l'utilisateur expérimenté

@menu
* AutoLoad:: Charger automatiquement @value{HTML-TO-TEXI-DOT-EL}
@end menu

@node AutoLoad, , , Expérimenté
@comment  node-name,  next,  previous,  up
@section Charger automatiquement @value{HTML-TO-TEXI-DOT-EL}

@node Indexes,        Quoi d'neuf,   Expérimenté,    Top 
@chapter Indexes des concepts, commandes, et variables

@node Quoi d'neuf,    Remerciements, Indexes,        Top 
@chapter  Ce qui est nouveau pour le paquetage html-to-texi

@node Remerciements,,                Quoi d'neuf,    Top 
@chapter Remerciements

Remerciements à Sylvie Ruette pour ses macros de conversion de lettres
accentuées en divers formats.

@bye



@c Local Variables: 
@c mode: texinfo
@c TeX-master: t
@c End: 


Revision-number: 12
Prop-content-length: 776
Content-length: 776

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2012-01-28T07:23:48.000000Z
K 7
svn:log
V 673
- Rend la variable html2texi-document-information locale au tamon .texi plutôt que variable de `let'.
- Ajout traitement balises tt et html
- dans fonction `html2texi-make-anchor', ajout passage optionel d'une fonction d'échappement.
- dans fonction `html2texi-tag-handler-meta', ajout traitement attribut http-equiv
- dans fonction `html2texi-set-doc-info' ajout docstring
- dans fonction `html2texi-insert-doc-info', mise de @documentlanguage en commentaire si ce n'est pas un langage valide
- dans fonction `html2texi-insert-doc-info', génération d'un cookie EMACS de codage de caractères compatible avec la déclaration Texinfo d'encodage du document.

PROPS-END

Node-path: trunk/lisp/html-to-texinfo.el
Node-kind: file
Node-action: change
Text-content-length: 45375
Text-content-md5: 758ae3a4b30399c4faa2c5fa2a38dbdf
Content-length: 45375

;;; html-to-texinfo.el --- -*- coding: iso-8859-1 -*-
;; Copyright 2010/2012 Vincent Belaïche
;;
;; Author: Vincent Belaïche <vincent.b.1@hotmail.fr>
;; Version: $Id: html-to-texinfo.el,v 1.6 2012-01-28 07:23:48 Vincent Exp $
;; Keywords:
;; X-URL: not distributed yet
;;
;; This software is governed by the CeCILL license under French law and
;; abiding by the rules of distribution of free software.  You can  use,
;; modify and/ or redistribute the software under the terms of the CeCILL
;; license as circulated by CEA, CNRS and INRIA at the following URL
;; "http://www.cecill.info".
;;
;; As a counterpart to the access to the source code and  rights to copy,
;; modify and redistribute granted by the license, users are provided only
;; with a limited warranty  and the software's author,  the holder of the
;; economic rights,  and the successive licensors  have only  limited
;; liability.
;;
;; In this respect, the user's attention is drawn to the risks associated
;; with loading,  using,  modifying and/or developing or reproducing the
;; software by the user in light of its specific status of free software,
;; that may mean  that it is complicated to manipulate,  and  that  also
;; therefore means  that it is reserved for developers  and  experienced
;; professionals having in-depth computer knowledge. Users are therefore
;; encouraged to load and test the software's suitability as regards their
;; requirements in conditions enabling the security of their systems and/or
;; data to be ensured and,  more generally, to use and operate it in the
;; same conditions as regards security.
;;
;; The fact that you are presently reading this means that you have had
;; knowledge of the CeCILL license and that you accept its terms.
;;
;;; Commentary:

;;

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'html-to-texinfo)

;;; Code:

(provide 'html-to-texinfo)
(eval-when-compile
  (require 'cl))
(require 'eieio)
(require 'calc-ext)
(require 'accents-ascii)

;;;;##########################################################################
;;;;  User Options, Variables
;;;;##########################################################################

(defconst html2texi-suspicious-html-tags
  '("meta" "br" "hr" "link" "img" "frame")
"Liste des balises pour lesquelles le HTML ne suit pas une
syntaxe strictement XML. Par exemple `<br>' est utilisé au lieu
de `<br/>'."  )

(defconst html2texi-suspicious-html-tags-re
  (regexp-opt html2texi-suspicious-html-tags))

(defconst html2texi-non-recursive-tags
  '("p" "li"))

(defconst html2texi-non-recursive-tags-re
  (regexp-opt html2texi-non-recursive-tags))

(defconst html2texi-texi-buffer-local-variables
  '(html2texi-document-information)
    "Liste des variables déclarées localement au tampon Texinfo.")

(defclass html2texi-simple-markup ()
  ((class-dependant
    :initarg :class-dependant
    :initform nil
    :custom '(repeat
	  (list
	   (regexp :tag "clef")
	   (string :tag "prologue")
	   (string :tag "épilogue")
	   (boolean :tag "conserver les espaces et retours chariot")
	   ))
    :documentation "\
Liste d'association dont les éléments sont de la forme
 (CLEF PROLOGUE ÉPILOGUE)

Supposons que l'objet décrit le traitement de la balise TAG,
alors lorsque le code HTML `<TAG class=\"CLEF\">CONTENU</TAG>'
est rencontré, alors il est convertie en le code Texinfo
`PROLOGUE TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU.")
   (preamble
    :initarg :preamble
    :type string
    :documentation "\
Prologue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (postamble
    :initarg :postamble
    :type string
    :documentation "\
Épilogue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (space-verb
    :initarg :space-verb
    :initform nil
    :type boolean
    :documentation "\
Vrai lorsque les espaces et retours chariot sont à conserver tels quels."
    ))
  :documentation "\
Un object de type `html2texi-simple-markup'
décrit le traitement d'une balise simple comme par exemple
<code>.")

(defun html2texi-texinfo-inside-comment-p ()
  "Renvoie non nil lorsque le point est dans un commentaire Texinfo."
  (save-match-data
    (save-excursion
      (let ((cur (point))
	    (end (progn (end-of-line) (point))))
	(beginning-of-line)
	(and (re-search-forward "\\(^\\|[^@]\\)@c\\(omment\\)\\_>" end t)
	     (<= (match-beginning 0) cur))))))

(defmethod html2texi-handle-simple-markup
  ((this html2texi-simple-markup) xml-expr)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe
			(and class-attribute
			     (assoc-string (cdr class-attribute)
					   (oref this :class-dependant))))
		      (list (oref this :preamble)
			    (oref this :postamble)))))
    (insert (car pre-post))
    (let ((beg (point))
	  end)
      (html2texi-process-xml-expr xml-expr)
      (unless (oref this :space-verb)
	(setq end (point-marker))
	(goto-char beg)
	(while (re-search-forward "[\n\r]\\s-*" nil end)
	  (let ((replace-str " "))
	    (save-match-data
	      (cond
	       ((html2texi-texinfo-inside-comment-p)
		(setq replace-str nil))))
	      (and replace-str (replace-match replace-str t t)))))
	(goto-char end)
	(set-marker end nil))
    (insert (cadr pre-post))))


(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-i-simple-markup
  (html2texi-simple-markup "html2texi-i-simple-markup"
   :preamble "@emph{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-b-simple-markup
  (html2texi-simple-markup "html2texi-b-simple-markup"
   :preamble "@strong{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-kbd-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :preamble "@kbd{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-dfn-simple-markup
  (html2texi-simple-markup "html2texi-dfn-simple-markup"
   :preamble "@dfn{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-sub-simple-markup
  (html2texi-simple-markup "html2texi-sub-simple-markup"
   :preamble ""
   :postamble "")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<sub class=\"CLEF\">CONTENU</sub>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-sup-simple-markup
  (html2texi-simple-markup "html2texi-sup-simple-markup"
   :preamble ""
   :postamble "")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<sup class=\"CLEF\">CONTENU</sup>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-samp-simple-markup
  (html2texi-simple-markup "html2texi-samp-simple-markup"
   :preamble "@samp{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<samp class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-tt-simple-markup
  (html2texi-simple-markup "html2texi-tt-simple-markup"
   :preamble "@t{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<tt class=\"CLEF\">CONTENU</tt>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-handle-two-columns-table-as-@table
  t
 "Si `nil' alors une table `<table>...</table>'
avec deux colonne sera gérée en texinfo par une `@table', si non
`nil', alors elle sera gérée par une `@multitable'."
  :type
  '(choice
    (const :tag "t pour @table" t)
    (const :tag "nil pour @multitable" nil))
  :group 'html2texi)




(defvar html2texi-document-information nil
  "Liste d'association pour mémoriser les informations (titre,
  auteurs, etc...) propres à un document.")

(defvar html2texi-xml-parsed nil
  "Résultat de l'analyse syntaxique d'un doc")

(defvar html2texi-xml-stack nil
  "Pile des expressions XML")

(defvar html2texi-keep-empty-strings nil
  "Non nil si les chaînes vides sont à conserver.")

(defvar html2texi-ignore-head nil
  "Non nil si on ignore le <head> (dans un fichier HTML lié).")

(defvar html2texi-directory-stack nil
  "Pile des chemins de répertoire.")

(defvar html2texi-files-doing-or-done nil
  "Liste des fichiers déjà traités, ou le fichier en cours de traitement.
Le fichier en cours de traitement est en première position dans cette liste.")

(defvar html2texi-files-to-do nil
  "Liste des fichiers non encore traités")

(defvar html2texi-flushable-anchors nil
  "Liste de nom d'ancrage de lien dont l'insertion a été remise à
  plus tard." )

(defvar html2texi-postpone-output nil
  "Non `nil' lorsque l'insertion du code est remise à plus tard")


(defvar html2texi-directory-ref nil
  "Répertoire de référence")

(defmacro html2texi-make-simple-markup-handler (tag)
  `(defun ,(intern (concat "html2texi-tag-handler-" (symbol-name tag)))
     (xml-expr)
     (html2texi-handle-simple-markup
      ,(intern (concat "html2texi-"  (symbol-name tag) "-simple-markup"))
      xml-expr) ))

(defun html2texi-make-html-clean-xml (beg end)
  (let  ((end-arg end)
	 end)
    (if (markerp end-arg)
	(setq end end-arg)
      (goto-char end-arg)
      (setq end (point-marker)))
    ;; rend les balise implicitement auto-closante vraiment auto-closante
    (goto-char beg)
   (while (re-search-forward (concat "<\\(" html2texi-suspicious-html-tags-re "\\)\\>")
			      end t)
      (let ((tag (match-string-no-properties 1)))
	(unless (re-search-forward ">" nil t)
	  (error "Clôture non trouvé pour la balise %s" tag))
	(when (null (looking-back "/>"))
	  (backward-char)
	  (insert "/")
	  (forward-char))))
    ;; marque de paragraph et de ligne
    (goto-char beg)
    (let (tag-stack p1 tag is-closure self-closing)
      (while (re-search-forward "<\\(/\\)?\\([a-zA-Z]+\\)\\>" end t)
	(setq p1 (match-beginning 0)
	      tag (match-string-no-properties 2)
	      is-closure (match-string-no-properties 1))
	(unless (string= tag (downcase tag))
	  (replace-match (setq tag (downcase tag)) 2))
	(unless (re-search-forward ">" end t)
	  (error "`Soufflet de clôture non trouvé pour la balise %s" tag))
	(setq self-closing (looking-back "/>"))
	(cond
	 ((and self-closing  is-closure)
	  (error "balise %s à la fois de clôture et auto-closante" tag))

	 (self-closing
	  ;; do nothing
	  )

	 ((null is-closure)
	  (when (and
		 (string-match (concat "\\`" html2texi-non-recursive-tags-re "\\'") tag)
		 tag-stack
		 (string= tag (caar tag-stack)))
	    ;; clôture
	    (save-excursion
	      (goto-char p1)
	      (insert "</" tag "><!-- HTML2TEXI: repaired (1) -->")
	      (warn "Fichier `%s', ligne %d ajout clôture `</%s>'"
		    (car html2texi-files-doing-or-done)
		    (line-number-at-pos)
		    tag))
	    (pop tag-stack))
	  (push (list tag) tag-stack))

	 (is-closure
	      (if (and tag-stack
		       (string= (caar tag-stack) tag))
		  (pop tag-stack)
		(let ((first (assoc-string tag tag-stack)) rev)
		  (if first
		      (progn
			(while (and tag-stack (null (eq (car tag-stack) first)))
			  (push (pop tag-stack) rev))
			(pop tag-stack)
			(save-excursion
			  (goto-char p1)
			  (dolist (c rev)
			    (insert  "</" (car c) "><!-- HTML2TEXI: repaired (2) -->" )
			     (warn "Fichier `%s', ligne %d ajout clôture `</%s>'"
				   (car html2texi-files-doing-or-done)
				   (line-number-at-pos)
				   tag))))
		    (error "Clôture de %s ne correspondant à aucune ouverture" tag)))))))


      (let (p-pos li-pos markup poss pos)
	(while (re-search-forward "<\\(/\\)?\\(p\\|li\\)\\>[^>]*>" end t)
	  (setq markup (match-string-no-properties 2)
		poss (intern (concat markup "-pos"))
		pos (symbol-value poss))
	  (if (match-string-no-properties 1)
	      (if  pos
		  (if (= pos (match-beginning 0))
		      (set poss nil)
		    (error "Clôture de balise %s ne correspondant à aucune ouverture" (match-string-no-properties 0)))
		(save-excursion
		  (save-match-data
		    (unless  (re-search-forward
			      (format "<\\(/\\)?\\(%s\\)\\>[^>]+>" markup)
			      end t)
		      (error "Ouverture de balise <%s> sans clôture" markup))
		    (set poss (match-beginning 0))
		    (unless (match-string-no-properties 1)
		      (goto-char (match-beginning 0))
		      (insert (format "</%s>" markup))
		      (dolist (symb '(p-pos li-pos))
			(unless (or (null (symbol-value symb))
				 (eq symb poss))
			  (set symb (+ (length markup) 3 (symbol-value symb)))))))))))
	    ))
    ;; mise entre guillemets anglais des attributs entier sans guillemets
    (goto-char beg)
    (let (p1 p2 added-dquote-attributes p-start)
      ;; tant qu'on trouve potentiellement un attribut sans "..."
      (while (re-search-forward "\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([0-9]+\\)"
				nil end)
	(setq p1 (match-beginning 1)
	      p2 (match-end 0))
	(if
	    ;; si la position est bien entre < et >
	    (and (re-search-backward "[<>]" nil beg)
		 (string= (match-string-no-properties 0) "<")
		 (looking-at "<\\sw+")
		 (progn
		   (goto-char (setq p-start (match-end 0)))
		   (re-search-forward "[<>]" nil beg)
		   (string= (match-string-no-properties 0) ">"))
		 (>= (point) p1))
	    ;; alors on fait la réparation
	    (progn
	      (goto-char p-start)
	      (while
		  (progn
		    (while (looking-at "\\(?:\\s-\\|\n\\)*\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\"[^\"]*\"")
		      (goto-char (match-end 0)))
		    (cond
		     ((looking-at  "\\(?:\\s-\\|\n\\)*\\(\\sw+\\)\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([0-9]+\\)")
		      (push (match-string-no-properties 1) added-dquote-attributes)
		      (goto-char (match-beginning 2))
		      (insert ?\")
		      (goto-char (1+ (match-end 2)))
		      (insert ?\"))
		     ((looking-at "\\(?:\\s-\\|\n\\)*>")
		      (goto-char (match-end 0))
		      (insert "<!-- HTML2TEXI inserted double quotes around values for attibutes"
			      (mapconcat (lambda (x) (concat "`" x "'"))
					 added-dquote-attributes
					 ", ")
			      ">")
		      nil)
		     (t (error "Attribut au format invalide: %s"
			       (match-string-no-properties (point)
							      (+ p2
								 (* 2 (length added-dquote-attributes))))))))))
	  ;; sinon on continue à chercher un attribut potentiel dont la valeur
	  ;; n'est pas entre "..."
	  (goto-char p2))))

    ;; un peu de ménage...
    (unless (markerp end-arg)
      (set-marker end nil)) ))

;;;==========================================================================
;;; définition des gestionnaires de balise
;;;--------------------------------------------------------------------------

(defun html2texi-tag-handler-a (xml-expr)
  (let (name href text (xml-expr-length (length xml-expr)))
    (dolist (attrib (cadr xml-expr))
      (cond
       ((eq (car attrib) 'href)
	(setq href (cdr attrib)))
       ((eq (car attrib) 'name)
	(setq name (cdr attrib)))))
    (and (cddr xml-expr)
	 (setq text (caddr xml-expr)))
    (cond
     (href (html2texi-process-url href text))
     ((= xml-expr-length 3)
      (cond
       ((stringp text)
	(insert (html2texi-string-escape text t)))
       ((consp text) (html2texi-process-xml-expr text))
       (t (error "Le format du text de la balise <a> était inattendu"))))
     ((> xml-expr-length 3)
      (html2texi-process-xml-expr `(div nil ,@(cddr xml-expr)))))
    (and name
      (insert "\n@anchor{" (html2texi-make-anchor (concat "#" name)) "}\n"))))

(html2texi-make-simple-markup-handler b)

(defun html2texi-flush-anchors ()
  (while html2texi-flushable-anchors
    (insert "@anchor{" (pop html2texi-flushable-anchors) "}\n")))


(defun html2texi-tag-handler-h1 (xml-expr)
  (insert "@chapter " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))


(defun html2texi-tag-handler-h2 (xml-expr)
  (insert "@section " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))

(defun html2texi-tag-handler-h3 (xml-expr)
  (insert "@subsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
    (html2texi-flush-anchors))

(defun html2texi-tag-handler-h4 (xml-expr)
  (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))

(defun html2texi-tag-handler-h5 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
     (html2texi-flush-anchors))

(defun html2texi-tag-handler-h6 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
   (html2texi-flush-anchors))

(html2texi-make-simple-markup-handler samp)


(defun html2texi-get-col-span (xml-expr)
  ;; xml-expr is <td> or <th>
  (let ((col-span (cdr-safe (assq 'colspan (nth 1 xml-expr)))))
    (setq col-span
	  (cond
	   ((integerp
	       (setq col-span
		     (if (stringp col-span)
			 (string-to-number col-span)
		       col-span)))
	      col-span)
	   ((null col-span) 1)
	   (t (error "colspan invalide"))))  ))

(html2texi-make-simple-markup-handler sub)
(html2texi-make-simple-markup-handler sup)

(html2texi-make-simple-markup-handler tt)

(defvar html2texi-col-number nil)
(defvar html2texi-row-number nil)
(defvar html2texi-head-on-row-0 nil)
(defvar html2texi-col-count nil)
(defvar html2texi-col-info-length nil)

(defun html2texi-tag-handler-table (xml-expr)
  (let* (html2texi-col-count
	(html2texi-row-number 0)
	html2texi-head-on-row-0
	html2texi-col-number
	;; le premier élément ne correspond pas à une colonne mais servira à
	;; reduire le vecteur des informations sur chaque colonne
	(html2texi-col-info (list 0))
	(html2texi-col-info-last html2texi-col-info)
	(html2texi-col-info-length 0)
	(xml-items (cddr xml-expr)))
    (while xml-items
      (let ((xml-expr (pop xml-items)))
	(cond
	 ((and (consp xml-expr)
	       (eq (car xml-expr) 'tr))
	  ;; plus besoin de chercher une ligne: on compte les colonnes sur la
	  ;; première ligne trouvée
	  (setq xml-items nil)
	  (dolist  (xml-expr (cddr xml-expr))
	    (cond
	     ((consp xml-expr)
	      (if (memq  (car xml-expr) '(th td))
		  (progn
		    (setq html2texi-col-count
			  (+ (or html2texi-col-count 0) (html2texi-get-col-span xml-expr)))
		    (when (> html2texi-col-count html2texi-col-info-length)
		      (let ((l (make-list (- html2texi-col-count html2texi-col-info-length) '(abs 1))))
			(setcdr html2texi-col-info-last l)
			(setq html2texi-col-info-last (last l)
			      html2texi-col-info-length html2texi-col-count))))
		(error "balise inattendu dans une table")))
	     ((stringp xml-expr)
	      (unless (string-match
		       "\\`\\s-*\\(\n\\s-*\\)*\\'"
		       xml-expr)
		(error "Chaîne inattendue")))
	     (t (error "Élément inattendu")))))
	 ((stringp xml-expr)
	  (unless (string-match
		   "\\`\\s-*\\(\n\\s-*\\)*\\'"
		   xml-expr)
	    (error "Chaîne inattendue")))
	 (t (error "Élément inattendu")))))



    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(progn
	  (insert "@multitable @columnfractions ")
	  (let ((total-weight
		  (math-reduce-vec
		   (lambda (r x)
		     (+ r
			(cond
			 ((eq (car x) 'abs) (cadr x))
			 ((eq (car x) 'rel)
			  (setcar x 'abs)
			  (setcar (cdr x) (*  (cadr x) html2texi-col-info-length))
			  (cadr x)))))
		   (cons 'vec html2texi-col-info))))
		(insert (mapconcat
			 (lambda (x)
			   (number-to-string
			    (/ (float (cadr x)) html2texi-col-info-length)))
			 (cdr html2texi-col-info)
			 " ")))
	  (insert "\n"))
      (insert "@table\n"))

    (html2texi-process-xml-expr xml-expr)

    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(insert "@end multitable\n")
      (insert "@end table\n"))))


(defun html2texi-tag-handler-tr (xml-expr)
  (setq html2texi-col-number 0)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n")
  (setq html2texi-row-number (1+ html2texi-row-number)))

(defun html2texi-tag-handler-th (xml-expr)
  (if   (= 0 html2texi-col-number)
      (if (and (= 0 html2texi-row-number)
	       (null html2texi-handle-two-columns-table-as-@table))
	  (progn
	    (setq html2texi-head-on-row-0 t)
	    (insert "@headitem ")
	    (html2texi-process-xml-expr xml-expr))
	(insert "@item ")
	(html2texi-process-xml-expr xml-expr))
    (when (or (> html2texi-col-count 2)
	      (null html2texi-handle-two-columns-table-as-@table))
      (insert "@tab "))
    (html2texi-process-xml-expr xml-expr)
    (unless (and  (= 0 html2texi-row-number) html2texi-head-on-row-0)
	(insert "\n")))
  (setq html2texi-col-number (1+ html2texi-col-number)))

(defun html2texi-tag-handler-td (xml-expr)
  (if (= 0 html2texi-col-number)
	(insert "@item ")
    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
      (insert "@tab ")))
  (html2texi-process-xml-expr xml-expr)
  (insert "\n")
  (setq html2texi-col-number (1+ html2texi-col-number)))


(defun html2texi-cur-dir ()
  "Détermine le répertoire courant relativement au répertoire du
HTML racine de départ. La valeur retournée se termine par une oblique `/'"
  (let ((cur-dir  (nreverse (split-string (cdar html2texi-directory-stack) "/")))
	(ref-dir  (nreverse (split-string html2texi-directory-ref "/"))))
    (unless (and (string= (car cur-dir) "")
		 (string= (car ref-dir) ""))
      (error "Format invalide de répertoire"))
    (setq cur-dir (nreverse (cdr cur-dir))
	  ref-dir (cdr ref-dir))
    (if (or (string= (car cur-dir) "")
	    (string-match "\\`[a-z]:" (car cur-dir)))
	;; cur-dir est un chemin absolu
	(progn
	  (setq ref-dir (nreverse ref-dir))
	  (while (and cur-dir ref-dir (string= (car cur-dir) (car ref-dir)))
	    (setq cur-dir (cdr cur-dir)
		  ref-dir (cdr ref-dir)))
	  (while ref-dir
	    (push ".." cur-dir)
	    (setq ref-dir (cdr ref-dir)))
	  (concat (mapconcat 'identity cur-dir "/") "/"))
      (while (and cur-dir
		  (cond
		   ((string= (car cur-dir) "..")
		    (unless ref-dir
		      (error "Chemin invalide"))
		    (setq ref-dir (cdr ref-dir)
			  cur-dir (cdr cur-dir)))
		   ((string= (car cur-dir) ".")
		    (setq cur-dir (cdr cur-dir)))
		   (t nil))))
      (dolist (e cur-dir)
	(push e ref-dir))
      (mapconcat 'identity  (nreverse (cons "" ref-dir)) "/") )))

(defun html2texi-anchor-escape (anchor)
  (let (ret)
    (setq anchor
	  (mapconcat
	   'identity
	   (split-string anchor "-") "--"))
    (mapc
     (lambda (x)
       (if
	(or (and (>= x ?a) (<= x ?z))
	     (and (>= x ?A) (<= x ?Z))
	     (and (>= x ?0) (<= x ?9))
	     (member x '(?_ ?- ?/)))
	   (push (string x) ret)
	 (push (format "-%04x" x) ret)))
     anchor)
    (apply 'concat (nreverse ret))))

(defun html2texi-make-anchor (name &optional escape-function)
  (let* ((anchor (expand-file-name (concat (html2texi-cur-dir) name)))
	 (l-a (length anchor))
	 (l-r (length html2texi-directory-ref))
	 (l (min l-a l-r))
	 (start 0)
	 (i -1))
    (while (and
	    (< (setq i (1+ i)) l)
	    (prog1
		(= (aref anchor i) (aref html2texi-directory-ref i))
	      (and (= (aref anchor i) ?/)
		   (setq start (1+ i))))))
    (setq anchor (list (substring anchor start)))
    (dotimes (i (length (split-string (substring html2texi-directory-ref start))))
      (push "../" anchor))
    (setq anchor (apply 'concat anchor))
    (html2texi-string-escape (funcall (or escape-function 'html2texi-anchor-escape) anchor))))

(defun html2texi-tag-handler-body (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))


(html2texi-make-simple-markup-handler code)

(defun html2texi-tag-handler-br (xml-expr)
  (insert "@*\n"))

(defun html2texi-tag-handler-div (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(html2texi-make-simple-markup-handler dfn)

(defun html2texi-tag-handler-dl (xml-expr)
  (insert "@table @asis\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "@end table\n"))

(defun html2texi-tag-handler-dt (xml-expr)
  (insert "@item ")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(defun html2texi-tag-handler-dd (xml-expr)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(defun html2texi-tag-handler-frameset (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-frame (xml-expr)
  (let (url text)
    (dolist (x (cadr xml-expr))
      (cond
       ((eq (car x) 'src)
	(setq url (cdr x)))
       ((eq (car x) 'name)
	(setq text (cdr x)))))
    (when url
      (html2texi-process-url url text))))

(defun html2texi-simple-markup-handle (xml-expr class-alist preamble postamble)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe
			(and class-attribute
			     (assoc-string (cdr class-attribute) class-alist)))
		      (list preamble postamble))))
    (insert (car pre-post))
   (html2texi-process-xml-expr xml-expr)
   (insert (cadr pre-post))))

(defun html2texi-tag-handler-hr (xml-expr)
  (insert "@c <hr/>\n"))

(html2texi-make-simple-markup-handler kbd)

(defun html2texi-tag-handler-html (xml-expr)
  "\
Traitement de la balise html."
  (let* ((attributes (nth 1 xml-expr))
	 (lang (assq 'lang attributes)))
    (when lang
      	(html2texi-set-doc-info 'language (cdr lang))))
    (html2texi-process-xml-expr xml-expr))

(defun html2texi-handle-string (str)
  (let (ret (pos0 0) pos1 (len (length str)))
    (while (and
	    (< pos0 len)
	    (setq pos1 (string-match "[{}@]" str pos0)))
      (push (substring str pos0 pos1) ret)
      (push (concat "@" (match-string-no-properties 0 str)) ret)
      (setq pos0 (1+ pos1)))
    (when (< pos0 len)
      (push (substring str pos0 pos1) ret))
    (apply 'concat (nreverse ret))))


(defun html2texi-error (format-str xml-expr &rest args)
  (apply 'error (concat format-str
			"
-----------------------------------------------------------------------------
xml-expr=%S
xml-stack=%S
-----------------------------------------------------------------------------")
	 `( ,@args ,xml-expr ,html2texi-xml-stack)))

(defun html2texi-process-url (url text)
  (let* ((parsed-url (url-generic-parse-url url))
	 url-list
	 i file-name locator)
    ;; petit hack parce que url-generic-parse-url ne fait pas complètement le
    ;; boulot
    (when (and
	   (null  (aref parsed-url 1))
	   (setq i (string-match "#" (aref parsed-url 6)))
	   (null (aref parsed-url 7)))
      (aset parsed-url 7 (substring (aref parsed-url 6) (1+ i)))
      (aset parsed-url 6 (substring (aref parsed-url 6) 0 i)))

    (push "@uref{" url-list) ; ça peut être défait ensuite
    ;; URL
    (if (and (eq (aref parsed-url 0)
		 'cl-struct-url)
	     (null (aref parsed-url 1)))
	;; cas où il n'y a pas de protocole
	(cond
	 ;; on point vers un fichier HTML, ce n'est donc pas une URL interne
	 ;; => cas suspect
	 ((member (file-name-extension
		   (setq file-name (aref parsed-url 6)))
		  '("html" "htm"))
	  (setq file-name (expand-file-name
			   file-name
			   (file-name-directory (car html2texi-files-doing-or-done))))
	  (unless (member file-name html2texi-files-doing-or-done)
	    (add-to-list 'html2texi-files-to-do file-name))
	  (when (aref parsed-url 7)
	    (setq file-name (concat file-name "#" (aref parsed-url 7))))
	  (push (html2texi-string-escape file-name) url-list))

	 ;; cas d'une URL interne
	 ((and (string= "" file-name)
	       (setq locator (aref parsed-url 7)))
	  (pop url-list)
	  (push "@ref{" url-list)
	  (push (html2texi-make-anchor (concat "#" locator)) url-list))

	  (t
	    (push (html2texi-string-escape url) url-list)))
        (push (html2texi-string-escape url) url-list))
     ;; Text
     (when text
       (push "," url-list)
       (push (html2texi-string-escape text) url-list))
     (push "}" url-list)
     (apply 'insert (nreverse url-list))))


(html2texi-make-simple-markup-handler i)

(defun html2texi-tag-handler-li (xml-expr)
  (insert "\n@item\n")
  (unless (memq (caadr html2texi-xml-stack) '(ol ul))
    (html2texi-error "<li> était inattendu" xml-expr))
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-link (xml-expr)
  )

(defun html2texi-tag-handler-ol (xml-expr)
  (insert "\n@enumerate")
   (html2texi-process-xml-expr xml-expr)
  (insert "\n@end enumerate\n"))

(defun html2texi-tag-handler-p (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(defun html2texi-tag-handler-ul (xml-expr)
  (insert "\n@itemize")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n@end itemize\n"))

(defun html2texi-tag-handler-span (xml-expr)
  (insert "@c span: (<span #1>#2</span> => #2.")
  (html2texi-default-handling xml-expr "span: ")
  (html2texi-process-xml-expr xml-expr)
  (insert "@c span: )\n"))

(defun html2texi-tag-handler-style (xml-expr)
  )

(defun html2texi-tag-handler-meta (xml-expr)
  (unless (and (nth 1 html2texi-xml-stack)
	       (eq (caadr html2texi-xml-stack) 'head))
    (html2texi-error "<meta> inattendu." xml-expr))
  ;; traitement du meta...
  (let* ((attribute-list (nth 1 xml-expr))
	 (http-equiv (assq 'http-equiv attribute-list))
	 (name (assq 'name attribute-list))
	 (content (assq 'content attribute-list)))
    (cond 
     ((and (consp name)
	   (consp content)
	   (progn
	     (setq name (cdr name)
		   content (cdr content))
	     (stringp name))
	   (stringp content))
      (cond
       ((string= name "author")
	(html2texi-set-doc-info 'author content))
       ((string= name "language")
	(when (string-match "\\`\\([a-z]\\{2\\}\\(-[A-Z]\\{2\\}\\)?\\)\\'" content)
	  (let ((language (match-string-no-properties 1 content)))
	    (when (= (length language) 5)
	      (aset language 2 ?_))
	    (html2texi-set-doc-info 'language language))))))
     ((and (consp http-equiv)
	   (consp content)
	   (progn (setq http-equiv (cdr http-equiv))
		  (stringp http-equiv))
	   (progn (setq content (cdr content))
		  (stringp content)))
      (setq http-equiv (downcase http-equiv))
      (cond
       ((and (string= http-equiv "content-type")
	     (string-match "charset\\s-*=\\s-*\\([-a-z0-9]+\\)" content))
	(html2texi-set-doc-info 'content-type-charset (match-string-no-properties 1 content)));
       )))))

(defun html2texi-tag-handler-pre (xml-expr)
  (let ((kes html2texi-keep-empty-strings))
    (setq html2texi-keep-empty-strings t)
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-keep-empty-strings kes)))

(defun hmtl2texi-to-plain-text (xml-expr &rest flags)
  (let (ret anchor)
    (dolist (xml-expr (cddr xml-expr))
      (cond
       ((stringp xml-expr)
	(push xml-expr ret))
       ((consp xml-expr)
	(push xml-expr html2texi-xml-stack)
	(cond
	 ((and (eq (car xml-expr) 'a)
	       (setq anchor (assq 'name (nth 1 xml-expr))))
	  (push (html2texi-make-anchor (concat "#" (cdr anchor)))
		html2texi-flushable-anchors) ))
	(let ((str  (hmtl2texi-to-plain-text xml-expr)))
	  (and (null (string= str ""))
	       (push str ret)))
	(pop html2texi-xml-stack))
       (t (html2texi-error "Expression XML inattendue." xml-expr))))
    (setq  ret (mapconcat 'identity (nreverse ret) " "))
    (if (memq :one-line flags)
	(mapconcat 'identity (split-string ret "\n") " ")
      ret)))


(defun html2texi-tag-handler-title (xml-expr)
  (unless (and  (nth 1 html2texi-xml-stack)
		(eq  (caadr html2texi-xml-stack) 'head))
    (html2texi-error "<title> inattendu." xml-expr))
  (setq xml-expr (cddr xml-expr))
  (let ((str  (hmtl2texi-to-plain-text xml-expr)))
    (setq str (split-string str "\n")
	  str (mapconcat 'identity str " "))
    (unless (string= str "")
      (html2texi-set-doc-info 'title str))))

(defun html2texi-string-escape (str &optional flatten)
  (cond
   ((stringp str)
    (with-temp-buffer
      (insert str)
      (goto-char (point-min))
      (while (re-search-forward "[,@{}]" nil t)
	(cond
	 ((string= (match-string-no-properties 0) ",")
	  (replace-match "@comma{}"))
	 ((member (match-string-no-properties 0) '("@" "{" "}"))
	  (replace-match (concat "@" (match-string-no-properties 0))))))
      (when flatten
	(goto-char (point-min))
	(while (re-search-forward "\n\\(\\s-*\\)" nil t)
	  (replace-match (if (> 0 (length (match-string 1))) " " "") t t)))
      (buffer-substring (point-min) (point-max))))
   ((and (consp str) (car-safe str))
    (cond
     ((eq (car str) 'span)
      (with-temp-buffer
	(insert "@c span: (<span #1>#2</span> => string-escape of #2.")
	(html2texi-default-handling str "span: ")
	(insert (html2texi-string-escape  (nth 2 str) flatten))
	(insert "@c span: )\n")
	(buffer-substring (point-min) (point-max))))
     (t (html2texi-error "Un chaîne était attendue" str))))
   (t  (html2texi-error "Un chaîne était attendue" str))))

(defun html2texi-tag-handler-img (xml-expr)
  (let (filename width height alttext extension)
    (dolist (x (cadr xml-expr))
      (cond
       ((eq (car x) 'src)
	(setq filename (cdr x)))
       ((eq (car x) 'alt)
	(setq alttext (cdr x)))))
    (unless filename
      (html2texi-error "src=... était attendu" xml-expr))
    (setq extension (file-name-extension filename)
	  filename (file-name-sans-extension filename))
    (when (member extension '("png" "jpg" "jpeg" "eps" "txt"))
      (setq extension nil))
    (insert "@image{" (html2texi-make-anchor filename (symbol-function 'identity)))
    (let ((remainder (list width height alttext extension)))
	(while remainder
	  (if (let (non-empty)
		(mapc (lambda (x) (setq non-empty (or non-empty (stringp x))))
		      remainder)
		non-empty)
	      (insert "," (or (pop remainder) "") )
	    (setq remainder nil); rompt la boucle (while remainder...)
	    ))
	(insert "}"))))

(defun html2texi-set-doc-info (tag val)
  "Configure pour l'étiquette TAG la valeur VAL concernant les
informations globales au documents. Ces informations concernent
notamment la langue et l'encodage du document."
  (let ((info (assq tag html2texi-document-information)))
    (if info
	(setcdr info val)
      (push (cons tag val) html2texi-document-information))))

(defun html2texi-tag-handler-head (xml-expr)
  (unless html2texi-ignore-head
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-ignore-head t)))

(defun html2texi-tag-handler-noframes (xml-expr)
  )

(if (boundp 'html2texi-handler-hash-table)
    (makunbound 'html2texi-handler-hash-table))

(defconst html2texi-handler-hash-table
  (let ((ht (make-hash-table)))
    (dolist (v '(a b body code dfn dl dt dd i kbd li p hr div ol ul pre
    head meta title frameset frame noframes span table th tr td h1 h2
    h3 h4 h5 h5 html link br img samp style sup sub tt))
      (puthash v (symbol-function (intern (concat "html2texi-tag-handler-" (symbol-name v))))
	       ht))
    ht)
  "Table de hashage des traitement associé à chaque balise HTML"
  )

(defun html2texi-remove-empty-strings (xml-expr)
  (setq xml-expr (cdr xml-expr))
  (save-match-data
  (while (cdr xml-expr)
    (if (and (stringp (cadr xml-expr))
	     (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'" (cadr xml-expr)))
	(setcdr xml-expr (cddr xml-expr))
      (setq xml-expr (cdr xml-expr))))))

(defun html2texi-process-xml-expr (xml-expr)
  (push xml-expr html2texi-xml-stack)
  (dolist (xml-expr (cddr xml-expr))
    (cond
     ((consp xml-expr)
      (push xml-expr html2texi-xml-stack)
      (let ((handler (gethash (intern (downcase (symbol-name (car xml-expr))))
			      html2texi-handler-hash-table)))
	(if handler
	    (funcall handler  xml-expr)
	  (html2texi-default-handling xml-expr)))
      (pop html2texi-xml-stack))
     ((stringp xml-expr)
      (and (or html2texi-keep-empty-strings
	       (null (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'"  xml-expr)))
	   (insert (html2texi-handle-string xml-expr))))
     (t (error "Expression XML inattendue %S" xml-expr))))
  (pop html2texi-xml-stack))

(defun html2texi-default-handling (xml-expr &optional prompt)
  (let ((str (split-string (prin1-to-string xml-expr) "\n")))
    (dolist (str-line str)
      (insert "\n@c " (or prompt "") str-line)))
    (insert "\n"))

(defun html2texi-process-region (beg end)
  (goto-char end)
  (let ((end (point-marker))
	xml-expr)

    ;; Suppression de tout ce qui est en dehors des balise <html> ... </html>
    (goto-char beg)
    (unless (re-search-forward "<html" end t)
      (error "Balise <html> non trouvée"))
    (delete-region beg (match-beginning 0))
    (unless (re-search-forward ">" end t)
      (error "Clôture de la balise <html> trouvéee"))
    (unless  (re-search-forward "</html" end t)
      (error "Balise </html> non trouvée trouvée"))
    (unless (re-search-forward ">" end t)
      (error "Clôture de la balise </html> trouvée"))
    (delete-region (match-end 0) end)

    (html2texi-make-html-clean-xml beg end)

    (setq xml-expr (xml-parse-region (point-min) (point-max)))
    (delete-region beg end)
    (set-marker end nil)
    xml-expr))

(if t
;; plus partique pour déboguer qu'un vrai tampon temporaire
    (defmacro html2texi-with-temp-buffer (&rest body)
      (let ((cur-buff (make-symbol "cur-buff")))
	`(with-current-buffer
	       (let (( ,cur-buff (get-buffer "*HTML2TEXI Temp*")))
		 (and ,cur-buff (kill-buffer ,cur-buff))
		 (get-buffer-create "*HTML2TEXI Temp*"))
       (erase-buffer)
       ,@body)))
  ;;
  (defmacro html2texi-with-temp-buffer (&rest body)
    `(with-temp-buffer ,@body)))



(defun html2texi-make-texi-buffer (&optional buffer )
  (let* ((start-buffer (or buffer (current-buffer)))
	 xml-expr
	 (start-filename  (or (buffer-file-name start-buffer) (buffer-name)))
	 (start-filename-ext (file-name-extension start-filename))
	 (texi-buffer-name
	  (concat (concat  (file-name-sans-extension   (file-name-nondirectory start-filename))
			    ".texi")))
	 done-links-list
	 texi-buffer
	 html2texi-keep-empty-strings
	 html2texi-xml-parsed
	 html2texi-xml-stack
	 html2texi-ignore-head
	 html2texi-directory-stack
	 html2texi-flushable-anchors
	 html2texi-directory-ref
	 html2texi-files-doing-or-done
	 html2texi-files-to-do)
    (unless (or (member start-filename-ext '("html" "htm"))
		(y-or-n-p (format "le tampon %s n'a pas une extension html, continuer?"
				  start-filename)))
      (error "Fichier sans extension html"))
    (setq texi-buffer (get-buffer-create texi-buffer-name))
    (set-buffer texi-buffer)
    (erase-buffer)
    (dolist (v html2texi-texi-buffer-local-variables)
      (set (make-local-variable v) nil))
    (insert (with-current-buffer start-buffer
	      (save-restriction
		(widen)
		(buffer-substring (point-min) (point-max)))))
    (accents-de-html)
    (push (cons default-directory "./") html2texi-directory-stack)
    (push start-filename html2texi-files-doing-or-done)
    (setq html2texi-directory-ref default-directory)

    (setq xml-expr (html2texi-process-region (point-min) (point-max)))
    (unless (eq 'html (caar xml-expr))
      (error "Résultat d'analyse XML inattendu"))
    (setq xml-expr `(html2texi-dummy-markup nil ,(car xml-expr)))
    (html2texi-process-xml-expr xml-expr)
    (while html2texi-files-to-do
      (setq file-name (pop html2texi-files-to-do))
      (if (file-exists-p file-name)
	  (progn
	    (push file-name html2texi-files-doing-or-done)
	    (let* ((dir (file-name-as-directory
			 (file-name-directory file-name)))
		   (rel-dir   (let ((d
				     (file-name-directory
				      (file-relative-name file-name html2texi-directory-ref))))
				(if d (file-name-as-directory d)
				  "./"))))
	      (push (cons dir rel-dir) html2texi-directory-stack)
	      (html2texi-with-temp-buffer
	       (insert-file-contents file-name)
	       (accents-de-html)
	       (html2texi-make-html-clean-xml (point-min) (point-max))
	       (setq xml-expr (html2texi-process-region (point-min) (point-max))))
	      (unless (eq 'html (caar xml-expr))
		(error "Résultat d'analyse XML inattendu"))
	      (setq xml-expr (car xml-expr))
	      (html2texi-process-xml-expr xml-expr)
	      (pop html2texi-directory-stack)	))
	(warn "Le fichier `%s' n'existe pas!" file-name)))))

(defun html2texi-insert-doc-info ()
  (let ((author
	 (html2texi-string-escape
	  (or (cdr-safe (assq 'author html2texi-document-information)) "AUTHOR")))
	(title 	 (html2texi-string-escape
		  (or (cdr-safe (assq 'title html2texi-document-information)) "TITLE")))
	(language 	 (let ((language  (cdr-safe (assq 'language html2texi-document-information))))
			   (if language (cons "" (html2texi-string-escape language))
			     (cons "@c " "LANGUAGE"))))
	(encoding  (html2texi-string-escape
			  (or (cdr-safe (assq 'content-type-charset html2texi-document-information)) 
			      "iso-8859-1"))))

    (goto-char (point-min))
    (insert "\\input texinfo   @c -*-mode:texinfo; coding:" encoding "-*-
@setfilename " (file-name-sans-extension (buffer-name)) ".info
" (car language) "@documentlanguage " (cdr language) "
@documentencoding "  (if (let ((case-fold-search t))
			   (string-match "\\`\\(us\\|utf\\|iso\\)" encoding)) 
			 (upcase encoding) encoding) "
@copying
This manual is for PROGRAM, version VERSION.

Copyright @copyright{} YEARS COPYRIGHT-OWNER.

@quotation
Permission is granted to ...
@end quotation
@end copying

@titlepage
@title " title "@c NAME-OF-MANUAL-WHEN-PRINTED
@c @subtitle SUBTITLE-IF-ANY
@c @subtitle SECOND-SUBTITLE
@author " author "

@c  The following two commands
@c  start the copyright page.
@page
@vskip 0pt plus 1filll
@insertcopying

Published by ...
@end titlepage

@c So the toc is printed at the start.
@contents

@ifnottex
@node Top
@top TITLE

This manual is for PROGRAM, version VERSION.
@end ifnottex
")
    (goto-char (point-max))
    (insert "
@bye") ))

(defun html2texi-post-process ()
  "Remplace les double lignes vides en ligne vides simples."
  (goto-char (point-min))
  (while (re-search-forward "\\(^[ \t]*\n\\)\\{2,\\}" nil t)
    (replace-match "\n"))
  (normal-mode))

;;;###autoload
(defun html2texi ()
  (interactive)
  (html2texi-make-texi-buffer)
  (html2texi-insert-doc-info)
  (html2texi-post-process))

;;; html-to-texinfo.el ends here


Revision-number: 13
Prop-content-length: 509
Content-length: 509

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2012-01-28T08:14:14.000000Z
K 7
svn:log
V 406
- dans méthode `accents-conversion' détection du cas où end est un marqueur.
- dans fonction `accents-moteur' ajout save-match-data.
- dans fonctions `accents-tex', `accents-de-tex', `accents-html', `accents-de-html', utilisation de la région si active.
- dans constante `accents-convertisseur-html', ajout d'entité HTML.
- ajout fonction `accents-quote-html' et constantes correspondantes.

PROPS-END

Node-path: trunk/lisp/accents-ascii.el
Node-kind: file
Node-action: change
Text-content-length: 22629
Text-content-md5: ab8b7ae50f7137279ef017322dfae2a6
Content-length: 22629

;; -*- coding: utf-8 -*-
;; Copyright 2008 Vincent Belaïche

;; Author: Vincent Belaïche <vincent.b.1@hotmail.fr>
;; Version: $Id: accents-ascii.el,v 1.2 2012-01-28 08:14:14 Vincent Exp $
;; Keywords: 
;; X-URL: not distributed yet

;; 
;; This software is governed by the CeCILL license under French law and
;; abiding by the rules of distribution of free software.  You can  use, 
;; modify and/ or redistribute the software under the terms of the CeCILL
;; license as circulated by CEA, CNRS and INRIA at the following URL
;; "http://www.cecill.info". 
;; 
;; As a counterpart to the access to the source code and  rights to copy,
;; modify and redistribute granted by the license, users are provided only
;; with a limited warranty  and the software's author,  the holder of the
;; economic rights,  and the successive licensors  have only  limited
;; liability. 
;; 
;; In this respect, the user's attention is drawn to the risks associated
;; with loading,  using,  modifying and/or developing or reproducing the
;; software by the user in light of its specific status of free software,
;; that may mean  that it is complicated to manipulate,  and  that  also
;; therefore means  that it is reserved for developers  and  experienced
;; professionals having in-depth computer knowledge. Users are therefore
;; encouraged to load and test the software's suitability as regards their
;; requirements in conditions enabling the security of their systems and/or 
;; data to be ensured and,  more generally, to use and operate it in the 
;; same conditions as regards security. 
;; 
;; The fact that you are presently reading this means that you have had
;; knowledge of the CeCILL license and that you accept its terms.
;; 
;;; Commentary:

;; accents-tex : change les caractères accentués en accents tex
;; conserve les majuscules, sans demander confirmation.
;;
;; accents-de-tex : change les accents tex en caracteres accentués sans
;; demander confirmation.  les majuscules sont respectees.
;;

(require 'eieio)

(dolist (v '(accents-convertisseur-cache
	     accents-convertisseur-le-cache
	     accents-convertisseur-base
	     accents-convertisseur-simple
	     accents-convertisseur-inverse
	     accents-convertisseur-html
	     accents-convertisseur-de-html))
  (makunbound v))

(defclass accents-convertisseur-cache ()
  ((table-de-hashage
    :initarg :table-de-hashage)
   (expression-rationnelle
    :initarg :expression-rationnelle
    :documentation "Expression rationnelle s'accordant aux
    lettres accentuées à remplacer.")
   (id-convertisseur
    :initarg :id-convertisseur
    :initform nil
    :type symbol)
   (lecteur-clef
    :initarg :lecteur-clef
    :initform nil))
  "C'est la classe qui fait le boulot effectif de remplacement.")

(defvar accents-convertisseur-le-cache
  (make-instance 'accents-convertisseur-cache
		 :table-de-hashage (make-hash-table :test 'equal)))

(defmethod accents-conversion 
  ((this accents-convertisseur-cache) &optional beg end)
  (let (cleanup)
    (save-excursion
      (goto-char (or beg (point-min)))
      (setq end (if (integerp end) 
		    (let ((m (make-marker))) 
		      (setq cleanup t)
		      (set-marker m end)
		      m)
		  end))
      (save-match-data
	(let ((case-fold-search nil)
	      (table-de-hashage (oref this :table-de-hashage))
	      (expression-rationnelle (oref this :expression-rationnelle))
	      (lecteur-clef (or (oref this :lecteur-clef) 
				(function (lambda () (match-string-no-properties 0))))))

	  (while (re-search-forward expression-rationnelle end t)
	    (let ((replacement  
		   (gethash  (funcall lecteur-clef)
			     table-de-hashage)))
	      (and replacement
		   (replace-match replacement t t)))))))
    (when cleanup
      (set-marker end nil))))

(defclass accents-convertisseur-base ()
  ((cache
    :allocation :class
    :documentation "État en cache du convertisseur"))
  "Classe de base pour un convertisseur"  )
(oset-default accents-convertisseur-base cache 
	      accents-convertisseur-le-cache)

(defclass accents-convertisseur-simple 
  (accents-convertisseur-base)
  ((id
    :initarg :id
    :documentation "Symbole d'itentification unique pour le
    cache.")
   (liste-de-remplacement
    :initarg :liste-de-remplacement
    :documentation "Liste d'association") )
  "")

(defmacro accents-definir-conversion
  (CLASS CAR CDR &optional LECTEUR-CLEF)
  `(defmethod accents-conversion 
     ((this ,CLASS) &optional beg end)

     (let ((cache (oref this cache))
	   (id (oref this :id)))
       (unless (eq (oref cache :id-convertisseur)
		   id)
	 (oset cache :id-convertisseur ,LECTEUR-CLEF)
	 (oset cache :lecteur-clef nil)
	 (let ((table-de-hashage (oref cache :table-de-hashage))
	       (liste-de-remplacement (oref this :liste-de-remplacement)))
	   (clrhash table-de-hashage)
	   (dolist (k liste-de-remplacement)
	     (puthash (,CAR k) (,CDR k) table-de-hashage))
	   (oset cache :expression-rationnelle
		 (regexp-opt (mapcar (quote ,CAR) liste-de-remplacement)))))
       (accents-conversion cache beg end))))

(accents-definir-conversion accents-convertisseur-simple car cdr)

(defclass accents-convertisseur-inverse
  (accents-convertisseur-simple)
  ()
  "Convertisseur pour effectuer la conversion inverse vis-à-vis
  de la liste de remplacement.")

(accents-definir-conversion accents-convertisseur-inverse cdr car)

(defun accents-moteur (liste-des-remplacements &optional convert-to-re)
  (save-excursion
	(save-match-data
	  (let ((case-fold-search nil)
		(re (if convert-to-re 
			(mapconcat 'identity 
				   (mapcar 'car liste-des-remplacements)
				   "\\|")
		      (regexp-opt  (mapcar 'car liste-des-remplacements)))))
	    (goto-char (point-min))
	    (while (re-search-forward re nil t)
	      (replace-match
	       (if convert-to-re
		   (save-match-data 
		     (assoc-default (match-string 0) 
				    liste-des-remplacements 'string-match))
		 (cdr (assoc-string (match-string 0) liste-des-remplacements)))
	       t; fixed case
	       t; literal
	       ))))))

(defconst accents-converstisseur-tex
  (make-instance 
   'accents-convertisseur-simple
   :id 'accents-converstisseur-tex
   :liste-de-remplacement 
   '(("\�" . "\\'A")
     ("\À" . "\\`A")
     ("\Â" . "\\^A")
     ("\Ä" .  "\\\"A")
     ("\É" . "\\'E")
     ("\È" . "\\`E")
     ("\Ê" . "\\^E")
     ("\Ë" .  "\\\"E")
     ("\�" . "\\'I")
     ("\Ì" . "\\`I")
     ("\ÃŽ" . "\\^I")
     ("\�" .  "\\\"I")
     ("\0" . "\\'O")
     ("\Ã’" . "\\`O")
     ("\Ô" . "\\^O")
     ("\Ö" .  "\\\"O")
     ("\Ú" . "\\'U")
     ("\Ù" . "\\`U")
     ("\Û" . "\\^U")
     ("\Ü" .  "\\\"U")
     ("\Ç" . "\\c{C}")
     ("\á" . "\\'a")
     ("\à" . "\\`a")
     ("\â" . "\\^a")
     ("\ä"  .  "\\\"a")
     ("\é" . "\\'e")
     ("\è" . "\\`e")
     ("\ê" . "\\^e")
     ("\ë" .  "\\\"e")
     ("\í" .  "\\'\\i")
     ("\ì" .  "\\`\\i")
     ("\î" .  "\\^\\i")
     ("\ï" .  "\\\"\\i")
     ("\ó" . "\\'o")
     ("\ò" . "\\`o")
     ("\ô" . "\\^o")
     ("\ö" .  "\\\"o")
     ("\ú" . "\\'u")
     ("\ù" . "\\`u")
     ("\û" . "\\^u")
     ("\ü" .  "\\\"u")
     ("\ç" . "\\c{c}")
     ("\×" . "\\times{}")
)
   
   )
  "Convertisseur de lettres accentuées en séquence TeX
  équivalentes.")


(defun accents-tex ()
  (interactive)
  "change les caracteres accentues en accents tex"
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-conversion accents-convertisseur-tex beg end)
    ))

(defun accents-de-tex ()
  (interactive)
  "change les caracteres accentues en accents tex"
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-moteur
     '(( "\\\\'[ \n\t]*A" . "\�")
       ( "\\\\`[ \n\t]*A" . "\À")
       ( "\\\\^[ \n\t]*A" . "\Â")
       ( "\\\\\"[ \n\t]*A" . "\Ä")
       ( "\\\\'[ \n\t]*E" . "\É")
       ( "\\\\`[ \n\t]*E" . "\È")
       ( "\\\\^[ \n\t]*E" . "\Ê" )
       ( "\\\\\"[ \n\t]*E" . "\Ë")
       ( "\\\\'[ \n\t]*I" . "\�")
       ( "\\\\`[ \n\t]*I" . "\Ì")
       ( "\\\\^[ \n\t]*I" . "\ÃŽ")
       ( "\\\\\"[ \n\t]*I" . "\�")
       ( "\\\\'[ \n\t]*O" . "\0")
       ( "\\\\`[ \n\t]*O" . "\Ã’")
       ( "\\\\^[ \n\t]*O" . "\Ô")
       ( "\\\\\"[ \n\t]*O" . "\Ö")
       ( "\\\\'[ \n\t]*U" . "\Ú")
       ( "\\\\`[ \n\t]*U" . "\Ù")
       ( "\\\\^[ \n\t]*U" . "\Û")
       ( "\\\\\"[ \n\t]*U" . "\Ü")
       ( "\\\\c[ \n\t]*{C}" . "\Ç")
       ( "\\\\'[ \n\t]*{A}" . "\�")
       ( "\\\\`[ \n\t]*{A}" . "\À")
       ( "\\\\^[ \n\t]*{A}" . "\Â")
       ( "\\\\\"[ \n\t]*{A}" . "\Ä")
       ( "\\\\'[ \n\t]*{E}" . "\É")
       ( "\\\\`[ \n\t]*{E}" . "\È")
       ( "\\\\^[ \n\t]*{E}" . "\Ê" )
       ( "\\\\\"[ \n\t]*{E}" . "\Ë")
       ( "\\\\'[ \n\t]*{I}" . "\�")
       ( "\\\\`[ \n\t]*{I}" . "\Ì")
       ( "\\\\^[ \n\t]*{I}" . "\ÃŽ")
       ( "\\\\\"[ \n\t]*{I}" . "\�")
       ( "\\\\'[ \n\t]*{O}" . "\0")
       ( "\\\\`[ \n\t]*{O}" . "\Ã’")
       ( "\\\\^[ \n\t]*{O}" . "\Ô")
       ( "\\\\\"[ \n\t]*{O}" . "\Ö")
       ( "\\\\'[ \n\t]*{U}" . "\Ú")
       ( "\\\\`[ \n\t]*{U}" . "\Ù")
       ( "\\\\^[ \n\t]*{U}" . "\Û")
       ( "\\\\'[ \n\t]*a" . "\á" )
       ( "\\\\`[ \n\t]*a" . "\à" )
       ( "\\\\^[ \n\t]*a" . "\â" )
       ( "\\\\\"[ \n\t]*a" . "\ä" )
       ( "\\\\'[ \n\t]*e" . "\é" )
       ( "\\\\`[ \n\t]*e" . "\è")
       ( "\\\\^[ \n\t]*e" . "\ê")
       ( "\\\\\"[ \n\t]*e" . "\ë")
       ( "\\\\'{\\\\i}" . "\í")
       ( "\\\\`{\\\\i}" . "\ì")
       ( "\\\\^{\\\\i}" . "\î")
       ( "\\\\\"{\\\\i}" . "\ï")
       ( "\\\\'\\\\[ \n\t]*i" . "\í")
       ( "\\\\`\\\\[ \n\t]*i" . "\ì")
       ( "\\\\^\\\\[ \n\t]*i" . "\î")
       ( "\\\\\"\\\\[ \n\t]*i" . "\ï")
       ( "\\\\'[ \n\t]*o" . "\ó")
       ( "\\\\`[ \n\t]*o" . "\ò")
       ( "\\\\^[ \n\t]*o" . "\ô")
       ( "\\\\\"[ \n\t]*o" . "\ö")
       (  "\\\\'[ \n\t]*u" . "\ú")
       ( "\\\\`[ \n\t]*u" . "\ù")
       ( "\\\\^[ \n\t]*u" . "\û")
       ( "\\\\\"[ \n\t]*u" . "\ü")
       ( "\\\\c[ \n\t]*{c}" . "\ç")
       ( "\\\\\"[ \n\t]*{u}" . "\ü")
       ( "\\\\'[ \n\t]*{a}" . "\á" )
       ( "\\\\`[ \n\t]*{a}" . "\à" )
       ( "\\\\^[ \n\t]*{a}" . "\â" )
       ( "\\\\\"[ \n\t]*{a}" . "\ä" )
       ( "\\\\'[ \n\t]*{e}" . "\é" )
       ( "\\\\`[ \n\t]*{e}" . "\è")
       ( "\\\\^[ \n\t]*{e}" . "\ê")
       ( "\\\\\"[ \n\t]*{e}" . "\ë")
       ( "\\\\'[ \n\t]*{o}" . "\ó")
       ( "\\\\`[ \n\t]*{o}" . "\ò")
       ( "\\\\^[ \n\t]*{o}" . "\ô")
       ( "\\\\\"[ \n\t]*{o}" . "\ö")
       (  "\\\\'[ \n\t]*{u}" . "\ú")
       ( "\\\\`[ \n\t]*{u}" . "\ù")
       ( "\\\\^[ \n\t]*{u}" . "\û")
       ( "\\\\\"[ \n\t]*{u}" . "\ü")
       )
     t ;; utilisation de d'expression régulière
     )
    ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; accents-html : change les caracteres accentues en accents html
;; sans demander confirmation
;; les majuscules sont respectees
;;
;; html-accents : change les accents html en caracteres accentues
;; sans demander confirmation
;; les majuscules sont respectees

(defconst accents-convertisseur-html
  (make-instance 'accents-convertisseur-simple 
		 :id 'accents-convertisseur-html
		 :liste-de-remplacement
   '(
     ( "\∀" . "&forall;")
     ( "\∂" . "&part;")
     ( "\∃" . "&exist;")
     ( "\∅" . "&empty;")
     ( "\∇" . "&nabla;")
     ( "\∈" . "&isin;")
     ( "\∉" . "&notin;")
     ( "\∋" . "&ni;")
     ( "\�" . "&prod;")
     ( "\∑" . "&sum;")
     ( "\−" . "&minus;")
     ( "\∗" . "&lowast;")
     ( "\√" . "&radic;")
     ( "\�" . "&prop;")
     ( "\∞" . "&infin;")
     ( "\∠" . "&ang;")
     ( "\∧" . "&and;")
     ( "\∨" . "&or;")
     ( "\∩" . "&cap;")
     ( "\∪" . "&cup;")
     ( "\∫" . "&int;")
     ( "\∴" . "&there4;")
     ( "\∼" . "&sim;")
     ( "\≅" . "&cong;")
     ( "\≈" . "&asymp;")
     ( "\≠" . "&ne;")
     ( "\≡" . "&equiv;")
     ( "\≤" . "&le;")
     ( "\≥" . "&ge;")
     ( "\⊂" . "&sub;")
     ( "\⊃" . "&sup;")
     ( "\⊄" . "&nsub;")
     ( "\⊆" . "&sube;")
     ( "\⊇" . "&supe;")
     ( "\⊕" . "&oplus;")
     ( "\⊗" . "&otimes;")
     ( "\⊥" . "&perp;")
     ( "\â‹…" . "&sdot;")
     ( "\Α" . "&Alpha;")
     ( "\Î’" . "&Beta;")
     ( "\Γ" . "&Gamma;")
     ( "\Δ" . "&Delta;")
     ( "\Ε" . "&Epsilon;")
     ( "\Ζ" . "&Zeta;")
     ( "\Η" . "&Eta;")
     ( "\Θ" . "&Theta;")
     ( "\Ι" . "&Iota;")
     ( "\Κ" . "&Kappa;")
     ( "\Λ" . "&Lambda;")
     ( "\Μ" . "&Mu;")
     ( "\�" . "&Nu;")
     ( "\Ξ" . "&Xi;")
     ( "\Ο" . "&Omicron;")
     ( "\Π" . "&Pi;")
     ( "\Ρ" . "&Rho;")
     ( "\Σ" . "&Sigma;")
     ( "\Τ" . "&Tau;")
     ( "\Î¥" . "&Upsilon;")
     ( "\Φ" . "&Phi;")
     ( "\Χ" . "&Chi;")
     ( "\Ψ" . "&Psi;")
     ( "\Ω" . "&Omega;")
     ( "\α" . "&alpha;")
     ( "\β" . "&beta;")
     ( "\γ" . "&gamma;")
     ( "\δ" . "&delta;")
     ( "\ε" . "&epsilon;")
     ( "\ζ" . "&zeta;")
     ( "\η" . "&eta;")
     ( "\θ" . "&theta;")
     ( "\ι" . "&iota;")
     ( "\κ" . "&kappa;")
     ( "\λ" . "&lambda;")
     ( "\μ" . "&mu;")
     ( "\ν" . "&nu;")
     ( "\ξ" . "&xi;")
     ( "\ο" . "&omicron;")
     ( "\Ï€" . "&pi;")
     ( "\�" . "&rho;")
     ( "\Ï‚" . "&sigmaf;")
     ( "\σ" . "&sigma;")
     ( "\Ï„" . "&tau;")
     ( "\Ï…" . "&upsilon;")
     ( "\φ" . "&phi;")
     ( "\χ" . "&chi;")
     ( "\ψ" . "&psi;")
     ( "\ω" . "&omega;")
     ( "\Ï‘" . "&thetasym;")
     ( "\Ï’" . "&upsih;")
     ( "\Ï–" . "&piv;")
     ( "\Å’" . "&OElig;")
     ( "\Å“" . "&oelig;")
     ( "\Å " . "&Scaron;")
     ( "\Å¡" . "&scaron;")
     ( "\Ÿ" . "&Yuml;")
     ( "\Æ’" . "&fnof;")
     ( "\ˆ" . "&circ;")
     ( "\˜" . "&tilde;")
     ( "\ " . "&ensp;")
     ( "\ " . "&emsp;")
     ( "\ " . "&thinsp;")
     ( "\‌" . "&zwnj;")
     ( "\�" . "&zwj;")
     ( "\‎" . "&lrm;")
     ( "\�" . "&rlm;")
     ( "\–" . "&ndash;")
     ( "\—" . "&mdash;")
     ( "\‘" . "&lsquo;")
     ( "\’" . "&rsquo;")
     ( "\‚" . "&sbquo;")
     ( "\“" . "&ldquo;")
     ( "\�" . "&rdquo;")
     ( "\„" . "&bdquo;")
     ( "\†" . "&dagger;")
     ( "\‡" . "&Dagger;")
     ( "\•" . "&bull;")
     ( "\…" . "&hellip;")
     ( "\‰" . "&permil;")
     ( "\′" . "&prime;")
     ( "\″" . "&Prime;")
     ( "\‹" . "&lsaquo;")
     ( "\›" . "&rsaquo;")
     ( "\‾" . "&oline;")
     ( "\¢" . "&cent;")
     ( "\€" . "&euro;")
     ( "\£" . "&pound;")
     ( "\Â¥" . "&yen;")
     ( "\§" . "&sect;")
     ( "\©" . "&copy;")
     ( "\®" . "&reg;")
     ( "\â„¢" . "&trade;")
     ( "\ℵ" . "&alefsym;")
     ( "\�" . "&larr;")
     ( "\↑" . "&uarr;")
     ( "\→" . "&rarr;")
     ( "\↓" . "&darr;")
     ( "\↔" . "&harr;")
     ( "\↵" . "&crarr;")
     ( "\�" . "&lArr;")
     ( "\⇒" . "&rArr;")
     ( "\⇔" . "&hArr;")
     ( "\⇓" . "&dArr;")
     ( "\⇑" . "&uArr;")
     ( "\↨"  . "&#8616;")
     ( "\⌈" . "&lceil;")
     ( "\⌉" . "&rceil;")
     ( "\⌊" . "&lfloor;")
     ( "\⌋" . "&rfloor;")
     ( "\â—Š" . "&loz;")
     ( "\â™ " . "&spades;")
     ( "\♣" . "&clubs;")
     ( "\♥" . "&hearts;")
     ( "\♦" . "&diams;")
     ( "\�" . "&Aacute;")
     ( "\À" . "&Agrave;")
     ( "\Â" . "&Acirc;")
     ( "\Ä" . "&Auml;")
     ( "\É" . "&Eacute;")
     ( "È" . "&Egrave;")
     ( "\Ê" . "&Ecirc;")
     ( "\Ë" . "&Euml;")
     ( "\�" . "&Iacute;")
     ( "\Ì" . "&Igrave;")
     ( "\ÃŽ" . "&Icirc;")
     ( "\�" . "&Iuml;")
     ( "\Ó" . "&Oacute;")
     ( "\Ã’" . "&Ograve;")
     ( "\Ô" . "&Ocirc;")
     ( "\Ö" . "&Ouml;")
     ( "\Ú" . "&Uacute")
     ( "\Ù" . "&Ugrave;")
     ( "\Û" . "&Ucirc;")
     ( "\Ü" . "&Uuml;")
     ( "\Ç" . "&Ccedil;")
     ( "\á" . "&aacute;")
     ( "\à" . "&agrave;")
     ( "\â" . "&acirc;")
     ( "\ä" . "&auml;")
     ( "\é" . "&eacute;")
     ( "\è" . "&egrave;")
     ( "\ê" . "&ecirc;")
     ( "\ë" . "&euml;")
     ( "\…" . "&hellip;")
     ( "\í" . "&iacute;")
     ( "\ì" . "&igrave;")
     ( "\î" . "&icirc;")
     ( "\ "  . "&nbsp;")
     ( "\ï" . "&iuml;")
     ( "\ó" . "&oacute;")
     ( "\ò" . "&ograve;")
     ( "\Å“" . "&oelig;")
     ( "\ô" . "&ocirc;")
     ( "\ö" . "&ouml;")
     ( "\ú" . "&uacute")
     ( "\ù" . "&ugrave;")
     ( "\û" . "&ucirc;")
     ( "\ü" . "&uuml;")
     ( "\ç" . "&ccedil;")
     ("\«"  . "&laquo;")
     ("\»"  . "&raquo;")
     ("\ß" . "&szlig;")
     ("\Þ" . "&THORN;")
     ("�" . "&#357;")
     ("\ž" . "&#382;")
     ("\¡" . "&iexcl;")
     ("\¤" . "&curren;")
     ("\¦" . "&brvbar;")
     ("\¨" . "&uml;")
     ("\ª" . "&ordf;")
     ("\¬" . "&not;")
     ("\­" . "&shy;")
     ("\¯" . "&macr;")
     ("\°" . "&deg;")
     ("\±" . "&plusmn;")
     ("\²" . "&sup2;")
     ("\³" . "&sup3;")
     ("\´" . "&acute;")
     ("\µ" . "&micro;")
     ("\¶" . "&para'")
     ("\·" . "&middot;")
     ("\¸" . "&cedil;")
     ("\¹" . "&sup1;")
     ("\º" . "&ordm;")
     ("\¼" . "&frac14;")
     ("\½" . "&frac12;")
     ("\¾" . "&frac34;")
     ("\¿" . "&iquest;")
     ("\Ã" . "&Atilde;")
     ("\Ã…" . "&Aring;")
     ("\Æ" . "&AElig;")
     ("\�" . "&ETH;")
     ("\Ñ" . "&Ntilde;")
     ("\×" . "&times;")
     ("\Ø" . "&Oslash;")
     ("\�" . "&Yacute;")
     ("\ã" . "&atilde;")
     ("\Ã¥" . "&aring;")
     ("\æ" . "&aelig;")
     ("\ð" . "&eth;")
     ("\ñ" . "&ntilde;")
     ("\õ" . "&otilde;")
     ("\÷" . "&divide;")
     ("\ø" . "&oslash;")
     ("\ý" . "&yacute;")
     ("\þ" . "&thorn;")
     ("\ÿ" . "&yuml;")
     ) )
  "Converstisseur de lettres accentuées en entités HTML équivalentes. 
Cf http://www.webdesigneuse.net/Trouver-une-entite-HTML.html")

(defconst accents-convertisseur-de-html
  (make-instance
   'accents-convertisseur-inverse
   :id 'accents-convertisseur-de-html
   :liste-de-remplacement (oref accents-convertisseur-html
				:liste-de-remplacement))
  "Converstisseur d'entités HTML en lettres accentuées équivalentes" )

(defun accents-html ()
  (interactive)
  "change les caractères accentués en entités HTML équivalentes."
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-conversion accents-convertisseur-html beg end)))


(defun accents-de-html ()
  (interactive)
  "change les entités HTML en caractères accentués équivalents."
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end (let ((m make-marker)) (set-marker m (region-end)) m)))
    (accents-conversion accents-convertisseur-de-html beg end)
    (save-excursion
      (save-match-data 
	(goto-char (or beg (point-min)))
	(while (re-search-forward "&#\\([0-9]+\\);" end t)
	  (replace-match (string (string-to-number (match-string 1))) t t))))
    (when end (set-marker end nil))))

;;---------------------------------------------------------------------------

(defconst accents-convertisseur-quote-html
  (make-instance 'accents-convertisseur-simple 
		 :id 'accents-convertisseur-quote-html
		 :liste-de-remplacement
		 '( ( "<" . "&lt;")
		    ( ">" . "&gt;")
		    ( "\"" . "&quot;")))
  "Convertisseur des caractères `\"', `<', et `>' en entités HTML
  &quot; &lt; et &gt correspondantes.")

(defconst accents-convertisseur-de-quote-html
  (make-instance
   'accents-convertisseur-inverse
   :id 'accents-convertisseur-de-quote-html
   :liste-de-remplacement (oref accents-convertisseur-quote-html
				:liste-de-remplacement))
  "Convertisseur des entités HTML &quot; &lt; et &gt, en caractères correspondants." )

(defun accents-quote-html ()
  (interactive)
  "Convertisseur des caractères `\"', `<', et `>' en entités HTML
  &quot; &lt; et &gt correspondantes."
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-conversion accents-convertisseur-quote-html beg end)))

;;---------------------------------------------------------------------------
(defconst accents-convertisseur-de-utf-8
  (make-instance 
   'accents-convertisseur-simple
   :id 'accents-convertisseur-de-utf-8
   :liste-de-remplacement 
   '(("ï" . "ï")
     ("é" . "é")
     ("â" . "â")
     ("û" . "û")
     ("è" . "è")
     ("ä" . "ä")
     ("ù" . "ù")
     ( "ç" . "ç")
     ("ê" . "ê")
     ("à" . "à")
     ("ô" . "ô")
     ))
  "Conversion de codage UTF-8 non reconue en caractères équivalents")

(defconst accents-convertisseur-de-utf-8
  (make-instance 
   'accents-convertisseur-simple
   :id 'accents-convertisseur-de-utf-8
   :liste-de-remplacement 
   '(
     ("ƒ‹" . "ы")
     ("ƒÃ" . "�")
     ("‘�" . "�")
     ("à" . "à")
     ("â" . "â")
     ("ä" . "ä")
     ("ç" . "ç")
     ("è" . "è")
     ("é" . "é")
     ("ê" . "ê")
     ("ï" . "ï")
     ("ô" . "ô")     
     ("î" . "î")
     ("ù" . "ù")
     ("û" . "û")
     ("��" . "�")
     ("�Ÿ" . "П")
     ("�°" . "а")
     ("�²" . "в")     
     ("�´" . "д")
     ("�µ" . "е")     
     ("�¶" . "ж")
     ("�·" . "з")
     ("�¸" . "и")     
     ("�º" . "к")
     ("�»" . "л")
     ("�¾" . "о")
     ("р" . "р")
     ("р" . "р")
     ("т" . "т")
     ("у" . "у")
     ("ÑÅ" . "т")
     ("�±" . "б")
     ("т´" . "�")
     ("µÑ" . "е")
     ("ˆÑ" . "е")
     ("�£" . "У")
     ("�½" . "н")
     ("�¯" . "Я")
     ("�³" . "г")
     ("ÑÄ" . "т")
     ("�¾" . "о")
     ("ÑÃ" . "у")
     ("‘Ž" . "ю")
     ("�" . "�")
     ("�°" . "а")
     ("�½" . "н")
     ("ш" . "ш")
     ("�¸" . "и")
     ("ю" . "ю")
     
))
  "Conversion de codage UTF-8 non reconue en caractères équivalents")

(defun doit ()
  (interactive)
  (insert (logand (aref (buffer-substring-no-properties (point) (1+ (point))) 0) 255))
  (delete-region (point) (1+ (point))))

(defconst accents-convertisseur-utf-8
  (make-instance 
   'accents-convertisseur-inverse
   :id 'accents-convertisseur-utf-8
   :liste-de-remplacement (oref accents-convertisseur-de-utf-8
				:liste-de-remplacement))
  "Conversion de codage UTF-8 non reconue en caractères équivalents")


(defun accents-de-utf-8 ()
  (interactive)
  "change les séquence UTF-8 en caractères accentués équivalents."
  (accents-conversion accents-convertisseur-de-utf-8))

(defun accents-utf-8 ()
  (interactive)
  "change les caractères accentués en séquences UTF-8  équivalentes."
  (accents-conversion accents-convertisseur-utf-8))
  


(provide 'accents-ascii)

Revision-number: 14
Prop-content-length: 156
Content-length: 156

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2012-01-28T08:40:39.000000Z
K 7
svn:log
V 54
renommage accents-dur-tex-html.el en accents-ascii.el

PROPS-END

Node-path: trunk/lisp/accents-dur-tex-html.el
Node-action: delete

Revision-number: 15
Prop-content-length: 140
Content-length: 140

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2012-01-28T08:51:54.000000Z
K 7
svn:log
V 38
Documentation du chargement du paquet

PROPS-END

Node-path: trunk/doc/html-to-texi.texi
Node-kind: file
Node-action: change
Text-content-length: 14106
Text-content-md5: a2e1deb3858f9b9a27b86dc08490585f
Content-length: 14106

\input texinfo   @c -*- mode: texinfo; coding: iso-8859-15 -*-
@c %**start of header
@setfilename html-to-texi.info
@set VERSION $Id: html-to-texi.texi,v 1.3 2012-01-28 08:51:54 Vincent Exp $
@set TEXINFO @acronym{Texinfo}
@set HTML-TO-TEXI @code{html-to-texi}
@set HTML-TO-TEXI-PLAIN html-to-texi
@set HTML-TO-TEXI-DOT-EL @code{html-to-texi}
@set HTML-TO-TEXI-FILE @file{html-to-texi.el}
@set ACCENTS-ASCII-FILE @file{accents-ascii.el}
@settitle @value{HTML-TO-TEXI}@comma{} un convertisseur de HTML en @value{TEXINFO} pour EMACS
@documentencoding ISO-8859-15
@documentlanguage fr
@c %**end of header
@copying
Ceci est la documentation du paquetage @value{HTML-TO-TEXI}
d'@acronym{EMACS}, version @value{VERSION} Copyright @copyright{} 2011
Vincent Belaïche.


L'utilisation de @value{HTML-TO-TEXI} est permise selon les termes de la
license CeCILL v2.
@end copying

@dircategory Emacs
@direntry
*  html-to-texi: (html-to-texi). Un paquetage @acronym{EMACS} pour convertir du code @acronym{HTML} en code @value{TEXINFO}.
@end direntry

@titlepage
@title @value{HTML-TO-TEXI}, manuel d'utilisation
@subtitle @value{HTML-TO-TEXI}@comma{} un convertisseur de @acronym{HTML} en @value{TEXINFO} pour @acronym{EMACS}
@author Vincent Belaïche

@c  The following two commands
@c  start the copyright page.
@page
@vskip 0pt plus 1filll
@insertcopying
@c Publié par Vincent Belaïche
@end titlepage

@c Production de la table des matières
@contents

@ifnottex
@c --------------------------------------------------------------------------------
@node Top,,,(dir)top
@top N½ud chapeau.

Ceci est le manuel du paquetage html-to-texi d'Emacs.
@end ifnottex

@menu
* Vue d'ensemble:: Vue d'ensemble.
* Installation:: Comment installer le paquetage html-to-texi.
* Les Bases:: html-to-texi pour le débutant.
* Expérimenté:: html-to-texi pour l'utilisateur expérimenté.
* Indexes:: Indexes des concepts, commandes, et variables.
* Quoi d'neuf:: Ce qui est nouveau pour le paquetage html-to-texi.
* Remerciements:: .
@end menu

@node Vue d'ensemble, Installation,,                 Top
@chapter Vue d'ensemble


@menu
* Pour l'utilisateur pressé::   Noctice succinte à l'intention des utilisateurs pressés
* Motivation::                  De l'interêt de convertir du @acronym{HTML} en @acronym{Texinfo}
* Autres convertiseurs::        Autres convertiseurs de @acronym{HTML} en @acronym{Texinfo}
@end menu


@node Pour l'utilisateur pressé, Motivation, , Vue d'ensemble
@comment  node-name,  next,  previous,  up
@section Noctice succinte à l'intention des utilisateurs pressés


@value{HTML-TO-TEXI} permet de convertir un document @acronym{HTML} en un
document @value{TEXINFO}. Pour l'utiliser on procède comme cela :@*

@enumerate
@item
Lancer @acronym{EMACS}.
@item
Ouvrir dans @acronym{EMACS} le fichier @acronym{HTML} chapeau du
document @acronym{HTML}, ce fichier se nomme en général
@file{index.html}, ce que l'on suppose par la suite, et est la racine de
l'arbre des fichiers @acronym{HTML} constitutif du document
@acronym{HTML} à convertir. Il se peut aussi que votre document
@acronym{HTML} ne soit constitué que d'un seul fichier pour tout le
document, dans ce cas c'est celui-ci qu'il faut ouvrir.
@item
S'assurer que le paquetage @value{HTML-TO-TEXI-DOT-EL} est chargé, ou se
chargera. Ceci peut être déjà fait si le chargement est effectué
automatiquement au lancement d'@acronym{EMACS} ou à l'ouverture d'un
fichier @acronym{HTML}, ou encore si le paquetage
@value{HTML-TO-TEXI-DOT-EL} est en chargment automatique
(@pxref{LoadLisp}).
@item
Alors que sous @acronym{EMACS} le tampon courant est @file{index.html},
lancer la commande @code{M-x html2texi}, cela crée un tampon
@file{index.texi} contenant le code @value{TEXINFO} résultant de la
conversion. Attention : si le tampon @file{index.texi} existait déjà,
alors il est effacé.
@item
Enregistrer le tampon @file{index.texi} en un fichier à votre
convenance.
@end enumerate

@node Motivation, Autres convertiseurs, Pour l'utilisateur pressé, Vue d'ensemble
@comment  node-name,  next,  previous,  up
@section De l'interêt de convertir du @acronym{HTML} en @acronym{Texinfo} 


@node Autres convertiseurs,, Motivation, Vue d'ensemble
@comment  node-name,  next,  previous,  up
@section Autres convertiseurs de @acronym{HTML} en @acronym{Texinfo}

À ma connaissance@uref{http://code.google.com/p/html2texi/}


@node Installation, Les Bases, Vue d'ensemble, Top
@chapter Comment installer le paquetage @value{HTML-TO-TEXI}

@menu
* InstallDoc:: Installation de la documentation
* InstallLisp:: Installation des fichiers Lisp
* LoadLisp:: chargement du code Lisp en mémoire
@end menu

@node InstallDoc, InstallLisp, , Installation
@section Installation de la documentation
@comment  node-name,  next,  previous,  up

La documentaton est écrite en @acronym{Texinfo} ce qui permet de la
compiler en plusieurs formats, à savoir @acronym{Info}, @acronym{HTML}
et @acronym{PDF} pour les plus connus. On se reportera à la documentation
de @acronym{Texinfo} pour les détails de la compilation. Un bref résumé
de ce qui est à faire suit.

@menu
* DocInfo:: Compilation de la documentation au format @acronym{info}
* DocHTML:: Compilation de la documentation au format @acronym{HTML}
* DocPDF:: Compilation de la documentation au format @acronym{PDF}
@end menu

@node DocInfo, DocHTML, , InstallDoc
@comment  node-name,  next,  previous,  up
@subsection Compilation de la documentation au format @acronym{info}

Il vous faut les outils @file{makeinfo} et @file{install-dir}. Pour
@acronym{MS-Windows} ces outils se trouvent dans les distributions de
@acronym{MSYS} et de @acronym{MikTeX}. On peut également les télécharger
du site officiel de @acronym{Texinfo} :
@url{https://savannah.gnu.org/projects/texinfo}.

Il suffit alors de procéder comme suit:

@enumerate
@item
Lancer une console de commande (@acronym{MSDOS}, @acronym{bash},
etc. @dots{}) et se placer dans le répertoire où se trouve le fichier
@file{html-to-texi.texi}.
@item
Lancer la commande:

@smallexample
makeinfo html-to-texi.texi
@end smallexample

Un fichier @file{html-to-texi.info} est produit.
@item
On suppose que vous utilisez @acronym{EMACS} comme navigateur
@acronym{Info}, deplacer le fichier @file{html-to-texi.info} dans un
répertoire connu d'@acronym{EMACS}, c'est à dire figurant la variable
@acronym{EMACS} @code{Info-directory-list}, ou dans la variable
d'environnement @code{INFOPATH}.
@item
Allez dans le répertoire où vous avez déplacé le fichier @file{html-to-texi.info}, et lancer la commande:

@smallexample
install-dir html-to-tex.info
@end smallexample

Ceci modifie le fichier @file{dir} présent dans ce répertoire et en servant d'indexe.
@item
C'est fini, en faisant @kbd{C-h i}, vous trouverez @value{HTML-TO-TEXI}
dans la liste des manuels listés dans dans le n½ud d'info @file{(dir)
Top}.
@end enumerate

@node DocHTML, DocPDF, DocInfo, InstallDoc
@comment  node-name,  next,  previous,  up
@subsection Compilation de la documentation au format @acronym{HTML}

Il vous faut l'outil @file{makeinfo}. Pour @acronym{MS-Windows} cet
outil se trouve dans les distributions de @acronym{MSYS} et de
@acronym{MikTeX}. On peut également les télécharger du site officiel de
@acronym{Texinfo} : @url{https://savannah.gnu.org/projects/texinfo}.

Il suffit alors de procéder comme suit:

@enumerate
@item
Lancer une console de commande (@acronym{MSDOS}, @acronym{bash},
etc. @dots{}) et se placer dans le répertoire où se trouve le fichier
@file{html-to-texi.texi}.
@item
Lancer la commande:

@smallexample
makeinfo --html html-to-texi.texi
@end smallexample

Les fichiers @acronym{HTML} sont alors produit dans le même répertoire,
le fichier @acronym{HTML} chapeau étant dans @file{html-to-texi/index.html}.
@end enumerate


@node DocPDF,  , DocHTML, InstallDoc
@comment  node-name,  next,  previous,  up
@subsection Compilation de la documentation au format @acronym{PDF}

Il vous faut les outils @file{etex}, @file{dvips} et @file{ps2pdf}, tous
ces outils sont disponibles dans une distribution @LaTeX{}, par exemple
@acronym{MikTeX} ou @acronym{TeXLive} si vous êtes sous
@acronym{MSWindows}.

@enumerate
@item
Lancer une console de commande (@acronym{MSDOS}, @acronym{bash},
etc. @dots{}) et se placer dans le répertoire où se trouve le fichier
@file{html-to-texi.texi}.
@item
Lancer la commande :

@smallexample
etex html-to-texi.texi
@end smallexample

Un fichier @file{html-to-texi.dvi} est produit.
@item
Lancer la commande :

@smallexample
dvips html-to-texi.dvi
@end smallexample

Un fichier @file{html-to-texi.ps} est produit.
@item
Lancer la commande :

@smallexample
ps2pdf html-to-texi.ps
@end smallexample

Un fichier @file{html-to-texi.pdf} est produit.
@end enumerate


@node InstallLisp, LoadLisp, InstallDoc,  Installation
@section Installation du code lisp
@comment  node-name,  next,  previous,  up

Le paquetage @value{HTML-TO-TEXI} comprend deux fichiers en langage
emacs-lisp, respectivement @value{HTML-TO-TEXI-FILE} et
@value{ACCENTS-ASCII-FILE}. La première chose à faire est de placer ces
fichiers, ou une copie de ces fichiers dans un répertoire où
@acronym{EMACS} saura les trouver, c'est à dire un répertoire déclaré
dans la variable @code{load-path}. Inversement, vous pouvez rajouter
dans cette variable un nouveau chemin de répertoire pour le répertoire
où se trouvent ces fichiers.

@node LoadLisp, , InstallLisp, Installation
@comment  node-name,  next,  previous,  up
@section Chargement du code lisp

Pour que la commande @code{M-x html2texi} puisse s'exécuter il faut que
le code Lisp correspondant soit chargé en mémoire. Pour obtenir ce
résultat il y a plusieurs façons de faire, chacune ayant ses avantages
et ses inconvénients.

@menu
* InitLoad:: Chargement systématique au lancement d'@acronym{EMACS}
* HTMLLoad:: Chargement à l'ouverture d'un fichier en mode @code{HTML}
* AutoLoad:: Chargement à l'appel de @code{M-x html2texi}
@end menu

@node InitLoad, HTMLLoad, LoadLisp, LoadLisp
@comment  node-name,  next,  previous,  up
@subsection  Chargement systématique au lancement d'@acronym{EMACS}

Très simple, il suffit d'ajouter la ligne suivante dans votre fichier
d'init.@: :

@smalllisp
(load "@value{HTML-TO-TEXI-PLAIN}")
@end smalllisp

L'avantage c'est que c'est la méthode la plus simple pour charger le
code.

L'inconvénient de procéder ainsi et qu'à chaque fois que vous lancerez
@acronym{EMACS} alors un peu de temps est pris pour charger
@value{HTML-TO-TEXI}, sans compter que @value{HTML-TO-TEXI} consommera
un peu de mémoire, alors que peut-être vous ne l'utiliserez pas dans la
session @acronym{EMACS} que vous ouvrez.

@node HTMLLoad, AutoLoad, InitLoad, LoadLisp
@comment  node-name,  next,  previous,  up
@subsection  Chargement à l'ouverture d'un fichier en mode @code{HTML}

L'idée c'est d'utiliser une fonction crochet qui fera le chargement si
nécessaire à l'ouverture de tout fichier @acronym{HTML}. Pour que ça
marche il faut que @acronym{EMACS} soit configuré pour lancer le mode
@code{html-mode} lorsque vous ouvrez un fichier @acronym{HTML} est
visité, sinon la fonction crochet ne sera pas lancée.

Il suffit que vous rajoutiez le code suivant dans votre fichier d'init.@: :

@smalllisp
(defun mon-crochet-pour-charger-@value{HTML-TO-TEXI-PLAIN} ()
   (require '@value{HTML-TO-TEXI-PLAIN}))

(add-hook 'html-mode-hook 'mon-crochet-pour-charger-@value{HTML-TO-TEXI-PLAIN})
@end smalllisp

@node AutoLoad,  , HTMLLoad, LoadLisp
@comment  node-name,  next,  previous,  up
@subsection  Chargement à l'appel de @code{M-x html2texi}

La commande @code{html2texi} est définie au sein du fichier
@value{HTML-TO-TEXI-FILE} et elle y est déclarée avec une balise
spéciale @code{autoload}. Il suffit donc de lancer la commande @code{M-x
update-file-autoloads} et à l'invite d'indiquer le chemin complet du
fichier @value{HTML-TO-TEXI-FILE} pour que le fichier @file{loaddefs.el}
soit mis à jour. Une fois que ceci est fait, alors dès le prochain
chargement d'@acronym{EMACS}, @acronym{EMACS} effectuera le chargement
de @value{HTML-TO-TEXI} si nécessaire à l'appel de la commande @code{M-x
html2texi}.

Pour que @code{M-x update-file-autoloads} marche il faut que ayez des
droits d'administrateur sur la machine sur laquelle vous travaillez. Il
faaut aussi @acronym{EMACS} ait été installé correctement de sorte que
la variable @code{source-directory} pointe sur le répertoire racine
d'@acronym{EMACS}, par exemple si l'exécutable d'@acronym{EMACS} est
sous le répertoire @file{/le/chemin/d/emacs/bin/} alors la variable
@code{source-directory} doit valoir @file{/le/chemin/d/emacs/}. Si
@code{source-directory} n'a pas cette valeur, alors évaluez
l'expression :

@smalllisp
(setq source-directory "/le/chemin/d/emacs/")
@end smalllisp

avant de lancer la commande @code{M-x update-file-autoloads}. Notez que
dans cette expression @file{/} peut être utilisé comme séparateur de
fichier même sous @acronym{MSWindows}. 

Si vous êtes sous @acronym{MSWindows} l'exécution de la commande
@file{addpm.exe} a pour effet de parfaire l'installation
d'@acronym{EMACS} en affectant la base de registre @acronym{MSWindows}
de sorte à ne pas avoir ce problème de définition de
@code{source-directory}. Pour que ça marche il faut que @file{addpm.exe}
soit dans le même répertoire que l'exécutable @acronym{EMACS}, à savoir
@file{/le/chemin/d/emacs/bin/} dans l'exemple considéré. Il faut
également que vous ayiez les privilèges d'administrateur.

@node Les Bases,      Expérimenté,   Installation,   Top 
@chapter  html-to-texi pour le débutant

@node Expérimenté, Indexes, Les Bases, Top
@chapter html-to-texi pour l'utilisateur expérimenté

@node Indexes,        Quoi d'neuf,   Expérimenté,    Top 
@chapter Indexes des concepts, commandes, et variables

@node Quoi d'neuf,    Remerciements, Indexes,        Top 
@chapter  Ce qui est nouveau pour le paquetage html-to-texi

@node Remerciements,,                Quoi d'neuf,    Top 
@chapter Remerciements

Remerciements à Sylvie Ruette pour ses macros de conversion de lettres
accentuées en divers formats.

@bye



@c Local Variables: 
@c mode: texinfo
@c TeX-master: t
@c End: 


Revision-number: 16
Prop-content-length: 430
Content-length: 430

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2012-01-31T21:22:58.000000Z
K 7
svn:log
V 327
- ajout des balise <em> et <strong>, et traitement de <i> et <b> par @i et @b
- ajout de html2texi-error et html2texi-warning et d'un tampon de log
- html2texi-make-html-clean-xml: rendu plus robuste à un html erroné
- html2texi-process-region: tente de ne pas appeler html2texi-make-html-clean-xml lorsqu'on a du XHTML.

PROPS-END

Node-path: trunk/lisp/html-to-texinfo.el
Node-kind: file
Node-action: change
Text-content-length: 50163
Text-content-md5: 468150a37fedc8e53f0f4a52b8d85398
Content-length: 50163

;;; html-to-texinfo.el --- -*- coding: iso-8859-1 -*-
;; Copyright 2010/2012 Vincent Belaïche
;;
;; Author: Vincent Belaïche <vincent.b.1@hotmail.fr>
;; Version: $Id: html-to-texinfo.el,v 1.7 2012-01-31 21:22:58 Vincent Exp $
;; Keywords:
;; X-URL: not distributed yet
;;
;; This software is governed by the CeCILL license under French law and
;; abiding by the rules of distribution of free software.  You can  use,
;; modify and/ or redistribute the software under the terms of the CeCILL
;; license as circulated by CEA, CNRS and INRIA at the following URL
;; "http://www.cecill.info".
;;
;; As a counterpart to the access to the source code and  rights to copy,
;; modify and redistribute granted by the license, users are provided only
;; with a limited warranty  and the software's author,  the holder of the
;; economic rights,  and the successive licensors  have only  limited
;; liability.
;;
;; In this respect, the user's attention is drawn to the risks associated
;; with loading,  using,  modifying and/or developing or reproducing the
;; software by the user in light of its specific status of free software,
;; that may mean  that it is complicated to manipulate,  and  that  also
;; therefore means  that it is reserved for developers  and  experienced
;; professionals having in-depth computer knowledge. Users are therefore
;; encouraged to load and test the software's suitability as regards their
;; requirements in conditions enabling the security of their systems and/or
;; data to be ensured and,  more generally, to use and operate it in the
;; same conditions as regards security.
;;
;; The fact that you are presently reading this means that you have had
;; knowledge of the CeCILL license and that you accept its terms.
;;
;;; Commentary:

;;

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'html-to-texinfo)

;;; Code:

(provide 'html-to-texinfo)
(eval-when-compile
  (require 'cl))
(require 'eieio)
(require 'calc-ext)
(require 'accents-ascii)

;;;;##########################################################################
;;;;  User Options, Variables
;;;;##########################################################################

(defconst html2texi-suspicious-html-tags
  '("meta" "br" "hr" "link" "img" "frame")
"Liste des balises pour lesquelles le HTML ne suit pas une
syntaxe strictement XML. Par exemple `<br>' est utilisé au lieu
de `<br/>'."  )

(defconst html2texi-suspicious-html-tags-re
  (regexp-opt html2texi-suspicious-html-tags))

(defconst html2texi-non-recursive-tags
  '("p" "li"))

(defconst html2texi-non-recursive-tags-re
  (regexp-opt html2texi-non-recursive-tags))

(defconst html2texi-texi-buffer-local-variables
  '(html2texi-document-information)
    "Liste des variables déclarées localement au tampon Texinfo.")

(defclass html2texi-simple-markup ()
  ((class-dependant
    :initarg :class-dependant
    :initform nil
    :custom '(repeat
	  (list
	   (regexp :tag "clef")
	   (string :tag "prologue")
	   (string :tag "épilogue")
	   (boolean :tag "conserver les espaces et retours chariot")
	   ))
    :documentation "\
Liste d'association dont les éléments sont de la forme
 (CLEF PROLOGUE ÉPILOGUE)

Supposons que l'objet décrit le traitement de la balise TAG,
alors lorsque le code HTML `<TAG class=\"CLEF\">CONTENU</TAG>'
est rencontré, alors il est convertie en le code Texinfo
`PROLOGUE TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU.")
   (preamble
    :initarg :preamble
    :type string
    :documentation "\
Prologue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (postamble
    :initarg :postamble
    :type string
    :documentation "\
Épilogue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (space-verb
    :initarg :space-verb
    :initform nil
    :type boolean
    :documentation "\
Vrai lorsque les espaces et retours chariot sont à conserver tels quels."
    ))
  :documentation "\
Un object de type `html2texi-simple-markup'
décrit le traitement d'une balise simple comme par exemple
<code>.")

(defun html2texi-texinfo-inside-comment-p ()
  "Renvoie non nil lorsque le point est dans un commentaire Texinfo."
  (save-match-data
    (save-excursion
      (let ((cur (point))
	    (end (progn (end-of-line) (point))))
	(beginning-of-line)
	(and (re-search-forward "\\(^\\|[^@]\\)@c\\(omment\\)\\_>" end t)
	     (<= (match-beginning 0) cur))))))

(defmethod html2texi-handle-simple-markup
  ((this html2texi-simple-markup) xml-expr)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe
			(and class-attribute
			     (assoc-string (cdr class-attribute)
					   (oref this :class-dependant))))
		      (list (oref this :preamble)
			    (oref this :postamble)))))
    (insert (car pre-post))
    (let ((beg (point))
	  end)
      (html2texi-process-xml-expr xml-expr)
      (unless (oref this :space-verb)
	(setq end (point-marker))
	(goto-char beg)
	(while (re-search-forward "[\n\r]\\s-*" nil end)
	  (let ((replace-str " "))
	    (save-match-data
	      (cond
	       ((html2texi-texinfo-inside-comment-p)
		(setq replace-str nil))))
	      (and replace-str (replace-match replace-str t t)))))
	(goto-char end)
	(set-marker end nil))
    (insert (cadr pre-post))))


(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-i-simple-markup
  (html2texi-simple-markup "html2texi-i-simple-markup"
   :preamble "@i{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-b-simple-markup
  (html2texi-simple-markup "html2texi-b-simple-markup"
   :preamble "@b{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-kbd-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :preamble "@kbd{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-dfn-simple-markup
  (html2texi-simple-markup "html2texi-dfn-simple-markup"
   :preamble "@dfn{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-em-simple-markup
  (html2texi-simple-markup "html2texi-em-simple-markup"
   :preamble "@emph{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-sub-simple-markup
  (html2texi-simple-markup "html2texi-sub-simple-markup"
   :preamble ""
   :postamble "")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<sub class=\"CLEF\">CONTENU</sub>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-sup-simple-markup
  (html2texi-simple-markup "html2texi-sup-simple-markup"
   :preamble ""
   :postamble "")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<sup class=\"CLEF\">CONTENU</sup>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-samp-simple-markup
  (html2texi-simple-markup "html2texi-samp-simple-markup"
   :preamble "@samp{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<samp class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-strong-simple-markup
  (html2texi-simple-markup "html2texi-strong-simple-markup"
   :preamble "@strong{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-tt-simple-markup
  (html2texi-simple-markup "html2texi-tt-simple-markup"
   :preamble "@t{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<tt class=\"CLEF\">CONTENU</tt>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-handle-two-columns-table-as-@table
  t
 "Si `nil' alors une table `<table>...</table>'
avec deux colonne sera gérée en texinfo par une `@table', si non
`nil', alors elle sera gérée par une `@multitable'."
  :type
  '(choice
    (const :tag "t pour @table" t)
    (const :tag "nil pour @multitable" nil))
  :group 'html2texi)

(defcustom html2texi-log-buffer-name
  "*HTML2TEXI*"
  "Nom du tampon de sortie des erreurs et avertissements de traitement."
  :type 'string
  :group 'html2texi)


(defvar html2texi-document-information nil
  "Liste d'association pour mémoriser les informations (titre,
  auteurs, etc...) propres à un document.")

(defvar html2texi-line-delta 0
  "Décalage entre le numéro de ligne du code XML au sein le
  tampon Texinfo en cours de traitement, et son numéro de ligne
  dans le fichier HTML source.")


(defvar html2texi-xml-parsed nil
  "Résultat de l'analyse syntaxique d'un doc")

(defvar html2texi-xml-stack nil
  "Pile des expressions XML")

(defvar html2texi-keep-empty-strings nil
  "Non nil si les chaînes vides sont à conserver.")

(defvar html2texi-ignore-head nil
  "Non nil si on ignore le <head> (dans un fichier HTML lié).")

(defvar html2texi-directory-stack nil
  "Pile des chemins de répertoire.")

(defvar html2texi-files-doing-or-done nil
  "Liste des fichiers déjà traités, ou le fichier en cours de traitement.
Le fichier en cours de traitement est en première position dans cette liste.")

(defvar html2texi-files-to-do nil
  "Liste des fichiers non encore traités")

(defvar html2texi-flushable-anchors nil
  "Liste de nom d'ancrage de lien dont l'insertion a été remise à
  plus tard." )

(defvar html2texi-postpone-output nil
  "Non `nil' lorsque l'insertion du code est remise à plus tard.")


(defvar html2texi-directory-ref nil
  "Répertoire de référence")

(defvar html2texi-log-buffer nil
  "Tampon de sortie des erreurs et avertissements de traitement.")

(defmacro html2texi-make-simple-markup-handler (tag)
  `(defun ,(intern (concat "html2texi-tag-handler-" (symbol-name tag)))
     (xml-expr)
     (html2texi-handle-simple-markup
      ,(intern (concat "html2texi-"  (symbol-name tag) "-simple-markup"))
      xml-expr) ))

(defun html2texi-make-html-clean-xml (beg end)
  (let  ((end-arg end)
	 end)
    (if (markerp end-arg)
	(setq end end-arg)
      (goto-char end-arg)
      (setq end (point-marker)))
    ;; rend les balise implicitement auto-closante vraiment auto-closante
    (goto-char beg)
   (while (re-search-forward (concat "<\\(" html2texi-suspicious-html-tags-re "\\)\\>")
			      end t)
      (let ((tag (match-string-no-properties 1)))
	(unless (re-search-forward ">" nil t)
	  (html2texi-error "%s:%d: Clôture non trouvé pour la balise %s" nil
		 (car html2texi-files-doing-or-done)
		 (+ (line-number-at-pos) html2texi-line-delta)
		 tag))
	(when (null (looking-back "/>"))
	  (backward-char)
	  (insert "/")
	  (forward-char))))
    ;; marque de paragraphe et de ligne
    (goto-char beg)
    (let (tag-stack pos-< pos->
		    tag is-closure self-closing)
      (while (re-search-forward "<\\(/\\)?\\([a-zA-Z]+\\)\\>" end t)
	(setq pos-< (match-beginning 0)
	      tag (match-string-no-properties 2)
	      is-closure (match-string-no-properties 1))
	(unless (string= tag (downcase tag))
	  (replace-match (setq tag (downcase tag)) 2))
	(unless (re-search-forward ">" end t)
	  (error "%s:%d: Soufflet de clôture non trouvé pour la balise %s"
		 (car html2texi-files-doing-or-done)
		 (+ (line-number-at-pos) html2texi-line-delta)
		 tag))
	
	(setq pos-> (point)
	      self-closing (looking-back "/>"))
	(cond
	 ((and self-closing  is-closure)
	  (error "%s:%d: balise %s à la fois de clôture et auto-closante"
		 (car html2texi-files-doing-or-done)
		 (+ (line-number-at-pos) html2texi-line-delta)
		 tag))

	 (self-closing
	  ;; do nothing
	  )

	 ((null is-closure)
	  (when (and
		 (string-match (concat "\\`" html2texi-non-recursive-tags-re "\\'") tag)
		 tag-stack
		 (string= tag (caar tag-stack)))
	    ;; clôture
	    (save-excursion
	      (goto-char pos-<)
	      (insert "</" tag "><!-- HTML2TEXI: repaired (1) -->")
	      (html2texi-warning "%s:%d: ajout clôture `</%s>'" nil
		    (car html2texi-files-doing-or-done)
		    (+ (line-number-at-pos) html2texi-line-delta)
		    tag))
	    (pop tag-stack))
	  (push (list tag) tag-stack))

	 (is-closure
	      (if (and tag-stack
		       (string= (caar tag-stack) tag))
		  (pop tag-stack)
		(let ((first (assoc-string tag tag-stack)) rev)
		  (if first
		      (progn
			(while (and tag-stack (null (eq (car tag-stack) first)))
			  (push (pop tag-stack) rev))
			(pop tag-stack)
			(save-excursion
			  (goto-char pos-<)
			  (dolist (c rev)
			    (insert  "</" (car c) "><!-- HTML2TEXI: repaired (2) -->" )
			     (html2texi-warning "%s:%d: ajout clôture `</%s>'" nil
				   (car html2texi-files-doing-or-done)
				   (+ (line-number-at-pos) html2texi-line-delta)
				   tag))))
		    
		    (save-excursion
		       (goto-char pos->)
		       (insert "-->")
		       (goto-char pos-<)
		       (insert "<!-- HTML2TEXI: repaired (3). "))
		    (html2texi-warning "%s:%d: Clôture de %s ne correspondant à aucune ouverture" nil
			   (car html2texi-files-doing-or-done)
			   (+ (line-number-at-pos) html2texi-line-delta)
			   tag)))))))


      (let (p-pos li-pos markup poss pos)
	(while (re-search-forward "<\\(/\\)?\\(p\\|li\\)\\>[^>]*>" end t)
	  (setq markup (match-string-no-properties 2)
		poss (intern (concat markup "-pos"))
		pos (symbol-value poss))
	  (if (match-string-no-properties 1)
	      (if  pos
		  (if (= pos (match-beginning 0))
		      (set poss nil)
		    (html2texi-error "%s:%d: Clôture de balise %s ne correspondant à aucune ouverture" nil
			   (car html2texi-files-doing-or-done)
			   (+ (line-number-at-pos) html2texi-line-delta)
			   (match-string-no-properties 0)))
		(save-excursion
		  (save-match-data
		    (unless  (re-search-forward
			      (format "<\\(/\\)?\\(%s\\)\\>[^>]+>" markup)
			      end t)
		      (html2texi-error "%s:%d: Ouverture de balise <%s> sans clôture" nil
			   (car html2texi-files-doing-or-done)
			   (+ (line-number-at-pos) html2texi-line-delta)
			     markup))
		    (set poss (match-beginning 0))
		    (unless (match-string-no-properties 1)
		      (goto-char (match-beginning 0))
		      (insert (format "</%s>" markup))
		      (dolist (symb '(p-pos li-pos))
			(unless (or (null (symbol-value symb))
				 (eq symb poss))
			  (set symb (+ (length markup) 3 (symbol-value symb)))))))))))
	    ))
    ;; mise entre guillemets anglais des attributs entier sans guillemets
    (goto-char beg)
    (let (pos-< p2 added-dquote-attributes p-start)
      ;; tant qu'on trouve potentiellement un attribut sans "..."
      (while (re-search-forward "\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([0-9]+\\)"
				nil end)
	(setq pos-< (match-beginning 1)
	      p2 (match-end 0))
	(if
	    ;; si la position est bien entre < et >
	    (and (re-search-backward "[<>]" nil beg)
		 (string= (match-string-no-properties 0) "<")
		 (looking-at "<\\sw+")
		 (progn
		   (goto-char (setq p-start (match-end 0)))
		   (re-search-forward "[<>]" nil beg)
		   (string= (match-string-no-properties 0) ">"))
		 (>= (point) pos-<))
	    ;; alors on fait la réparation
	    (progn
	      (goto-char p-start)
	      (while
		  (progn
		    (while (looking-at "\\(?:\\s-\\|\n\\)*\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\"[^\"]*\"")
		      (goto-char (match-end 0)))
		    (cond
		     ((looking-at  "\\(?:\\s-\\|\n\\)*\\(\\sw+\\)\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([0-9]+\\)")
		      (push (match-string-no-properties 1) added-dquote-attributes)
		      (goto-char (match-beginning 2))
		      (insert ?\")
		      (goto-char (1+ (match-end 2)))
		      (insert ?\"))
		     ((looking-at "\\(?:\\s-\\|\n\\)*>")
		      (goto-char (match-end 0))
		      (insert "<!-- HTML2TEXI inserted double quotes around values for attibutes"
			      (mapconcat (lambda (x) (concat "`" x "'"))
					 added-dquote-attributes
					 ", ")
			      ">")
		      nil)
		     (t (error "%s:%d: Attribut au format invalide: %s"
			       (car html2texi-files-doing-or-done)
			       (+ (line-number-at-pos) html2texi-line-delta)
			       (match-string-no-properties (point)
							      (+ p2
								 (* 2 (length added-dquote-attributes))))))))))
	  ;; sinon on continue à chercher un attribut potentiel dont la valeur
	  ;; n'est pas entre "..."
	  (goto-char p2))))

    ;; un peu de ménage...
    (unless (markerp end-arg)
      (set-marker end nil)) ))

;;;==========================================================================
;;; définition des gestionnaires de balise
;;;--------------------------------------------------------------------------

(defun html2texi-tag-handler-a (xml-expr)
  (let (name href text (xml-expr-length (length xml-expr)))
    (dolist (attrib (cadr xml-expr))
      (cond
       ((eq (car attrib) 'href)
	(setq href (cdr attrib)))
       ((eq (car attrib) 'name)
	(setq name (cdr attrib)))))
    (and (cddr xml-expr)
	 (setq text (caddr xml-expr)))
    (cond
     (href (html2texi-process-url href text))
     ((= xml-expr-length 3)
      (cond
       ((stringp text)
	(insert (html2texi-string-escape text t)))
       ((consp text) (html2texi-process-xml-expr text))
       (t (error "Le format du text de la balise <a> était inattendu"))))
     ((> xml-expr-length 3)
      (html2texi-process-xml-expr `(div nil ,@(cddr xml-expr)))))
    (and name
      (insert "\n@anchor{" (html2texi-make-anchor (concat "#" name)) "}\n"))))

(html2texi-make-simple-markup-handler b)

(defun html2texi-flush-anchors ()
  (while html2texi-flushable-anchors
    (insert "@anchor{" (pop html2texi-flushable-anchors) "}\n")))


(defun html2texi-tag-handler-h1 (xml-expr)
  (insert "@chapter " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))


(defun html2texi-tag-handler-h2 (xml-expr)
  (insert "@section " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))

(defun html2texi-tag-handler-h3 (xml-expr)
  (insert "@subsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
    (html2texi-flush-anchors))

(defun html2texi-tag-handler-h4 (xml-expr)
  (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))

(defun html2texi-tag-handler-h5 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
     (html2texi-flush-anchors))

(defun html2texi-tag-handler-h6 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
   (html2texi-flush-anchors))

(html2texi-make-simple-markup-handler samp)


(defun html2texi-get-col-span (xml-expr)
  ;; xml-expr is <td> or <th>
  (let ((col-span (cdr-safe (assq 'colspan (nth 1 xml-expr)))))
    (setq col-span
	  (cond
	   ((integerp
	       (setq col-span
		     (if (stringp col-span)
			 (string-to-number col-span)
		       col-span)))
	      col-span)
	   ((null col-span) 1)
	   (t (error "colspan invalide"))))  ))

(html2texi-make-simple-markup-handler sub)
(html2texi-make-simple-markup-handler sup)

(html2texi-make-simple-markup-handler tt)

(defvar html2texi-col-number nil)
(defvar html2texi-row-number nil)
(defvar html2texi-head-on-row-0 nil)
(defvar html2texi-col-count nil)
(defvar html2texi-col-info-length nil)

(defun html2texi-tag-handler-table (xml-expr)
  (let* (html2texi-col-count
	(html2texi-row-number 0)
	html2texi-head-on-row-0
	html2texi-col-number
	;; le premier élément ne correspond pas à une colonne mais servira à
	;; reduire le vecteur des informations sur chaque colonne
	(html2texi-col-info (list 0))
	(html2texi-col-info-last html2texi-col-info)
	(html2texi-col-info-length 0)
	(xml-items (cddr xml-expr)))
    (while xml-items
      (let ((xml-expr (pop xml-items)))
	(cond
	 ((and (consp xml-expr)
	       (eq (car xml-expr) 'tr))
	  ;; plus besoin de chercher une ligne: on compte les colonnes sur la
	  ;; première ligne trouvée
	  (setq xml-items nil)
	  (dolist  (xml-expr (cddr xml-expr))
	    (cond
	     ((consp xml-expr)
	      (if (memq  (car xml-expr) '(th td))
		  (progn
		    (setq html2texi-col-count
			  (+ (or html2texi-col-count 0) (html2texi-get-col-span xml-expr)))
		    (when (> html2texi-col-count html2texi-col-info-length)
		      (let ((l (make-list (- html2texi-col-count html2texi-col-info-length) '(abs 1))))
			(setcdr html2texi-col-info-last l)
			(setq html2texi-col-info-last (last l)
			      html2texi-col-info-length html2texi-col-count))))
		(error "balise inattendu dans une table")))
	     ((stringp xml-expr)
	      (unless (string-match
		       "\\`\\s-*\\(\n\\s-*\\)*\\'"
		       xml-expr)
		(error "Chaîne inattendue")))
	     (t (error "Élément inattendu")))))
	 ((stringp xml-expr)
	  (unless (string-match
		   "\\`\\s-*\\(\n\\s-*\\)*\\'"
		   xml-expr)
	    (error "Chaîne inattendue")))
	 (t (error "Élément inattendu")))))



    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(progn
	  (insert "@multitable @columnfractions ")
	  (let ((total-weight
		  (math-reduce-vec
		   (lambda (r x)
		     (+ r
			(cond
			 ((eq (car x) 'abs) (cadr x))
			 ((eq (car x) 'rel)
			  (setcar x 'abs)
			  (setcar (cdr x) (*  (cadr x) html2texi-col-info-length))
			  (cadr x)))))
		   (cons 'vec html2texi-col-info))))
		(insert (mapconcat
			 (lambda (x)
			   (number-to-string
			    (/ (float (cadr x)) html2texi-col-info-length)))
			 (cdr html2texi-col-info)
			 " ")))
	  (insert "\n"))
      (insert "@table\n"))

    (html2texi-process-xml-expr xml-expr)

    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(insert "@end multitable\n")
      (insert "@end table\n"))))


(defun html2texi-tag-handler-tr (xml-expr)
  (setq html2texi-col-number 0)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n")
  (setq html2texi-row-number (1+ html2texi-row-number)))

(defun html2texi-tag-handler-th (xml-expr)
  (if   (= 0 html2texi-col-number)
      (if (and (= 0 html2texi-row-number)
	       (null html2texi-handle-two-columns-table-as-@table))
	  (progn
	    (setq html2texi-head-on-row-0 t)
	    (insert "@headitem ")
	    (html2texi-process-xml-expr xml-expr))
	(insert "@item ")
	(html2texi-process-xml-expr xml-expr))
    (when (or (> html2texi-col-count 2)
	      (null html2texi-handle-two-columns-table-as-@table))
      (insert "@tab "))
    (html2texi-process-xml-expr xml-expr)
    (unless (and  (= 0 html2texi-row-number) html2texi-head-on-row-0)
	(insert "\n")))
  (setq html2texi-col-number (1+ html2texi-col-number)))

(defun html2texi-tag-handler-td (xml-expr)
  (if (= 0 html2texi-col-number)
	(insert "@item ")
    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
      (insert "@tab ")))
  (html2texi-process-xml-expr xml-expr)
  (insert "\n")
  (setq html2texi-col-number (1+ html2texi-col-number)))


(defun html2texi-cur-dir ()
  "Détermine le répertoire courant relativement au répertoire du
HTML racine de départ. La valeur retournée se termine par une oblique `/'"
  (let ((cur-dir  (nreverse (split-string (cdar html2texi-directory-stack) "/")))
	(ref-dir  (nreverse (split-string html2texi-directory-ref "/"))))
    (unless (and (string= (car cur-dir) "")
		 (string= (car ref-dir) ""))
      (error "Format invalide de répertoire"))
    (setq cur-dir (nreverse (cdr cur-dir))
	  ref-dir (cdr ref-dir))
    (if (or (string= (car cur-dir) "")
	    (string-match "\\`[a-z]:" (car cur-dir)))
	;; cur-dir est un chemin absolu
	(progn
	  (setq ref-dir (nreverse ref-dir))
	  (while (and cur-dir ref-dir (string= (car cur-dir) (car ref-dir)))
	    (setq cur-dir (cdr cur-dir)
		  ref-dir (cdr ref-dir)))
	  (while ref-dir
	    (push ".." cur-dir)
	    (setq ref-dir (cdr ref-dir)))
	  (concat (mapconcat 'identity cur-dir "/") "/"))
      (while (and cur-dir
		  (cond
		   ((string= (car cur-dir) "..")
		    (unless ref-dir
		      (error "Chemin invalide"))
		    (setq ref-dir (cdr ref-dir)
			  cur-dir (cdr cur-dir)))
		   ((string= (car cur-dir) ".")
		    (setq cur-dir (cdr cur-dir)))
		   (t nil))))
      (dolist (e cur-dir)
	(push e ref-dir))
      (mapconcat 'identity  (nreverse (cons "" ref-dir)) "/") )))

(defun html2texi-anchor-escape (anchor)
  (let (ret)
    (setq anchor
	  (mapconcat
	   'identity
	   (split-string anchor "-") "--"))
    (mapc
     (lambda (x)
       (if
	(or (and (>= x ?a) (<= x ?z))
	     (and (>= x ?A) (<= x ?Z))
	     (and (>= x ?0) (<= x ?9))
	     (member x '(?_ ?- ?/)))
	   (push (string x) ret)
	 (push (format "-%04x" x) ret)))
     anchor)
    (apply 'concat (nreverse ret))))

(defun html2texi-make-anchor (name &optional escape-function)
  (let* ((anchor (expand-file-name (concat (html2texi-cur-dir) name)))
	 (l-a (length anchor))
	 (l-r (length html2texi-directory-ref))
	 (l (min l-a l-r))
	 (start 0)
	 (i -1))
    (while (and
	    (< (setq i (1+ i)) l)
	    (prog1
		(= (aref anchor i) (aref html2texi-directory-ref i))
	      (and (= (aref anchor i) ?/)
		   (setq start (1+ i))))))
    (setq anchor (list (substring anchor start)))
    (dotimes (i (length (split-string (substring html2texi-directory-ref start))))
      (push "../" anchor))
    (setq anchor (apply 'concat anchor))
    (html2texi-string-escape (funcall (or escape-function 'html2texi-anchor-escape) anchor))))

(defun html2texi-simple-markup-handle (xml-expr class-alist preamble postamble)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe
			(and class-attribute
			     (assoc-string (cdr class-attribute) class-alist)))
		      (list preamble postamble))))
    (insert (car pre-post))
   (html2texi-process-xml-expr xml-expr)
   (insert (cadr pre-post))))

(defun html2texi-tag-handler-body (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))


(html2texi-make-simple-markup-handler code)

(defun html2texi-tag-handler-br (xml-expr)
  (insert "@*\n"))

(defun html2texi-tag-handler-div (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(html2texi-make-simple-markup-handler dfn)

(defun html2texi-tag-handler-dl (xml-expr)
  (insert "@table @asis\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "@end table\n"))

(defun html2texi-tag-handler-dt (xml-expr)
  (insert "@item ")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(defun html2texi-tag-handler-dd (xml-expr)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(html2texi-make-simple-markup-handler em)

(defun html2texi-tag-handler-frameset (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-frame (xml-expr)
  (let (url text)
    (dolist (x (cadr xml-expr))
      (cond
       ((eq (car x) 'src)
	(setq url (cdr x)))
       ((eq (car x) 'name)
	(setq text (cdr x)))))
    (when url
      (html2texi-process-url url text))))

(defun html2texi-tag-handler-hr (xml-expr)
  (insert "@c <hr/>\n"))

(html2texi-make-simple-markup-handler kbd)

(defun html2texi-tag-handler-html (xml-expr)
  "\
Traitement de la balise html."
  (let* ((attributes (nth 1 xml-expr))
	 (lang (assq 'lang attributes)))
    (when lang
      	(html2texi-set-doc-info 'language (cdr lang))))
    (html2texi-process-xml-expr xml-expr))

(html2texi-make-simple-markup-handler strong)

(defun html2texi-handle-string (str)
  (let (ret (pos0 0) pos1 (len (length str)))
    (while (and
	    (< pos0 len)
	    (setq pos1 (string-match "[{}@]" str pos0)))
      (push (substring str pos0 pos1) ret)
      (push (concat "@" (match-string-no-properties 0 str)) ret)
      (setq pos0 (1+ pos1)))
    (when (< pos0 len)
      (push (substring str pos0 pos1) ret))
    (apply 'concat (nreverse ret))))

(defun html2texi-generate-log-buffer ()
  (let ((b (generate-new-buffer html2texi-log-buffer-name)))
    (display-buffer b)
    (with-current-buffer b
      (compilation-mode) )
    b))  

(defun html2texi-error (format-str xml-expr &rest args)
  (setq html2texi-log-buffer (or html2texi-log-buffer
				 (html2texi-generate-log-buffer)))
  (display-buffer html2texi-log-buffer)
  (with-current-buffer html2texi-log-buffer
    (let ((inhibit-read-only t))
      (insert "Error:" 
	      (apply
	       'format 
	       (concat format-str 
		       "\nInfo: <<<-----------\nInfo: xml-expr=%S\nInfo: xml-stack=%S\nInfo: ----------->>>\n")
	       `( ,@args ,xml-expr ,html2texi-xml-stack)) ?\n)))
  (apply 'error format-str args))

(defun html2texi-warning (format-str xml-expr &rest args)
  (setq html2texi-log-buffer (or html2texi-log-buffer
				 (html2texi-generate-log-buffer)))
  (display-buffer html2texi-log-buffer)
  (with-current-buffer html2texi-log-buffer
    (let ((inhibit-read-only t))
	  (insert "Warning:" (apply 'format format-str args) ?\n))  ))

(defun html2texi-process-url (url text)
  (let* ((parsed-url (url-generic-parse-url url))
	 url-list
	 i file-name locator)
    ;; petit hack parce que url-generic-parse-url ne fait pas complètement le
    ;; boulot
    (when (and
	   (null  (aref parsed-url 1))
	   (setq i (string-match "#" (aref parsed-url 6)))
	   (null (aref parsed-url 7)))
      (aset parsed-url 7 (substring (aref parsed-url 6) (1+ i)))
      (aset parsed-url 6 (substring (aref parsed-url 6) 0 i)))

    (push "@uref{" url-list) ; ça peut être défait ensuite
    ;; URL
    (if (and (eq (aref parsed-url 0)
		 'cl-struct-url)
	     (null (aref parsed-url 1)))
	;; cas où il n'y a pas de protocole
	(cond
	 ;; on point vers un fichier HTML, ce n'est donc pas une URL interne
	 ;; => cas suspect
	 ((member (file-name-extension
		   (setq file-name (aref parsed-url 6)))
		  '("html" "htm"))
	  (setq file-name (expand-file-name
			   file-name
			   (file-name-directory (car html2texi-files-doing-or-done))))
	  (unless (member file-name html2texi-files-doing-or-done)
	    (add-to-list 'html2texi-files-to-do file-name))
	  (when (aref parsed-url 7)
	    (setq file-name (concat file-name "#" (aref parsed-url 7))))
	  (push (html2texi-string-escape file-name) url-list))

	 ;; cas d'une URL interne
	 ((and (string= "" file-name)
	       (setq locator (aref parsed-url 7)))
	  (pop url-list)
	  (push "@ref{" url-list)
	  (push (html2texi-make-anchor (concat "#" locator)) url-list))

	  (t
	    (push (html2texi-string-escape url) url-list)))
        (push (html2texi-string-escape url) url-list))
     ;; Text
     (when text
       (push "," url-list)
       (push (html2texi-string-escape text) url-list))
     (push "}" url-list)
     (apply 'insert (nreverse url-list))))


(html2texi-make-simple-markup-handler i)

(defun html2texi-tag-handler-li (xml-expr)
  (insert "\n@item\n")
  (unless (memq (caadr html2texi-xml-stack) '(ol ul))
    (html2texi-error "%s:%d: <li> était inattendu." 
		     xml-expr
		     (car html2texi-files-doing-or-done)
		     (+ (line-number-at-pos) html2texi-line-delta)
		     ))
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-link (xml-expr)
  )

(defun html2texi-tag-handler-ol (xml-expr)
  (insert "\n@enumerate")
   (html2texi-process-xml-expr xml-expr)
  (insert "\n@end enumerate\n"))

(defun html2texi-tag-handler-p (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(defun html2texi-tag-handler-ul (xml-expr)
  (insert "\n@itemize")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n@end itemize\n"))

(defun html2texi-tag-handler-span (xml-expr)
  (insert "@c span: (<span #1>#2</span> => #2.")
  (html2texi-default-handling xml-expr "span: ")
  (html2texi-process-xml-expr xml-expr)
  (insert "@c span: )\n"))

(defun html2texi-tag-handler-style (xml-expr)
  )

(defun html2texi-tag-handler-meta (xml-expr)
  (unless (and (nth 1 html2texi-xml-stack)
	       (eq (caadr html2texi-xml-stack) 'head))
    (html2texi-error "<meta> inattendu." xml-expr))
  ;; traitement du meta...
  (let* ((attribute-list (nth 1 xml-expr))
	 (http-equiv (assq 'http-equiv attribute-list))
	 (name (assq 'name attribute-list))
	 (content (assq 'content attribute-list)))
    (cond
     ((and (consp name)
	   (consp content)
	   (progn
	     (setq name (cdr name)
		   content (cdr content))
	     (stringp name))
	   (stringp content))
      (cond
       ((string= name "author")
	(html2texi-set-doc-info 'author content))
       ((string= name "language")
	(when (string-match "\\`\\([a-z]\\{2\\}\\(-[A-Z]\\{2\\}\\)?\\)\\'" content)
	  (let ((language (match-string-no-properties 1 content)))
	    (when (= (length language) 5)
	      (aset language 2 ?_))
	    (html2texi-set-doc-info 'language language))))))
     ((and (consp http-equiv)
	   (consp content)
	   (progn (setq http-equiv (cdr http-equiv))
		  (stringp http-equiv))
	   (progn (setq content (cdr content))
		  (stringp content)))
      (setq http-equiv (downcase http-equiv))
      (cond
       ((and (string= http-equiv "content-type")
	     (string-match "charset\\s-*=\\s-*\\([-a-z0-9]+\\)" content))
	(html2texi-set-doc-info 'content-type-charset (match-string-no-properties 1 content)));
       )))))

(defun html2texi-tag-handler-pre (xml-expr)
  (let ((kes html2texi-keep-empty-strings))
    (setq html2texi-keep-empty-strings t)
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-keep-empty-strings kes)))

(defun hmtl2texi-to-plain-text (xml-expr &rest flags)
  (let (ret anchor)
    (dolist (xml-expr (cddr xml-expr))
      (cond
       ((stringp xml-expr)
	(push xml-expr ret))
       ((consp xml-expr)
	(push xml-expr html2texi-xml-stack)
	(cond
	 ((and (eq (car xml-expr) 'a)
	       (setq anchor (assq 'name (nth 1 xml-expr))))
	  (push (html2texi-make-anchor (concat "#" (cdr anchor)))
		html2texi-flushable-anchors) ))
	(let ((str  (hmtl2texi-to-plain-text xml-expr)))
	  (and (null (string= str ""))
	       (push str ret)))
	(pop html2texi-xml-stack))
       (t (html2texi-error "Expression XML inattendue." xml-expr))))
    (setq  ret (mapconcat 'identity (nreverse ret) " "))
    (if (memq :one-line flags)
	(mapconcat 'identity (split-string ret "\n") " ")
      ret)))


(defun html2texi-tag-handler-title (xml-expr)
  (unless (and  (nth 1 html2texi-xml-stack)
		(eq  (caadr html2texi-xml-stack) 'head))
    (html2texi-error "<title> inattendu." xml-expr))
  (setq xml-expr (cddr xml-expr))
  (let ((str  (hmtl2texi-to-plain-text xml-expr)))
    (setq str (split-string str "\n")
	  str (mapconcat 'identity str " "))
    (unless (string= str "")
      (html2texi-set-doc-info 'title str))))

(defun html2texi-string-escape (str &optional flatten)
  (cond
   ((stringp str)
    (with-temp-buffer
      (insert str)
      (goto-char (point-min))
      (while (re-search-forward "[,@{}]" nil t)
	(cond
	 ((string= (match-string-no-properties 0) ",")
	  (replace-match "@comma{}"))
	 ((member (match-string-no-properties 0) '("@" "{" "}"))
	  (replace-match (concat "@" (match-string-no-properties 0))))))
      (when flatten
	(goto-char (point-min))
	(while (re-search-forward "\n\\(\\s-*\\)" nil t)
	  (replace-match (if (> 0 (length (match-string 1))) " " "") t t)))
      (buffer-substring (point-min) (point-max))))
   ((and (consp str) (car-safe str))
    (cond
     ((eq (car str) 'span)
      (with-temp-buffer
	(insert "@c span: (<span #1>#2</span> => string-escape of #2.")
	(html2texi-default-handling str "span: ")
	(insert (html2texi-string-escape  (nth 2 str) flatten))
	(insert "@c span: )\n")
	(buffer-substring (point-min) (point-max))))
     (t (html2texi-error "Un chaîne était attendue" str))))
   (t  (html2texi-error "Un chaîne était attendue" str))))

(defun html2texi-tag-handler-img (xml-expr)
  (let (filename width height alttext extension)
    (dolist (x (cadr xml-expr))
      (cond
       ((eq (car x) 'src)
	(setq filename (cdr x)))
       ((eq (car x) 'alt)
	(setq alttext (cdr x)))))
    (unless filename
      (html2texi-error "src=... était attendu" xml-expr))
    (setq extension (file-name-extension filename)
	  filename (file-name-sans-extension filename))
    (when (member extension '("png" "jpg" "jpeg" "eps" "txt"))
      (setq extension nil))
    (insert "@image{" (html2texi-make-anchor filename (symbol-function 'identity)))
    (let ((remainder (list width height alttext extension)))
	(while remainder
	  (if (let (non-empty)
		(mapc (lambda (x) (setq non-empty (or non-empty (stringp x))))
		      remainder)
		non-empty)
	      (insert "," (or (pop remainder) "") )
	    (setq remainder nil); rompt la boucle (while remainder...)
	    ))
	(insert "}"))))

(defun html2texi-set-doc-info (tag val)
  "Configure pour l'étiquette TAG la valeur VAL concernant les
informations globales au documents. Ces informations concernent
notamment la langue et l'encodage du document."
  (let ((info (assq tag html2texi-document-information)))
    (if info
	(setcdr info val)
      (push (cons tag val) html2texi-document-information))))

(defun html2texi-tag-handler-head (xml-expr)
  (unless html2texi-ignore-head
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-ignore-head t)))

(defun html2texi-tag-handler-noframes (xml-expr)
  )

(if (boundp 'html2texi-handler-hash-table)
    (makunbound 'html2texi-handler-hash-table))

(defconst html2texi-handler-hash-table
  (let ((ht (make-hash-table)))
    (dolist (v '(a b body code dfn dl dt dd em i kbd li p hr div ol ul pre
    head meta title frameset frame noframes span strong table th tr td h1 h2
    h3 h4 h5 h5 html link br img samp style sup sub tt))
      (puthash v (symbol-function (intern (concat "html2texi-tag-handler-" (symbol-name v))))
	       ht))
    ht)
  "Table de hashage des traitement associé à chaque balise HTML"
  )

(defun html2texi-remove-empty-strings (xml-expr)
  (setq xml-expr (cdr xml-expr))
  (save-match-data
  (while (cdr xml-expr)
    (if (and (stringp (cadr xml-expr))
	     (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'" (cadr xml-expr)))
	(setcdr xml-expr (cddr xml-expr))
      (setq xml-expr (cdr xml-expr))))))

(defun html2texi-process-xml-expr (xml-expr)
  (push xml-expr html2texi-xml-stack)
  (dolist (xml-expr (cddr xml-expr))
    (cond
     ((consp xml-expr)
      (push xml-expr html2texi-xml-stack)
      (let ((handler (gethash (intern (downcase (symbol-name (car xml-expr))))
			      html2texi-handler-hash-table)))
	(if handler
	    (funcall handler  xml-expr)
	  (html2texi-default-handling xml-expr)))
      (pop html2texi-xml-stack))
     ((stringp xml-expr)
      (and (or html2texi-keep-empty-strings
	       (null (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'"  xml-expr)))
	   (insert (html2texi-handle-string xml-expr))))
     (t (error "Expression XML inattendue %S" xml-expr))))
  (pop html2texi-xml-stack))

(defun html2texi-default-handling (xml-expr &optional prompt)
  (let ((str (split-string (prin1-to-string xml-expr) "\n")))
    (dolist (str-line str)
      (insert "\n@c " (or prompt "") str-line)))
    (insert "\n"))

(defun html2texi-process-region (beg end)
  (goto-char end)
  (let ((end (point-marker))
	is-xhtml
	re-do
	xml-expr)

    ;; Suppression de tout ce qui est en dehors des balise <html> ... </html>
    (goto-char beg)
    (setq html2texi-line-delta (line-number-at-pos))
    (setq is-xhtml
	  (looking-at "[ \t\n\r]*<!DOCTYPE[ \t\n\r]+html[ \t\n\r]+PUBLIC[ \t\n\r]+\"-//W3C//DTD XHTML"))
    (unless (re-search-forward "<html" end t)
      (html2texi-error "Balise <html> non trouvée" xml-expr))
    (setq html2texi-line-delta (- (line-number-at-pos) html2texi-line-delta))
    (delete-region beg (match-beginning 0))
    (unless (re-search-forward ">" end t)
      (html2texi-error "Clôture de la balise <html> trouvéee" xml-expr))
    (unless  (re-search-forward "</html" end t)
      (html2texi-error "Balise </html> non trouvée trouvée" xml-expr))
    (unless (re-search-forward ">" end t)
      (html2texi-error "Clôture de la balise </html> trouvée" xml-expr))
    (delete-region (match-end 0) end)

    (or is-xhtml
	(html2texi-make-html-clean-xml beg end))

    (setq xml-expr
	  (condition-case
	      sig
	      (xml-parse-region beg end)
	    (error
	     (if (consp sig)
		 (html2texi-warning "%s: File is XHTML but xml-parser reported error `%S'" 
				 xml-expr
		       (car html2texi-files-doing-or-done)
		       (cdr sig))
	       (html2texi-warning "%s: File is XHTML but xml-parser reported errors" 
				  xml-expr
				  (car html2texi-files-doing-or-done)))
		  (if is-xhtml :html2texi-redo nil)))
	  xml-expr
	  (if (eq xml-expr :html2texi-redo)
	       (progn
		 (html2texi-make-html-clean-xml beg end)
		 (xml-parse-region beg end))
	     xml-expr))
  
    (delete-region beg end)
    (set-marker end nil)
    xml-expr))

(if t
;; plus partique pour déboguer qu'un vrai tampon temporaire
    (defmacro html2texi-with-temp-buffer (&rest body)
      (let ((cur-buff (make-symbol "cur-buff")))
	`(with-current-buffer
	       (let (( ,cur-buff (get-buffer "*HTML2TEXI Temp*")))
		 (and ,cur-buff (kill-buffer ,cur-buff))
		 (get-buffer-create "*HTML2TEXI Temp*"))
       (erase-buffer)
       ,@body)))
  ;;
  (defmacro html2texi-with-temp-buffer (&rest body)
    `(with-temp-buffer ,@body)))



(defun html2texi-make-texi-buffer (&optional buffer )
  (let* ((start-buffer (or buffer (current-buffer)))
	 xml-expr
	 (start-filename  (or (buffer-file-name start-buffer) (buffer-name)))
	 (start-filename-ext (file-name-extension start-filename))
	 (texi-buffer-name
	  (concat (concat  (file-name-sans-extension   (file-name-nondirectory start-filename))
			    ".texi")))
	 done-links-list
	 texi-buffer
	 html2texi-keep-empty-strings
	 html2texi-xml-parsed
	 html2texi-xml-stack
	 (html2texi-line-delta 0)
	 html2texi-ignore-head
	 html2texi-directory-stack
	 html2texi-flushable-anchors
	 html2texi-directory-ref
	 html2texi-files-doing-or-done
	 html2texi-files-to-do
	 html2texi-log-buffer)
    (unless (or (member start-filename-ext '("html" "htm"))
		(y-or-n-p (format "le tampon %s n'a pas une extension html, continuer?"
				  start-filename)))
      (error "Fichier sans extension html"))
    (setq texi-buffer (get-buffer-create texi-buffer-name))
    (set-buffer texi-buffer)
    (erase-buffer)
    (dolist (v html2texi-texi-buffer-local-variables)
      (set (make-local-variable v) nil))
    (insert (with-current-buffer start-buffer
	      (save-restriction
		(widen)
		(buffer-substring (point-min) (point-max)))))
    (accents-de-html)
    (push (cons default-directory "./") html2texi-directory-stack)
    (push start-filename html2texi-files-doing-or-done)
    (setq html2texi-directory-ref default-directory)

    (setq xml-expr (html2texi-process-region (point-min) (point-max)))
    (unless (eq 'html (caar xml-expr))
      (error "Résultat d'analyse XML inattendu"))
    (setq xml-expr `(html2texi-dummy-markup nil ,(car xml-expr)))
    (html2texi-process-xml-expr xml-expr)
    (while html2texi-files-to-do
      (setq file-name (pop html2texi-files-to-do))
      (if (file-exists-p file-name)
	  (progn
	    (push file-name html2texi-files-doing-or-done)
	    (let* ((dir (file-name-as-directory
			 (file-name-directory file-name)))
		   (rel-dir   (let ((d
				     (file-name-directory
				      (file-relative-name file-name html2texi-directory-ref))))
				(if d (file-name-as-directory d)
				  "./"))))
	      (push (cons dir rel-dir) html2texi-directory-stack)
	      (html2texi-with-temp-buffer
	       (insert-file-contents file-name)
	       (accents-de-html)
	       (html2texi-make-html-clean-xml (point-min) (point-max))
	       (setq xml-expr (html2texi-process-region (point-min) (point-max))))
	      (unless (eq 'html (caar xml-expr))
		(error "Résultat d'analyse XML inattendu"))
	      (setq xml-expr (car xml-expr))
	      (html2texi-process-xml-expr xml-expr)
	      (pop html2texi-directory-stack)	))
	(warn "Le fichier `%s' n'existe pas!" file-name)))))

(defun html2texi-insert-doc-info ()
  (let ((author
	 (html2texi-string-escape
	  (or (cdr-safe (assq 'author html2texi-document-information)) "AUTHOR")))
	(title 	 (html2texi-string-escape
		  (or (cdr-safe (assq 'title html2texi-document-information)) "TITLE")))
	(language 	 (let ((language  (cdr-safe (assq 'language html2texi-document-information))))
			   (if language (cons "" (html2texi-string-escape language))
			     (cons "@c " "LANGUAGE"))))
	(encoding  (html2texi-string-escape
			  (or (cdr-safe (assq 'content-type-charset html2texi-document-information))
			      "iso-8859-1"))))

    (goto-char (point-min))
    (insert "\\input texinfo   @c -*-mode:texinfo; coding:" encoding "-*-
@setfilename " (file-name-sans-extension (buffer-name)) ".info
" (car language) "@documentlanguage " (cdr language) "
@documentencoding "  (if (let ((case-fold-search t))
			   (string-match "\\`\\(us\\|utf\\|iso\\)" encoding))
			 (upcase encoding) encoding) "
@copying
This manual is for PROGRAM, version VERSION.

Copyright @copyright{} YEARS COPYRIGHT-OWNER.

@quotation
Permission is granted to ...
@end quotation
@end copying

@titlepage
@title " title "@c NAME-OF-MANUAL-WHEN-PRINTED
@c @subtitle SUBTITLE-IF-ANY
@c @subtitle SECOND-SUBTITLE
@author " author "

@c  The following two commands
@c  start the copyright page.
@page
@vskip 0pt plus 1filll
@insertcopying

Published by ...
@end titlepage

@c So the toc is printed at the start.
@contents

@ifnottex
@node Top
@top TITLE

This manual is for PROGRAM, version VERSION.
@end ifnottex
")
    (goto-char (point-max))
    (insert "
@bye") ))

(defun html2texi-post-process ()
  "Remplace les double lignes vides en ligne vides simples."
  (goto-char (point-min))
  (while (re-search-forward "\\(^[ \t]*\n\\)\\{2,\\}" nil t)
    (replace-match "\n"))
  (normal-mode))

;;;###autoload
(defun html2texi ()
  (interactive)
  (html2texi-make-texi-buffer)
  (html2texi-insert-doc-info)
  (html2texi-post-process))

;; Log compilation mode stuff
(add-to-list 'compilation-error-regexp-alist 'html-to-texinfo)
(let ((cell (or (assq 'html-to-texinfo compilation-error-regexp-alist-alist)
		(car (push (cons 'html-to-texinfo nil) compilation-error-regexp-alist-alist)))))
  (setcdr cell '(
		"^\\(?:Error\\|\\(Warning\\)\\|\\(Info\\)\\):\\(\\(?:[A-Z]:\\)?[A-Za-z_0-9./\\]+\\):\\(?:\\([0-9]+\\):\\)?.*$"
		3; File
		4; Line
		( 1 . 2) ; ( WARNING . INFO)
		)  ))

;;; html-to-texinfo.el ends here


Revision-number: 17
Prop-content-length: 212
Content-length: 212

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2012-02-05T18:35:08.000000Z
K 7
svn:log
V 109
- génération d'un log d'erreur dans un tampon en mode compilation
- décodage des URL (`%65' -> `A')

PROPS-END

Node-path: trunk/lisp/html-to-texinfo.el
Node-kind: file
Node-action: change
Text-content-length: 52914
Text-content-md5: f0a92cf91453257b0cd384b6bccfa205
Content-length: 52914

;;; html-to-texinfo.el --- -*- coding: iso-8859-1 -*-
;; Copyright 2010/2012 Vincent Belaïche
;;
;; Author: Vincent Belaïche <vincent.b.1@hotmail.fr>
;; Version: $Id: html-to-texinfo.el,v 1.8 2012-02-05 18:35:08 Vincent Exp $
;; Keywords:
;; X-URL: not distributed yet
;;
;; This software is governed by the CeCILL license under French law and
;; abiding by the rules of distribution of free software.  You can  use,
;; modify and/ or redistribute the software under the terms of the CeCILL
;; license as circulated by CEA, CNRS and INRIA at the following URL
;; "http://www.cecill.info".
;;
;; As a counterpart to the access to the source code and  rights to copy,
;; modify and redistribute granted by the license, users are provided only
;; with a limited warranty  and the software's author,  the holder of the
;; economic rights,  and the successive licensors  have only  limited
;; liability.
;;
;; In this respect, the user's attention is drawn to the risks associated
;; with loading,  using,  modifying and/or developing or reproducing the
;; software by the user in light of its specific status of free software,
;; that may mean  that it is complicated to manipulate,  and  that  also
;; therefore means  that it is reserved for developers  and  experienced
;; professionals having in-depth computer knowledge. Users are therefore
;; encouraged to load and test the software's suitability as regards their
;; requirements in conditions enabling the security of their systems and/or
;; data to be ensured and,  more generally, to use and operate it in the
;; same conditions as regards security.
;;
;; The fact that you are presently reading this means that you have had
;; knowledge of the CeCILL license and that you accept its terms.
;;
;;; Commentary:

;;

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'html-to-texinfo)

;;; Code:

(provide 'html-to-texinfo)
(eval-when-compile
  (require 'cl))
(require 'eieio)
(require 'calc-ext)
(require 'accents-ascii)
(require 'compile)

;;;;##########################################################################
;;;;  User Options, Variables
;;;;##########################################################################

(defconst html2texi-suspicious-html-tags
  '("meta" "br" "hr" "link" "img" "frame")
"Liste des balises pour lesquelles le HTML ne suit pas une
syntaxe strictement XML. Par exemple `<br>' est utilisé au lieu
de `<br/>'."  )

(defconst html2texi-suspicious-html-tags-re
  (regexp-opt html2texi-suspicious-html-tags))

(defconst html2texi-non-recursive-tags
  '("p" "li"))

(defconst html2texi-hierarchy-list
  '(
    (li (ul ol))
    (tr (table))
    (th (tr))
    (td (tr))
    (dd (dl))
    (dt (dl))  )
  )

(defconst html2texi-non-recursive-tags-re
  (regexp-opt html2texi-non-recursive-tags))

(defconst html2texi-filepath-re
  "\\(?:[A-Za-z]:\\)?[- ~+A-Za-z_0-9./\\]+")

(defconst html2texi-texi-buffer-local-variables
  '(html2texi-document-information)
    "Liste des variables déclarées localement au tampon Texinfo.")

(defclass html2texi-simple-markup ()
  ((class-dependant
    :initarg :class-dependant
    :initform nil
    :custom '(repeat
	  (list
	   (regexp :tag "clef")
	   (string :tag "prologue")
	   (string :tag "épilogue")
	   (boolean :tag "conserver les espaces et retours chariot")
	   ))
    :documentation "\
Liste d'association dont les éléments sont de la forme
 (CLEF PROLOGUE ÉPILOGUE)

Supposons que l'objet décrit le traitement de la balise TAG,
alors lorsque le code HTML `<TAG class=\"CLEF\">CONTENU</TAG>'
est rencontré, alors il est convertie en le code Texinfo
`PROLOGUE TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU.")
   (preamble
    :initarg :preamble
    :type string
    :documentation "\
Prologue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (postamble
    :initarg :postamble
    :type string
    :documentation "\
Épilogue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (space-verb
    :initarg :space-verb
    :initform nil
    :type boolean
    :documentation "\
Vrai lorsque les espaces et retours chariot sont à conserver tels quels."
    ))
  :documentation "\
Un object de type `html2texi-simple-markup'
décrit le traitement d'une balise simple comme par exemple
<code>.")

(defun html2texi-texinfo-inside-comment-p ()
  "Renvoie non nil lorsque le point est dans un commentaire Texinfo."
  (save-match-data
    (save-excursion
      (let ((cur (point))
	    (end (progn (end-of-line) (point))))
	(beginning-of-line)
	(and (re-search-forward "\\(^\\|[^@]\\)@c\\(omment\\)\\_>" end t)
	     (<= (match-beginning 0) cur))))))

(defmethod html2texi-handle-simple-markup
  ((this html2texi-simple-markup) xml-expr)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe
			(and class-attribute
			     (assoc-string (cdr class-attribute)
					   (oref this :class-dependant))))
		      (list (oref this :preamble)
			    (oref this :postamble)))))
    (insert (car pre-post))
    (let ((beg (point))
	  end)
      (html2texi-process-xml-expr xml-expr)
      (unless (oref this :space-verb)
	(setq end (point-marker))
	(goto-char beg)
	(while (re-search-forward "[\n\r]\\s-*" nil end)
	  (let ((replace-str " "))
	    (save-match-data
	      (cond
	       ((html2texi-texinfo-inside-comment-p)
		(setq replace-str nil))))
	      (and replace-str (replace-match replace-str t t)))))
	(goto-char end)
	(set-marker end nil))
    (insert (cadr pre-post))))


(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-url-encoding
  :html2texi-utf-8
  "Sélectionne le codage des URL."
  :type '(choice 
	  (symbol :tag "UTF-8" :html2texi-utf-8)
	  (symbol :tag "ISO-8859-1" :html2texi-latin-1))
  :group 'html2texi)

(defcustom html2texi-i-simple-markup
  (html2texi-simple-markup "html2texi-i-simple-markup"
   :preamble "@i{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-b-simple-markup
  (html2texi-simple-markup "html2texi-b-simple-markup"
   :preamble "@b{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-kbd-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :preamble "@kbd{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-dfn-simple-markup
  (html2texi-simple-markup "html2texi-dfn-simple-markup"
   :preamble "@dfn{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-em-simple-markup
  (html2texi-simple-markup "html2texi-em-simple-markup"
   :preamble "@emph{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-sub-simple-markup
  (html2texi-simple-markup "html2texi-sub-simple-markup"
   :preamble ""
   :postamble "")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<sub class=\"CLEF\">CONTENU</sub>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-sup-simple-markup
  (html2texi-simple-markup "html2texi-sup-simple-markup"
   :preamble ""
   :postamble "")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<sup class=\"CLEF\">CONTENU</sup>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-samp-simple-markup
  (html2texi-simple-markup "html2texi-samp-simple-markup"
   :preamble "@samp{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<samp class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-strong-simple-markup
  (html2texi-simple-markup "html2texi-strong-simple-markup"
   :preamble "@strong{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-tt-simple-markup
  (html2texi-simple-markup "html2texi-tt-simple-markup"
   :preamble "@t{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<tt class=\"CLEF\">CONTENU</tt>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-handle-two-columns-table-as-@table
  t
 "Si `nil' alors une table `<table>...</table>'
avec deux colonne sera gérée en texinfo par une `@table', si non
`nil', alors elle sera gérée par une `@multitable'."
  :type
  '(choice
    (const :tag "t pour @table" t)
    (const :tag "nil pour @multitable" nil))
  :group 'html2texi)

(defcustom html2texi-log-error-names
   ["Erreur fatale" "Erreur" "Avertissement" "Info"]
   "Liste des types d'erreur préfixant les messages d'erreur dans
le tampon de sortie des erreurs & avertissement de traitement."
   :type
   '(vector
     (string :tag "Erreur fatale")
     (string :tag "Erreur")
     (string :tag "Avertissement")
     (string :tag "Info"))
   :group 'html2texi  )

(defcustom html2texi-log-buffer-name
  "*HTML2TEXI*"
  "Nom du tampon de sortie des erreurs et avertissements de traitement."
  :type 'string
  :group 'html2texi)


(defvar html2texi-document-information nil
  "Liste d'association pour mémoriser les informations (titre,
  auteurs, etc...) propres à un document.")

(defvar html2texi-line-delta 0
  "Décalage entre le numéro de ligne du code XML au sein le
  tampon Texinfo en cours de traitement, et son numéro de ligne
  dans le fichier HTML source.")


(defvar html2texi-xml-parsed nil
  "Résultat de l'analyse syntaxique d'un doc")

(defvar html2texi-xml-stack nil
  "Pile des expressions XML")

(defvar html2texi-keep-empty-strings nil
  "Non nil si les chaînes vides sont à conserver.")

(defvar html2texi-ignore-head nil
  "Non nil si on ignore le <head> (dans un fichier HTML lié).")

(defvar html2texi-directory-stack nil
  "Pile des chemins de répertoire.")

(defvar html2texi-files-doing-or-done nil
  "Liste des fichiers déjà traités, ou le fichier en cours de traitement.
Le fichier en cours de traitement est en première position dans cette liste.")

(defvar html2texi-files-to-do nil
  "Liste des fichiers non encore traités")

(defvar html2texi-flushable-anchors nil
  "Liste de nom d'ancrage de lien dont l'insertion a été remise à
  plus tard." )

(defvar html2texi-postpone-output nil
  "Non `nil' lorsque l'insertion du code est remise à plus tard.")


(defvar html2texi-directory-ref nil
  "Répertoire de référence")

(defvar html2texi-log-buffer nil
  "Tampon de sortie des erreurs et avertissements de traitement.")

(defmacro html2texi-make-simple-markup-handler (tag)
  `(defun ,(intern (concat "html2texi-tag-handler-" (symbol-name tag)))
     (xml-expr)
     (html2texi-handle-simple-markup
      ,(intern (concat "html2texi-"  (symbol-name tag) "-simple-markup"))
      xml-expr) ))

(defun html2texi-make-html-clean-xml (beg end)
  (let  ((end-arg end)
	 end)
    (if (markerp end-arg)
	(setq end end-arg)
      (goto-char end-arg)
      (setq end (point-marker)))
    ;; rend les balise implicitement auto-closante vraiment auto-closante
    (goto-char beg)
   (while (re-search-forward (concat "<\\(" html2texi-suspicious-html-tags-re "\\)\\>")
			      end t)
      (let ((tag (match-string-no-properties 1)))
	(unless (re-search-forward ">" nil t)
	  (html2texi-fatal-error "%s:%d: Clôture non trouvé pour la balise %s" nil
		 (car html2texi-files-doing-or-done)
		 (+ (line-number-at-pos) html2texi-line-delta)
		 tag))
	(when (null (looking-back "/>"))
	  (backward-char)
	  (insert "/")
	  (forward-char))))
    ;; marque de paragraphe et de ligne
    (goto-char beg)
    (let (tag-stack pos-< pos->
		    tag is-closure self-closing)
      (while (re-search-forward "<\\(/\\)?\\([a-zA-Z]+\\)\\>" end t)
	(setq pos-< (match-beginning 0)
	      tag (match-string-no-properties 2)
	      is-closure (match-string-no-properties 1))
	(unless (string= tag (downcase tag))
	  (replace-match (setq tag (downcase tag)) 2))
	(unless (re-search-forward ">" end t)
	  (error "%s:%d: Soufflet de clôture non trouvé pour la balise %s"
		 (car html2texi-files-doing-or-done)
		 (+ (line-number-at-pos) html2texi-line-delta)
		 tag))
	
	(setq pos-> (point)
	      self-closing (looking-back "/>"))
	(cond
	 ((and self-closing  is-closure)
	  (error "%s:%d: balise %s à la fois de clôture et auto-closante"
		 (car html2texi-files-doing-or-done)
		 (+ (line-number-at-pos) html2texi-line-delta)
		 tag))

	 (self-closing
	  ;; do nothing
	  )

	 ((null is-closure)
	  (when (and
		 (string-match (concat "\\`" html2texi-non-recursive-tags-re "\\'") tag)
		 tag-stack
		 (string= tag (caar tag-stack)))
	    ;; clôture
	    (save-excursion
	      (goto-char pos-<)
	      (insert "</" tag "><!-- HTML2TEXI: repaired (1) -->")
	      (html2texi-warning "Ajout clôture `</%s>'" nil tag))
	    (pop tag-stack))
	  (push (list tag) tag-stack))

	 (is-closure
	      (if (and tag-stack
		       (string= (caar tag-stack) tag))
		  (pop tag-stack)
		(let ((first (assoc-string tag tag-stack)) rev)
		  (if first
		      (progn
			(while (and tag-stack (null (eq (car tag-stack) first)))
			  (push (pop tag-stack) rev))
			(pop tag-stack)
			(save-excursion
			  (goto-char pos-<)
			  (dolist (c rev)
			    (insert  "</" (car c) "><!-- HTML2TEXI: repaired (2) -->" )
			     (html2texi-warning "Ajout clôture `</%s>'" nil tag))))
		    
		    (save-excursion
		       (goto-char pos->)
		       (insert "-->")
		       (goto-char pos-<)
		       (insert "<!-- HTML2TEXI: repaired (3). "))
		    (html2texi-warning "Clôture de %s ne correspondant à aucune ouverture" nil tag)))))))


      (let (p-pos li-pos markup poss pos)
	(while (re-search-forward "<\\(/\\)?\\(p\\|li\\)\\>[^>]*>" end t)
	  (setq markup (match-string-no-properties 2)
		poss (intern (concat markup "-pos"))
		pos (symbol-value poss))
	  (if (match-string-no-properties 1)
	      (if  pos
		  (if (= pos (match-beginning 0))
		      (set poss nil)
		    (html2texi-fatal-error "%s:%d: Clôture de balise %s ne correspondant à aucune ouverture" nil
			   (car html2texi-files-doing-or-done)
			   (+ (line-number-at-pos) html2texi-line-delta)
			   (match-string-no-properties 0)))
		(save-excursion
		  (save-match-data
		    (unless  (re-search-forward
			      (format "<\\(/\\)?\\(%s\\)\\>[^>]+>" markup)
			      end t)
		      (html2texi-fatal-error "%s:%d: Ouverture de balise <%s> sans clôture" nil
			   (car html2texi-files-doing-or-done)
			   (+ (line-number-at-pos) html2texi-line-delta)
			     markup))
		    (set poss (match-beginning 0))
		    (unless (match-string-no-properties 1)
		      (goto-char (match-beginning 0))
		      (insert (format "</%s>" markup))
		      (dolist (symb '(p-pos li-pos))
			(unless (or (null (symbol-value symb))
				 (eq symb poss))
			  (set symb (+ (length markup) 3 (symbol-value symb)))))))))))
	    ))
    ;; mise entre guillemets anglais des attributs entier sans guillemets
    (goto-char beg)
    (let (p1 p2 added-dquote-attributes p-start)
      ;; tant qu'on trouve potentiellement un attribut sans "..."
      (while (re-search-forward "\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([-+]?[0-9]+\\)"
				nil end)
	(setq p1 (match-beginning 1)
	      p2 (match-end 0))
	(if
	    ;; si la position est bien entre < et >
	    (and (re-search-backward "[<>]" nil beg)
		 (looking-at "<\\sw+")
		 (progn
		   (goto-char (setq p-start (match-end 0)))
		   (re-search-forward "[<>]" nil beg)
		   (string= (match-string-no-properties 0) ">"))
		 (>= (point) p1))
	    ;; alors on fait la réparation
	    (progn
	      (goto-char p-start)
	      (while
		  (progn
		    (while (looking-at "\\(?:\\s-\\|\n\\)*\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\"[^\"]*\"")
		      (goto-char (match-end 0)))
		    (cond
		     ((looking-at  "\\(?:\\s-\\|\n\\)*\\(\\sw+\\)\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([-+]?[0-9]+\\)")
		      (push (match-string-no-properties 1) added-dquote-attributes)
		      (goto-char (match-beginning 2))
		      (insert ?\")
		      (goto-char (1+ (match-end 2)))
		      (insert ?\")
		      (setq pos-> (+ 2 pos->)))
		     ((looking-at "\\(?:\\s-\\|\n\\)*>")
		      (goto-char (match-end 0))
			  (insert "<!-- HTML2TEXI inserted double quotes around values for attibutes: "
				  (mapconcat (lambda (x) (concat "`" x "'"))
					     added-dquote-attributes
					     ", ")
				  " -->")
			  nil)
		     (t (error "%s:%d: Attribut au format invalide: %s"
			       (car html2texi-files-doing-or-done)
			       (+ (line-number-at-pos) html2texi-line-delta)
			       (match-string-no-properties (point)
							      (+ p2
								 (* 2 (length added-dquote-attributes))))))))))
	  ;; sinon on continue à chercher un attribut potentiel dont la valeur
	  ;; n'est pas entre "..."
	  (goto-char p2))))

    ;; un peu de ménage...
    (unless (markerp end-arg)
      (set-marker end nil)) ))

;;;==========================================================================
;;; définition des gestionnaires de balise
;;;--------------------------------------------------------------------------

(defun html2texi-tag-handler-a (xml-expr)
  (let (name href text (xml-expr-length (length xml-expr)))
    (dolist (attrib (cadr xml-expr))
      (cond
       ((eq (car attrib) 'href)
	(setq href (cdr attrib)))
       ((eq (car attrib) 'name)
	(setq name (cdr attrib)))))
    (and (cddr xml-expr)
	 (setq text (caddr xml-expr)))
    (cond
     (href (html2texi-process-url href text))
     ((= xml-expr-length 3)
      (cond
       ((stringp text)
	(insert (html2texi-string-escape text t)))
       ((consp text) (html2texi-process-xml-expr text))
       (t (error "Le format du text de la balise <a> était inattendu"))))
     ((> xml-expr-length 3)
      (html2texi-process-xml-expr `(div nil ,@(cddr xml-expr)))))
    (and name
      (insert "\n@anchor{" (html2texi-make-anchor (concat "#" name)) "}\n"))))

(html2texi-make-simple-markup-handler b)

(defun html2texi-flush-anchors ()
  (while html2texi-flushable-anchors
    (insert "@anchor{" (pop html2texi-flushable-anchors) "}\n")))


(defun html2texi-tag-handler-h1 (xml-expr)
  (insert "@chapter " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))


(defun html2texi-tag-handler-h2 (xml-expr)
  (insert "@section " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))

(defun html2texi-tag-handler-h3 (xml-expr)
  (insert "@subsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
    (html2texi-flush-anchors))

(defun html2texi-tag-handler-h4 (xml-expr)
  (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))

(defun html2texi-tag-handler-h5 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
     (html2texi-flush-anchors))

(defun html2texi-tag-handler-h6 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
   (html2texi-flush-anchors))

(html2texi-make-simple-markup-handler samp)


(defun html2texi-get-col-span (xml-expr)
  ;; xml-expr is <td> or <th>
  (let ((col-span (cdr-safe (assq 'colspan (nth 1 xml-expr)))))
    (setq col-span
	  (cond
	   ((integerp
	       (setq col-span
		     (if (stringp col-span)
			 (string-to-number col-span)
		       col-span)))
	      col-span)
	   ((null col-span) 1)
	   (t (error "colspan invalide"))))  ))

(html2texi-make-simple-markup-handler sub)
(html2texi-make-simple-markup-handler sup)

(html2texi-make-simple-markup-handler tt)

(defvar html2texi-col-number nil)
(defvar html2texi-row-number nil)
(defvar html2texi-head-on-row-0 nil)
(defvar html2texi-col-count nil)
(defvar html2texi-col-info-length nil)

(defun html2texi-tag-handler-table (xml-expr)
  (let* (html2texi-col-count
	(html2texi-row-number 0)
	html2texi-head-on-row-0
	html2texi-col-number
	;; le premier élément ne correspond pas à une colonne mais servira à
	;; reduire le vecteur des informations sur chaque colonne
	(html2texi-col-info (list 0))
	(html2texi-col-info-last html2texi-col-info)
	(html2texi-col-info-length 0)
	(xml-items (cddr xml-expr)))
    (while xml-items
      (let ((xml-expr (pop xml-items)))
	(cond
	 ((and (consp xml-expr)
	       (eq (car xml-expr) 'tr))
	  ;; plus besoin de chercher une ligne: on compte les colonnes sur la
	  ;; première ligne trouvée
	  (setq xml-items nil)
	  (dolist  (xml-expr (cddr xml-expr))
	    (cond
	     ((consp xml-expr)
	      (if (memq  (car xml-expr) '(th td))
		  (progn
		    (setq html2texi-col-count
			  (+ (or html2texi-col-count 0) (html2texi-get-col-span xml-expr)))
		    (when (> html2texi-col-count html2texi-col-info-length)
		      (let ((l (make-list (- html2texi-col-count html2texi-col-info-length) '(abs 1))))
			(setcdr html2texi-col-info-last l)
			(setq html2texi-col-info-last (last l)
			      html2texi-col-info-length html2texi-col-count))))
		(error "balise inattendu dans une table")))
	     ((stringp xml-expr)
	      (unless (string-match
		       "\\`\\s-*\\(\n\\s-*\\)*\\'"
		       xml-expr)
		(error "Chaîne inattendue")))
	     (t (error "Élément inattendu")))))
	 ((stringp xml-expr)
	  (unless (string-match
		   "\\`\\s-*\\(\n\\s-*\\)*\\'"
		   xml-expr)
	    (error "Chaîne inattendue")))
	 (t (error "Élément inattendu")))))



    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(progn
	  (insert "@multitable @columnfractions ")
	  (let ((total-weight
		  (math-reduce-vec
		   (lambda (r x)
		     (+ r
			(cond
			 ((eq (car x) 'abs) (cadr x))
			 ((eq (car x) 'rel)
			  (setcar x 'abs)
			  (setcar (cdr x) (*  (cadr x) html2texi-col-info-length))
			  (cadr x)))))
		   (cons 'vec html2texi-col-info))))
		(insert (mapconcat
			 (lambda (x)
			   (number-to-string
			    (/ (float (cadr x)) html2texi-col-info-length)))
			 (cdr html2texi-col-info)
			 " ")))
	  (insert "\n"))
      (insert "@table\n"))

    (html2texi-process-xml-expr xml-expr)

    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(insert "@end multitable\n")
      (insert "@end table\n"))))


(defun html2texi-tag-handler-tr (xml-expr)
  (setq html2texi-col-number 0)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n")
  (setq html2texi-row-number (1+ html2texi-row-number)))

(defun html2texi-tag-handler-th (xml-expr)
  (if   (= 0 html2texi-col-number)
      (if (and (= 0 html2texi-row-number)
	       (null html2texi-handle-two-columns-table-as-@table))
	  (progn
	    (setq html2texi-head-on-row-0 t)
	    (insert "@headitem ")
	    (html2texi-process-xml-expr xml-expr))
	(insert "@item ")
	(html2texi-process-xml-expr xml-expr))
    (when (or (> html2texi-col-count 2)
	      (null html2texi-handle-two-columns-table-as-@table))
      (insert "@tab "))
    (html2texi-process-xml-expr xml-expr)
    (unless (and  (= 0 html2texi-row-number) html2texi-head-on-row-0)
	(insert "\n")))
  (setq html2texi-col-number (1+ html2texi-col-number)))

(defun html2texi-tag-handler-td (xml-expr)
  (if (= 0 html2texi-col-number)
	(insert "@item ")
    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
      (insert "@tab ")))
  (html2texi-process-xml-expr xml-expr)
  (insert "\n")
  (setq html2texi-col-number (1+ html2texi-col-number)))


(defun html2texi-cur-dir ()
  "Détermine le répertoire courant relativement au répertoire du
HTML racine de départ. La valeur retournée se termine par une oblique `/'"
  (let ((cur-dir  (nreverse (split-string (cdar html2texi-directory-stack) "/")))
	(ref-dir  (nreverse (split-string html2texi-directory-ref "/"))))
    (unless (and (string= (car cur-dir) "")
		 (string= (car ref-dir) ""))
      (error "Format invalide de répertoire"))
    (setq cur-dir (nreverse (cdr cur-dir))
	  ref-dir (cdr ref-dir))
    (if (or (string= (car cur-dir) "")
	    (string-match "\\`[a-z]:" (car cur-dir)))
	;; cur-dir est un chemin absolu
	(progn
	  (setq ref-dir (nreverse ref-dir))
	  (while (and cur-dir ref-dir (string= (car cur-dir) (car ref-dir)))
	    (setq cur-dir (cdr cur-dir)
		  ref-dir (cdr ref-dir)))
	  (while ref-dir
	    (push ".." cur-dir)
	    (setq ref-dir (cdr ref-dir)))
	  (concat (mapconcat 'identity cur-dir "/") "/"))
      (while (and cur-dir
		  (cond
		   ((string= (car cur-dir) "..")
		    (unless ref-dir
		      (error "Chemin invalide"))
		    (setq ref-dir (cdr ref-dir)
			  cur-dir (cdr cur-dir)))
		   ((string= (car cur-dir) ".")
		    (setq cur-dir (cdr cur-dir)))
		   (t nil))))
      (dolist (e cur-dir)
	(push e ref-dir))
      (mapconcat 'identity  (nreverse (cons "" ref-dir)) "/") )))

(defun html2texi-anchor-escape (anchor)
  (let (ret)
    (setq anchor
	  (mapconcat
	   'identity
	   (split-string anchor "-") "--"))
    (mapc
     (lambda (x)
       (if
	(or (and (>= x ?a) (<= x ?z))
	     (and (>= x ?A) (<= x ?Z))
	     (and (>= x ?0) (<= x ?9))
	     (member x '(?_ ?- ?/)))
	   (push (string x) ret)
	 (push (format "-%04x" x) ret)))
     anchor)
    (apply 'concat (nreverse ret))))

(defun html2texi-make-anchor (name &optional escape-function)
  (let* ((anchor (expand-file-name (concat (html2texi-cur-dir) name)))
	 (l-a (length anchor))
	 (l-r (length html2texi-directory-ref))
	 (l (min l-a l-r))
	 (start 0)
	 (i -1))
    (while (and
	    (< (setq i (1+ i)) l)
	    (prog1
		(= (aref anchor i) (aref html2texi-directory-ref i))
	      (and (= (aref anchor i) ?/)
		   (setq start (1+ i))))))
    (setq anchor (list (substring anchor start)))
    (dotimes (i (length (split-string (substring html2texi-directory-ref start))))
      (push "../" anchor))
    (setq anchor (apply 'concat anchor))
    (html2texi-string-escape (funcall (or escape-function 'html2texi-anchor-escape) anchor))))

(defun html2texi-simple-markup-handle (xml-expr class-alist preamble postamble)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe
			(and class-attribute
			     (assoc-string (cdr class-attribute) class-alist)))
		      (list preamble postamble))))
    (insert (car pre-post))
   (html2texi-process-xml-expr xml-expr)
   (insert (cadr pre-post))))

(defun html2texi-tag-handler-body (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))


(html2texi-make-simple-markup-handler code)

(defun html2texi-tag-handler-br (xml-expr)
  (insert "@*\n"))

(defun html2texi-tag-handler-div (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(html2texi-make-simple-markup-handler dfn)

(defun html2texi-tag-handler-dl (xml-expr)
  (insert "@table @asis\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "@end table\n"))

(defun html2texi-tag-handler-dt (xml-expr)
  (insert "@item ")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(defun html2texi-tag-handler-dd (xml-expr)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(html2texi-make-simple-markup-handler em)

(defun html2texi-tag-handler-frameset (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-frame (xml-expr)
  (let (url text)
    (dolist (x (cadr xml-expr))
      (cond
       ((eq (car x) 'src)
	(setq url (cdr x)))
       ((eq (car x) 'name)
	(setq text (cdr x)))))
    (when url
      (html2texi-process-url url text))))

(defun html2texi-tag-handler-hr (xml-expr)
  (insert "@c <hr/>\n"))

(html2texi-make-simple-markup-handler kbd)

(defun html2texi-tag-handler-html (xml-expr)
  "\
Traitement de la balise html."
  (let* ((attributes (nth 1 xml-expr))
	 (lang (assq 'lang attributes)))
    (when lang
      	(html2texi-set-doc-info 'language (cdr lang))))
    (html2texi-process-xml-expr xml-expr))

(html2texi-make-simple-markup-handler strong)

(defun html2texi-handle-string (str)
  (let (ret (pos0 0) pos1 (len (length str)))
    (while (and
	    (< pos0 len)
	    (setq pos1 (string-match "[{}@]" str pos0)))
      (push (substring str pos0 pos1) ret)
      (push (concat "@" (match-string-no-properties 0 str)) ret)
      (setq pos0 (1+ pos1)))
    (when (< pos0 len)
      (push (substring str pos0 pos1) ret))
    (apply 'concat (nreverse ret))))

(defun html2texi-generate-log-buffer ()
  (let* ((compilation-error-regexp-alist
	 '(html-to-texinfo-error
	   html-to-texinfo-warning
	   html-to-texinfo-info))
	 (b (generate-new-buffer html2texi-log-buffer-name)))
    (display-buffer b)
    (with-current-buffer b
      (compilation-mode)
      b)))

(defun html2texi-fatal-error (format-str xml-expr &rest args)
  (setq html2texi-log-buffer (or html2texi-log-buffer
				 (html2texi-generate-log-buffer)))
  (display-buffer html2texi-log-buffer)
  
  (let ((line-number (line-number-at-pos)))
    (with-current-buffer html2texi-log-buffer
      (let ((inhibit-read-only t))
	(insert (aref html2texi-log-error-names 0) ":" 
		(car html2texi-files-doing-or-done) ":"
		(if (eq xml-expr :html2texi-generic-error)
		    ""
		  (format "%d:" (+ line-number html2texi-line-delta))) 	      
		(apply
		 'format 
		 (concat format-str 
			 "\n" 
			 (aref html2texi-log-error-names 3)
			 ": <<<-----------\n" 
			 (aref html2texi-log-error-names 3)
			 ": xml-expr=%S\n"
			 (aref html2texi-log-error-names 3)
			 ": xml-stack=%S\nInfo: ----------->>>\n")
		 `( ,@args ,xml-expr ,html2texi-xml-stack)) ?\n)))
    (apply 'error format-str args)))

(defun html2texi-error (format-str xml-expr &rest args)
  (setq html2texi-log-buffer (or html2texi-log-buffer
				 (html2texi-generate-log-buffer)))
  (display-buffer html2texi-log-buffer)
  (let ((line-number (line-number-at-pos)))
    (with-current-buffer html2texi-log-buffer
      (let ((inhibit-read-only t))
	(insert (aref 1 html2texi-log-error-names) ":" 
		(car html2texi-files-doing-or-done) ":"
		(if (eq xml-expr :html2texi-generic-error)
		    ""
		  (format "%d:" (+ line-number html2texi-line-delta))) 
		" "
		(apply 'format format-str args) ?\n)))))

(defun html2texi-warning (format-str xml-expr &rest args)
  (setq html2texi-log-buffer (or html2texi-log-buffer
				 (html2texi-generate-log-buffer)))
  (display-buffer html2texi-log-buffer)
  (let ((line-number (line-number-at-pos)))
    (with-current-buffer html2texi-log-buffer
      (let ((inhibit-read-only t))
	(insert (aref html2texi-log-error-names 2) ":"
		(car html2texi-files-doing-or-done) ":"
		(if (eq xml-expr :html2texi-generic-error)
		    ""
		  (format "%d:" (+  line-number html2texi-line-delta))) 
		(apply 'format format-str args) ?\n))  )))

(defun html2texi-decode-url (url)
  "Décode les `%20' et autres séquences hexadécimale"
  (with-temp-buffer
    (insert url)
    (goto-char (point-min))
    (while (re-search-forward "%\\([[:xdigit:]]\\{2\\}\\)" nil t)
      (replace-match (string (math-read-radix
			       (match-string-no-properties 1) 16)) t t))
    (when (eq html2texi-url-encoding :html2texi-utf-8)
      (accents-de-utf-8))
    (buffer-substring (point-min) (point-max))))

(defun html2texi-process-url (url text)
  (let* ((parsed-url (url-generic-parse-url (html2texi-decode-url url)))
	 url-list
	 i file-name locator)
    ;; petit hack parce que url-generic-parse-url ne fait pas complètement le
    ;; boulot
    (when (and
	   (null  (aref parsed-url 1))
	   (setq i (string-match "#" (aref parsed-url 6)))
	   (null (aref parsed-url 7)))
      (aset parsed-url 7 (substring (aref parsed-url 6) (1+ i)))
      (aset parsed-url 6 (substring (aref parsed-url 6) 0 i)))

    (push "@uref{" url-list) ; ça peut être défait ensuite
    ;; URL
    (if (and (eq (aref parsed-url 0)
		 'cl-struct-url)
	     (null (aref parsed-url 1)))
	;; cas où il n'y a pas de protocole
	(cond
	 ;; on point vers un fichier HTML, ce n'est donc pas une URL interne
	 ;; => cas suspect
	 ((member (file-name-extension
		   (setq file-name (aref parsed-url 6)))
		  '("html" "htm"))
	  (setq file-name (expand-file-name
			   file-name
			   (file-name-directory (car html2texi-files-doing-or-done))))
	  (unless (member file-name html2texi-files-doing-or-done)
	    (add-to-list 'html2texi-files-to-do file-name))
	  (when (aref parsed-url 7)
	    (setq file-name (concat file-name "#" (aref parsed-url 7))))
	  (push (html2texi-string-escape file-name) url-list))

	 ;; cas d'une URL interne
	 ((and (string= "" file-name)
	       (setq locator (aref parsed-url 7)))
	  (pop url-list)
	  (push "@ref{" url-list)
	  (push (html2texi-make-anchor (concat "#" locator)) url-list))

	  (t
	    (push (html2texi-string-escape url) url-list)))
        (push (html2texi-string-escape url) url-list))
     ;; Text
     (when text
       (push "," url-list)
       (push (html2texi-string-escape text) url-list))
     (push "}" url-list)
     (apply 'insert (nreverse url-list))))


(html2texi-make-simple-markup-handler i)

(defun html2texi-tag-handler-li (xml-expr)
  (insert "\n@item\n")
  (unless (memq (caadr html2texi-xml-stack) '(ol ul))
    (html2texi-fatal-error "<li> était inattendu." xml-expr ))
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-link (xml-expr)
  )

(defun html2texi-tag-handler-ol (xml-expr)
  (insert "\n@enumerate")
   (html2texi-process-xml-expr xml-expr)
  (insert "\n@end enumerate\n"))

(defun html2texi-tag-handler-p (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(defun html2texi-tag-handler-ul (xml-expr)
  (insert "\n@itemize")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n@end itemize\n"))

(defun html2texi-tag-handler-span (xml-expr)
  (insert "@c span: (<span #1>#2</span> => #2.")
  (html2texi-default-handling xml-expr "span: ")
  (html2texi-process-xml-expr xml-expr)
  (insert "@c span: )\n"))

(defun html2texi-tag-handler-style (xml-expr)
  )

(defun html2texi-tag-handler-meta (xml-expr)
  (unless (and (nth 1 html2texi-xml-stack)
	       (eq (caadr html2texi-xml-stack) 'head))
    (html2texi-fatal-error "<meta> inattendu." xml-expr))
  ;; traitement du meta...
  (let* ((attribute-list (nth 1 xml-expr))
	 (http-equiv (assq 'http-equiv attribute-list))
	 (name (assq 'name attribute-list))
	 (content (assq 'content attribute-list)))
    (cond
     ((and (consp name)
	   (consp content)
	   (progn
	     (setq name (cdr name)
		   content (cdr content))
	     (stringp name))
	   (stringp content))
      (cond
       ((string= name "author")
	(html2texi-set-doc-info 'author content))
       ((string= name "language")
	(when (string-match "\\`\\([a-z]\\{2\\}\\(-[A-Z]\\{2\\}\\)?\\)\\'" content)
	  (let ((language (match-string-no-properties 1 content)))
	    (when (= (length language) 5)
	      (aset language 2 ?_))
	    (html2texi-set-doc-info 'language language))))))
     ((and (consp http-equiv)
	   (consp content)
	   (progn (setq http-equiv (cdr http-equiv))
		  (stringp http-equiv))
	   (progn (setq content (cdr content))
		  (stringp content)))
      (setq http-equiv (downcase http-equiv))
      (cond
       ((and (string= http-equiv "content-type")
	     (string-match "charset\\s-*=\\s-*\\([-a-z0-9]+\\)" content))
	(html2texi-set-doc-info 'content-type-charset (match-string-no-properties 1 content)));
       )))))

(defun html2texi-tag-handler-pre (xml-expr)
  (let ((kes html2texi-keep-empty-strings))
    (setq html2texi-keep-empty-strings t)
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-keep-empty-strings kes)))

(defun hmtl2texi-to-plain-text (xml-expr &rest flags)
  (let (ret anchor)
    (dolist (xml-expr (cddr xml-expr))
      (cond
       ((stringp xml-expr)
	(push xml-expr ret))
       ((consp xml-expr)
	(push xml-expr html2texi-xml-stack)
	(cond
	 ((and (eq (car xml-expr) 'a)
	       (setq anchor (assq 'name (nth 1 xml-expr))))
	  (push (html2texi-make-anchor (concat "#" (cdr anchor)))
		html2texi-flushable-anchors) ))
	(let ((str  (hmtl2texi-to-plain-text xml-expr)))
	  (and (null (string= str ""))
	       (push str ret)))
	(pop html2texi-xml-stack))
       (t (html2texi-fatal-error "Expression XML inattendue." xml-expr))))
    (setq  ret (mapconcat 'identity (nreverse ret) " "))
    (if (memq :one-line flags)
	(mapconcat 'identity (split-string ret "\n") " ")
      ret)))


(defun html2texi-tag-handler-title (xml-expr)
  (unless (and  (nth 1 html2texi-xml-stack)
		(eq  (caadr html2texi-xml-stack) 'head))
    (html2texi-fatal-error "<title> inattendu." xml-expr))
  (setq xml-expr (cddr xml-expr))
  (let ((str  (hmtl2texi-to-plain-text xml-expr)))
    (setq str (split-string str "\n")
	  str (mapconcat 'identity str " "))
    (unless (string= str "")
      (html2texi-set-doc-info 'title str))))

(defun html2texi-string-escape (str &optional flatten)
  (cond
   ((stringp str)
    (with-temp-buffer
      (insert str)
      (goto-char (point-min))
      (while (re-search-forward "[,@{}]" nil t)
	(cond
	 ((string= (match-string-no-properties 0) ",")
	  (replace-match "@comma{}"))
	 ((member (match-string-no-properties 0) '("@" "{" "}"))
	  (replace-match (concat "@" (match-string-no-properties 0))))))
      (when flatten
	(goto-char (point-min))
	(while (re-search-forward "\n\\(\\s-*\\)" nil t)
	  (replace-match (if (> 0 (length (match-string 1))) " " "") t t)))
      (buffer-substring (point-min) (point-max))))
   ((and (consp str) (car-safe str))
    (cond
     ((eq (car str) 'span)
      (with-temp-buffer
	(insert "@c span: (<span #1>#2</span> => string-escape of #2.")
	(html2texi-default-handling str "span: ")
	(insert (html2texi-string-escape  (nth 2 str) flatten))
	(insert "@c span: )\n")
	(buffer-substring (point-min) (point-max))))
     (t (html2texi-fatal-error "Une chaîne était attendue" str))))
   (t  (html2texi-fatal-error "Une chaîne était attendue" str))))

(defun html2texi-tag-handler-img (xml-expr)
  (let (filename width height alttext extension)
    (dolist (x (cadr xml-expr))
      (cond
       ((eq (car x) 'src)
	(setq filename (cdr x)))
       ((eq (car x) 'alt)
	(setq alttext (cdr x)))))
    (unless filename
      (html2texi-fatal-error "src=... était attendu" xml-expr))
    (setq filename (html2texi-decode-url filename))
    (setq extension (file-name-extension filename)
	  filename (file-name-sans-extension filename))
    (when (member extension '("png" "jpg" "jpeg" "eps" "txt"))
      (setq extension nil))
    (insert "@image{" (html2texi-make-anchor filename (symbol-function 'identity)))
    (let ((remainder (list width height alttext extension)))
	(while remainder
	  (if (let (non-empty)
		(mapc (lambda (x) (setq non-empty (or non-empty (stringp x))))
		      remainder)
		non-empty)
	      (insert "," (or (pop remainder) "") )
	    (setq remainder nil); rompt la boucle (while remainder...)
	    ))
	(insert "}"))))

(defun html2texi-set-doc-info (tag val)
  "Configure pour l'étiquette TAG la valeur VAL concernant les
informations globales au documents. Ces informations concernent
notamment la langue et l'encodage du document."
  (let ((info (assq tag html2texi-document-information)))
    (if info
	(setcdr info val)
      (push (cons tag val) html2texi-document-information))))

(defun html2texi-tag-handler-head (xml-expr)
  (unless html2texi-ignore-head
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-ignore-head t)))

(defun html2texi-tag-handler-noframes (xml-expr)
  )

(if (boundp 'html2texi-handler-hash-table)
    (makunbound 'html2texi-handler-hash-table))

(defconst html2texi-handler-hash-table
  (let ((ht (make-hash-table)))
    (dolist (v '(a b body code dfn dl dt dd em i kbd li p hr div ol ul pre
    head meta title frameset frame noframes span strong table th tr td h1 h2
    h3 h4 h5 h5 html link br img samp style sup sub tt))
      (puthash v (symbol-function (intern (concat "html2texi-tag-handler-" (symbol-name v))))
	       ht))
    ht)
  "Table de hashage des traitement associé à chaque balise HTML"
  )

(defun html2texi-remove-empty-strings (xml-expr)
  (setq xml-expr (cdr xml-expr))
  (save-match-data
  (while (cdr xml-expr)
    (if (and (stringp (cadr xml-expr))
	     (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'" (cadr xml-expr)))
	(setcdr xml-expr (cddr xml-expr))
      (setq xml-expr (cdr xml-expr))))))

(defun html2texi-process-xml-expr (xml-expr)
  (push xml-expr html2texi-xml-stack)
  (dolist (xml-expr (cddr xml-expr))
    (cond
     ((consp xml-expr)
      (push xml-expr html2texi-xml-stack)
      (let ((handler (gethash (intern (downcase (symbol-name (car xml-expr))))
			      html2texi-handler-hash-table)))
	(if handler
	    (funcall handler  xml-expr)
	  (html2texi-default-handling xml-expr)))
      (pop html2texi-xml-stack))
     ((stringp xml-expr)
      (and (or html2texi-keep-empty-strings
	       (null (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'"  xml-expr)))
	   (insert (html2texi-handle-string xml-expr))))
     (t (error "Expression XML inattendue %S" xml-expr))))
  (pop html2texi-xml-stack))

(defun html2texi-default-handling (xml-expr &optional prompt)
  (let ((str (split-string (prin1-to-string xml-expr) "\n")))
    (dolist (str-line str)
      (insert "\n@c " (or prompt "") str-line)))
    (insert "\n"))

(defun html2texi-process-region (beg end)
  (goto-char end)
  (let ((end (point-marker))
	is-xhtml
	re-do
	xml-expr)

    ;; Suppression de tout ce qui est en dehors des balise <html> ... </html>
    (goto-char beg)
    (setq html2texi-line-delta (line-number-at-pos))
    (setq is-xhtml
	  (looking-at "[ \t\n\r]*<!DOCTYPE[ \t\n\r]+html[ \t\n\r]+PUBLIC[ \t\n\r]+\"-//W3C//DTD XHTML"))
    (unless (re-search-forward "<html" end t)
      (html2texi-fatal-error "Balise <html> non trouvée" xml-expr))
    (setq html2texi-line-delta (- (line-number-at-pos) (* 2 html2texi-line-delta)))
    (delete-region beg (match-beginning 0))
    (unless (re-search-forward ">" end t)
      (html2texi-fatal-error "Clôture de la balise <html> trouvée" xml-expr))
    (unless  (re-search-forward "</html" end t)
      (html2texi-fatal-error "Balise </html> non trouvée trouvée" xml-expr))
    (unless (re-search-forward ">" end t)
      (html2texi-fatal-error "Clôture de la balise </html> trouvée" xml-expr))
    (delete-region (match-end 0) end)

    (or is-xhtml
	(html2texi-make-html-clean-xml beg end))

    (setq xml-expr
	  (condition-case
	      sig
	      (xml-parse-region beg end)
	    (error
	     (if (consp sig)
		 (html2texi-warning "File is XHTML but xml-parser reported error `%S'" 
				 :html2texi-generic-error
				 (cdr sig))
	       (html2texi-warning "File is XHTML but xml-parser reported errors" 
				  :html2texi-generic-error))
		  (if is-xhtml :html2texi-redo nil)))
	  xml-expr
	  (if (eq xml-expr :html2texi-redo)
	       (progn
		 (html2texi-make-html-clean-xml beg end)
		 (xml-parse-region beg end))
	     xml-expr))
  
    (delete-region beg end)
    (set-marker end nil)
    xml-expr))

(if t
;; plus partique pour déboguer qu'un vrai tampon temporaire
    (defmacro html2texi-with-temp-buffer (&rest body)
      (let ((cur-buff (make-symbol "cur-buff")))
	`(with-current-buffer
	       (let (( ,cur-buff (get-buffer "*HTML2TEXI Temp*")))
		 (and ,cur-buff (kill-buffer ,cur-buff))
		 (get-buffer-create "*HTML2TEXI Temp*"))
       (erase-buffer)
       ,@body)))
  ;;
  (defmacro html2texi-with-temp-buffer (&rest body)
    `(with-temp-buffer ,@body)))



(defun html2texi-make-texi-buffer (&optional buffer )
  (let* ((start-buffer (or buffer (current-buffer)))
	 xml-expr
	 (start-filename  (or (buffer-file-name start-buffer) (buffer-name)))
	 (start-filename-ext (file-name-extension start-filename))
	 (texi-buffer-name
	  (concat (concat  (file-name-sans-extension   (file-name-nondirectory start-filename))
			    ".texi")))
	 done-links-list
	 texi-buffer
	 html2texi-keep-empty-strings
	 html2texi-xml-parsed
	 html2texi-xml-stack
	 (html2texi-line-delta 0)
	 html2texi-ignore-head
	 html2texi-directory-stack
	 html2texi-flushable-anchors
	 html2texi-directory-ref
	 html2texi-files-doing-or-done
	 html2texi-files-to-do
	 html2texi-log-buffer)
    (unless (or (member start-filename-ext '("html" "htm"))
		(y-or-n-p (format "le tampon %s n'a pas une extension html, continuer?"
				  start-filename)))
      (error "Fichier sans extension html"))
    (setq texi-buffer (get-buffer-create texi-buffer-name))
    (set-buffer texi-buffer)
    (erase-buffer)
    (dolist (v html2texi-texi-buffer-local-variables)
      (set (make-local-variable v) nil))
    (insert (with-current-buffer start-buffer
	      (save-restriction
		(widen)
		(buffer-substring (point-min) (point-max)))))
    (accents-de-html)
    (push (cons default-directory "./") html2texi-directory-stack)
    (push start-filename html2texi-files-doing-or-done)
    (setq html2texi-directory-ref default-directory)

    (setq xml-expr (html2texi-process-region (point-min) (point-max)))
    (unless (eq 'html (caar xml-expr))
      (error "Résultat d'analyse XML inattendu"))
    (setq xml-expr `(html2texi-dummy-markup nil ,(car xml-expr)))
    (html2texi-process-xml-expr xml-expr)
    (while html2texi-files-to-do
      (setq file-name (pop html2texi-files-to-do))
      (if (file-exists-p file-name)
	  (progn
	    (push file-name html2texi-files-doing-or-done)
	    (let* ((dir (file-name-as-directory
			 (file-name-directory file-name)))
		   (rel-dir   (let ((d
				     (file-name-directory
				      (file-relative-name file-name html2texi-directory-ref))))
				(if d (file-name-as-directory d)
				  "./"))))
	      (push (cons dir rel-dir) html2texi-directory-stack)
	      (html2texi-with-temp-buffer
	       (insert-file-contents file-name)
	       (accents-de-html)
	       (html2texi-make-html-clean-xml (point-min) (point-max))
	       (setq xml-expr (html2texi-process-region (point-min) (point-max))))
	      (unless (eq 'html (caar xml-expr))
		(error "Résultat d'analyse XML inattendu"))
	      (setq xml-expr (car xml-expr))
	      (html2texi-process-xml-expr xml-expr)
	      (pop html2texi-directory-stack)	))
	(warn "Le fichier `%s' n'existe pas!" file-name)))))

(defun html2texi-insert-doc-info ()
  (let ((author
	 (html2texi-string-escape
	  (or (cdr-safe (assq 'author html2texi-document-information)) "AUTHOR")))
	(title 	 (html2texi-string-escape
		  (or (cdr-safe (assq 'title html2texi-document-information)) "TITLE")))
	(language 	 (let ((language  (cdr-safe (assq 'language html2texi-document-information))))
			   (if language (cons "" (html2texi-string-escape language))
			     (cons "@c " "LANGUAGE"))))
	(encoding  (html2texi-string-escape
			  (or (cdr-safe (assq 'content-type-charset html2texi-document-information))
			      "iso-8859-1"))))

    (goto-char (point-min))
    (insert "\\input texinfo   @c -*-mode:texinfo; coding:" (downcase encoding) "-*-
@setfilename " (file-name-sans-extension (buffer-name)) ".info
" (car language) "@documentlanguage " (cdr language) "
@documentencoding "  (if (let ((case-fold-search t))
			   (string-match "\\`\\(us\\|utf\\|iso\\)" encoding))
			 (upcase encoding) encoding) "
@copying
This manual is for PROGRAM, version VERSION.

Copyright @copyright{} YEARS COPYRIGHT-OWNER.

@quotation
Permission is granted to ...
@end quotation
@end copying

@titlepage
@title " title "@c NAME-OF-MANUAL-WHEN-PRINTED
@c @subtitle SUBTITLE-IF-ANY
@c @subtitle SECOND-SUBTITLE
@author " author "

@c  The following two commands
@c  start the copyright page.
@page
@vskip 0pt plus 1filll
@insertcopying

Published by ...
@end titlepage

@c So the toc is printed at the start.
@contents

@ifnottex
@node Top
@top TITLE

This manual is for PROGRAM, version VERSION.
@end ifnottex
")
    (goto-char (point-max))
    (insert "
@bye") ))

(defun html2texi-post-process ()
  "Remplace les double lignes vides en ligne vides simples."
  (goto-char (point-min))
  (while (re-search-forward "\\(^[ \t]*\n\\)\\{2,\\}" nil t)
    (replace-match "\n"))
  (normal-mode))

;;;###autoload
(defun html2texi ()
  (interactive)
  (html2texi-make-texi-buffer)
  (html2texi-insert-doc-info)
  (html2texi-post-process))

;; Log compilation mode stuff
(defun html2texi-define-error-regexps ()
  (dolist (v `(
	       (html-to-texinfo-error
		. 
		(
		 ,(concat "^" (regexp-opt (list (aref html2texi-log-error-names 0)
						(aref html2texi-log-error-names 1)))
			  ":\\(" html2texi-filepath-re 
			  "\\):\\(?:\\([0-9]+\\):\\)?.*$")
		 1; File
		 2; Line
		 0; Error
		 ))
	       (html-to-texinfo-warning
		. 
		(
		 ,(concat "^" (aref html2texi-log-error-names 2)
			  ":\\(" html2texi-filepath-re 
			  "\\):\\(?:\\([0-9]+\\):\\)?.*$")
		 1; File
		 2; Line
		 1; Warning
		 ))
	       (html-to-texinfo-info
		. 
		(
		 ,(concat "^" (aref html2texi-log-error-names 3)
			  ":")
		 nil; File
		 nil; Line
		 2; Warning
		 ))))
    (add-to-list 'compilation-error-regexp-alist (car v))
    (let ((cell (or (assq (car v) compilation-error-regexp-alist-alist)
		    (car (push (cons  (car v) nil) compilation-error-regexp-alist-alist)))))
      (setcdr cell (cdr v))  )))
(html2texi-define-error-regexps)

;;; html-to-texinfo.el ends here

Revision-number: 18
Prop-content-length: 145
Content-length: 145

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2012-02-08T06:02:26.000000Z
K 7
svn:log
V 43
Ajout de la gestion de la balise `center'.

PROPS-END

Node-path: trunk/lisp/html-to-texinfo.el
Node-kind: file
Node-action: change
Text-content-length: 54284
Text-content-md5: 8470c4e217125c54eb4094dae2a800a8
Content-length: 54284

;;; html-to-texinfo.el --- -*- coding: iso-8859-1 -*-
;; Copyright 2010/2012 Vincent Belaïche
;;
;; Author: Vincent Belaïche <vincent.b.1@hotmail.fr>
;; Version: $Id: html-to-texinfo.el,v 1.9 2012-02-08 06:02:26 Vincent Exp $
;; Keywords:
;; X-URL: not distributed yet
;;
;; This software is governed by the CeCILL license under French law and
;; abiding by the rules of distribution of free software.  You can  use,
;; modify and/ or redistribute the software under the terms of the CeCILL
;; license as circulated by CEA, CNRS and INRIA at the following URL
;; "http://www.cecill.info".
;;
;; As a counterpart to the access to the source code and  rights to copy,
;; modify and redistribute granted by the license, users are provided only
;; with a limited warranty  and the software's author,  the holder of the
;; economic rights,  and the successive licensors  have only  limited
;; liability.
;;
;; In this respect, the user's attention is drawn to the risks associated
;; with loading,  using,  modifying and/or developing or reproducing the
;; software by the user in light of its specific status of free software,
;; that may mean  that it is complicated to manipulate,  and  that  also
;; therefore means  that it is reserved for developers  and  experienced
;; professionals having in-depth computer knowledge. Users are therefore
;; encouraged to load and test the software's suitability as regards their
;; requirements in conditions enabling the security of their systems and/or
;; data to be ensured and,  more generally, to use and operate it in the
;; same conditions as regards security.
;;
;; The fact that you are presently reading this means that you have had
;; knowledge of the CeCILL license and that you accept its terms.
;;
;;; Commentary:

;;

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'html-to-texinfo)

;;; Code:

(provide 'html-to-texinfo)
(eval-when-compile
  (require 'cl))
(require 'eieio)
(require 'calc-ext)
(require 'accents-ascii)
(require 'compile)

;;;;##########################################################################
;;;;  User Options, Variables
;;;;##########################################################################

(defconst html2texi-suspicious-html-tags
  '("meta" "br" "hr" "link" "img" "frame")
"Liste des balises pour lesquelles le HTML ne suit pas une
syntaxe strictement XML. Par exemple `<br>' est utilisé au lieu
de `<br/>'."  )

(defconst html2texi-suspicious-html-tags-re
  (regexp-opt html2texi-suspicious-html-tags))

(defconst html2texi-non-recursive-tags
  '("p" "li"))

(defconst html2texi-hierarchy-list
  '(
    (li (ul ol))
    (tr (table))
    (th (tr))
    (td (tr))
    (dd (dl))
    (dt (dl))  )
  )

(defconst html2texi-non-recursive-tags-re
  (regexp-opt html2texi-non-recursive-tags))

(defconst html2texi-filepath-re
  "\\(?:[A-Za-z]:\\)?[- ~+A-Za-z_0-9./\\]+")

(defconst html2texi-texi-buffer-local-variables
  '(html2texi-document-information)
    "Liste des variables déclarées localement au tampon Texinfo.")

(defconst html2texi-allowed-markup-in-@center
  '(img b i em tt strong dfn code)
  "Liste des balises autorisées pour @center.")

(defconst html2texi-@center-max-size 1000)

(defclass html2texi-simple-markup ()
  ((class-dependant
    :initarg :class-dependant
    :initform nil
    :custom '(repeat
	  (list
	   (regexp :tag "clef")
	   (string :tag "prologue")
	   (string :tag "épilogue")
	   (boolean :tag "conserver les espaces et retours chariot")
	   ))
    :documentation "\
Liste d'association dont les éléments sont de la forme
 (CLEF PROLOGUE ÉPILOGUE)

Supposons que l'objet décrit le traitement de la balise TAG,
alors lorsque le code HTML `<TAG class=\"CLEF\">CONTENU</TAG>'
est rencontré, alors il est convertie en le code Texinfo
`PROLOGUE TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU.")
   (preamble
    :initarg :preamble
    :type string
    :documentation "\
Prologue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (postamble
    :initarg :postamble
    :type string
    :documentation "\
Épilogue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (space-verb
    :initarg :space-verb
    :initform nil
    :type boolean
    :documentation "\
Vrai lorsque les espaces et retours chariot sont à conserver tels quels."
    ))
  :documentation "\
Un object de type `html2texi-simple-markup'
décrit le traitement d'une balise simple comme par exemple
<code>.")

(defun html2texi-texinfo-inside-comment-p ()
  "Renvoie non nil lorsque le point est dans un commentaire Texinfo."
  (save-match-data
    (save-excursion
      (let ((cur (point))
	    (end (progn (end-of-line) (point))))
	(beginning-of-line)
	(and (re-search-forward "\\(^\\|[^@]\\)@c\\(omment\\)\\_>" end t)
	     (<= (match-beginning 0) cur))))))

(defmethod html2texi-handle-simple-markup
  ((this html2texi-simple-markup) xml-expr)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe
			(and class-attribute
			     (assoc-string (cdr class-attribute)
					   (oref this :class-dependant))))
		      (list (oref this :preamble)
			    (oref this :postamble)))))
    (insert (car pre-post))
    (let ((beg (point))
	  end)
      (html2texi-process-xml-expr xml-expr)
      (unless (oref this :space-verb)
	(setq end (point-marker))
	(goto-char beg)
	(while (re-search-forward "[\n\r]\\s-*" nil end)
	  (let ((replace-str " "))
	    (save-match-data
	      (cond
	       ((html2texi-texinfo-inside-comment-p)
		(setq replace-str nil))))
	      (and replace-str (replace-match replace-str t t)))))
	(goto-char end)
	(set-marker end nil))
    (insert (cadr pre-post))))


(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-url-encoding
  :html2texi-utf-8
  "Sélectionne le codage des URL."
  :type '(choice 
	  (symbol :tag "UTF-8" :html2texi-utf-8)
	  (symbol :tag "ISO-8859-1" :html2texi-latin-1))
  :group 'html2texi)

(defcustom html2texi-i-simple-markup
  (html2texi-simple-markup "html2texi-i-simple-markup"
   :preamble "@i{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-b-simple-markup
  (html2texi-simple-markup "html2texi-b-simple-markup"
   :preamble "@b{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-kbd-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :preamble "@kbd{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-dfn-simple-markup
  (html2texi-simple-markup "html2texi-dfn-simple-markup"
   :preamble "@dfn{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-em-simple-markup
  (html2texi-simple-markup "html2texi-em-simple-markup"
   :preamble "@emph{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-sub-simple-markup
  (html2texi-simple-markup "html2texi-sub-simple-markup"
   :preamble ""
   :postamble "")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<sub class=\"CLEF\">CONTENU</sub>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-sup-simple-markup
  (html2texi-simple-markup "html2texi-sup-simple-markup"
   :preamble ""
   :postamble "")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<sup class=\"CLEF\">CONTENU</sup>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-samp-simple-markup
  (html2texi-simple-markup "html2texi-samp-simple-markup"
   :preamble "@samp{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<samp class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-strong-simple-markup
  (html2texi-simple-markup "html2texi-strong-simple-markup"
   :preamble "@strong{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-tt-simple-markup
  (html2texi-simple-markup "html2texi-tt-simple-markup"
   :preamble "@t{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<tt class=\"CLEF\">CONTENU</tt>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-handle-two-columns-table-as-@table
  t
 "Si `nil' alors une table `<table>...</table>'
avec deux colonne sera gérée en texinfo par une `@table', si non
`nil', alors elle sera gérée par une `@multitable'."
  :type
  '(choice
    (const :tag "t pour @table" t)
    (const :tag "nil pour @multitable" nil))
  :group 'html2texi)

(defcustom html2texi-log-error-names
   ["Erreur fatale" "Erreur" "Avertissement" "Info"]
   "Liste des types d'erreur préfixant les messages d'erreur dans
le tampon de sortie des erreurs & avertissement de traitement."
   :type
   '(vector
     (string :tag "Erreur fatale")
     (string :tag "Erreur")
     (string :tag "Avertissement")
     (string :tag "Info"))
   :group 'html2texi  )

(defcustom html2texi-log-buffer-name
  "*HTML2TEXI*"
  "Nom du tampon de sortie des erreurs et avertissements de traitement."
  :type 'string
  :group 'html2texi)


(defvar html2texi-document-information nil
  "Liste d'association pour mémoriser les informations (titre,
  auteurs, etc...) propres à un document.")

(defvar html2texi-line-delta 0
  "Décalage entre le numéro de ligne du code XML au sein le
  tampon Texinfo en cours de traitement, et son numéro de ligne
  dans le fichier HTML source.")


(defvar html2texi-xml-parsed nil
  "Résultat de l'analyse syntaxique d'un doc")

(defvar html2texi-xml-stack nil
  "Pile des expressions XML")

(defvar html2texi-keep-empty-strings nil
  "Non nil si les chaînes vides sont à conserver.")

(defvar html2texi-ignore-head nil
  "Non nil si on ignore le <head> (dans un fichier HTML lié).")

(defvar html2texi-directory-stack nil
  "Pile des chemins de répertoire.")

(defvar html2texi-files-doing-or-done nil
  "Liste des fichiers déjà traités, ou le fichier en cours de traitement.
Le fichier en cours de traitement est en première position dans cette liste.")

(defvar html2texi-files-to-do nil
  "Liste des fichiers non encore traités")

(defvar html2texi-flushable-anchors nil
  "Liste de nom d'ancrage de lien dont l'insertion a été remise à
  plus tard." )

(defvar html2texi-postpone-output nil
  "Non `nil' lorsque l'insertion du code est remise à plus tard.")


(defvar html2texi-directory-ref nil
  "Répertoire de référence")

(defvar html2texi-log-buffer nil
  "Tampon de sortie des erreurs et avertissements de traitement.")

(defmacro html2texi-make-simple-markup-handler (tag)
  `(defun ,(intern (concat "html2texi-tag-handler-" (symbol-name tag)))
     (xml-expr)
     (html2texi-handle-simple-markup
      ,(intern (concat "html2texi-"  (symbol-name tag) "-simple-markup"))
      xml-expr) ))

(defun html2texi-make-html-clean-xml (beg end)
  (let  ((end-arg end)
	 end)
    (if (markerp end-arg)
	(setq end end-arg)
      (goto-char end-arg)
      (setq end (point-marker)))
    ;; rend les balise implicitement auto-closante vraiment auto-closante
    (goto-char beg)
   (while (re-search-forward (concat "<\\(" html2texi-suspicious-html-tags-re "\\)\\>")
			      end t)
      (let ((tag (match-string-no-properties 1)))
	(unless (re-search-forward ">" nil t)
	  (html2texi-fatal-error "%s:%d: Clôture non trouvé pour la balise %s" nil
		 (car html2texi-files-doing-or-done)
		 (+ (line-number-at-pos) html2texi-line-delta)
		 tag))
	(when (null (looking-back "/>"))
	  (backward-char)
	  (insert "/")
	  (forward-char))))
    ;; marque de paragraphe et de ligne
    (goto-char beg)
    (let (tag-stack pos-< pos->
		    tag is-closure self-closing)
      (while (re-search-forward "<\\(/\\)?\\([a-zA-Z]+\\)\\>" end t)
	(setq pos-< (match-beginning 0)
	      tag (match-string-no-properties 2)
	      is-closure (match-string-no-properties 1))
	(unless (string= tag (downcase tag))
	  (replace-match (setq tag (downcase tag)) 2))
	(unless (re-search-forward ">" end t)
	  (error "%s:%d: Soufflet de clôture non trouvé pour la balise %s"
		 (car html2texi-files-doing-or-done)
		 (+ (line-number-at-pos) html2texi-line-delta)
		 tag))
	
	(setq pos-> (point)
	      self-closing (looking-back "/>"))
	(cond
	 ((and self-closing  is-closure)
	  (error "%s:%d: balise %s à la fois de clôture et auto-closante"
		 (car html2texi-files-doing-or-done)
		 (+ (line-number-at-pos) html2texi-line-delta)
		 tag))

	 (self-closing
	  ;; do nothing
	  )

	 ((null is-closure)
	  (when (and
		 (string-match (concat "\\`" html2texi-non-recursive-tags-re "\\'") tag)
		 tag-stack
		 (string= tag (caar tag-stack)))
	    ;; clôture
	    (save-excursion
	      (goto-char pos-<)
	      (insert "</" tag "><!-- HTML2TEXI: repaired (1) -->")
	      (html2texi-warning "Ajout clôture `</%s>'" nil tag))
	    (pop tag-stack))
	  (push (list tag) tag-stack))

	 (is-closure
	      (if (and tag-stack
		       (string= (caar tag-stack) tag))
		  (pop tag-stack)
		(let ((first (assoc-string tag tag-stack)) rev)
		  (if first
		      (progn
			(while (and tag-stack (null (eq (car tag-stack) first)))
			  (push (pop tag-stack) rev))
			(pop tag-stack)
			(save-excursion
			  (goto-char pos-<)
			  (dolist (c rev)
			    (insert  "</" (car c) "><!-- HTML2TEXI: repaired (2) -->" )
			     (html2texi-warning "Ajout clôture `</%s>'" nil tag))))
		    
		    (save-excursion
		       (goto-char pos->)
		       (insert "-->")
		       (goto-char pos-<)
		       (insert "<!-- HTML2TEXI: repaired (3). "))
		    (html2texi-warning "Clôture de %s ne correspondant à aucune ouverture" nil tag)))))))


      (let (p-pos li-pos markup poss pos)
	(while (re-search-forward "<\\(/\\)?\\(p\\|li\\)\\>[^>]*>" end t)
	  (setq markup (match-string-no-properties 2)
		poss (intern (concat markup "-pos"))
		pos (symbol-value poss))
	  (if (match-string-no-properties 1)
	      (if  pos
		  (if (= pos (match-beginning 0))
		      (set poss nil)
		    (html2texi-fatal-error "%s:%d: Clôture de balise %s ne correspondant à aucune ouverture" nil
			   (car html2texi-files-doing-or-done)
			   (+ (line-number-at-pos) html2texi-line-delta)
			   (match-string-no-properties 0)))
		(save-excursion
		  (save-match-data
		    (unless  (re-search-forward
			      (format "<\\(/\\)?\\(%s\\)\\>[^>]+>" markup)
			      end t)
		      (html2texi-fatal-error "%s:%d: Ouverture de balise <%s> sans clôture" nil
			   (car html2texi-files-doing-or-done)
			   (+ (line-number-at-pos) html2texi-line-delta)
			     markup))
		    (set poss (match-beginning 0))
		    (unless (match-string-no-properties 1)
		      (goto-char (match-beginning 0))
		      (insert (format "</%s>" markup))
		      (dolist (symb '(p-pos li-pos))
			(unless (or (null (symbol-value symb))
				 (eq symb poss))
			  (set symb (+ (length markup) 3 (symbol-value symb)))))))))))
	    ))
    ;; mise entre guillemets anglais des attributs entier sans guillemets
    (goto-char beg)
    (let (p1 p2 added-dquote-attributes p-start)
      ;; tant qu'on trouve potentiellement un attribut sans "..."
      (while (re-search-forward "\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([-+]?[0-9]+\\)"
				nil end)
	(setq p1 (match-beginning 1)
	      p2 (match-end 0))
	(if
	    ;; si la position est bien entre < et >
	    (and (re-search-backward "[<>]" nil beg)
		 (looking-at "<\\sw+")
		 (progn
		   (goto-char (setq p-start (match-end 0)))
		   (re-search-forward "[<>]" nil beg)
		   (string= (match-string-no-properties 0) ">"))
		 (>= (point) p1))
	    ;; alors on fait la réparation
	    (progn
	      (goto-char p-start)
	      (while
		  (progn
		    (while (looking-at "\\(?:\\s-\\|\n\\)*\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\"[^\"]*\"")
		      (goto-char (match-end 0)))
		    (cond
		     ((looking-at  "\\(?:\\s-\\|\n\\)*\\(\\sw+\\)\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([-+]?[0-9]+\\)")
		      (push (match-string-no-properties 1) added-dquote-attributes)
		      (goto-char (match-beginning 2))
		      (insert ?\")
		      (goto-char (1+ (match-end 2)))
		      (insert ?\")
		      (setq pos-> (+ 2 pos->)))
		     ((looking-at "\\(?:\\s-\\|\n\\)*>")
		      (goto-char (match-end 0))
			  (insert "<!-- HTML2TEXI inserted double quotes around values for attibutes: "
				  (mapconcat (lambda (x) (concat "`" x "'"))
					     added-dquote-attributes
					     ", ")
				  " -->")
			  nil)
		     (t (error "%s:%d: Attribut au format invalide: %s"
			       (car html2texi-files-doing-or-done)
			       (+ (line-number-at-pos) html2texi-line-delta)
			       (match-string-no-properties (point)
							      (+ p2
								 (* 2 (length added-dquote-attributes))))))))))
	  ;; sinon on continue à chercher un attribut potentiel dont la valeur
	  ;; n'est pas entre "..."
	  (goto-char p2))))

    ;; un peu de ménage...
    (unless (markerp end-arg)
      (set-marker end nil)) ))

;;;==========================================================================
;;; définition des gestionnaires de balise
;;;--------------------------------------------------------------------------

(defun html2texi-tag-handler-a (xml-expr)
  (let (name href text (xml-expr-length (length xml-expr)))
    (dolist (attrib (cadr xml-expr))
      (cond
       ((eq (car attrib) 'href)
	(setq href (cdr attrib)))
       ((eq (car attrib) 'name)
	(setq name (cdr attrib)))))
    (and (cddr xml-expr)
	 (setq text (caddr xml-expr)))
    (cond
     (href (html2texi-process-url href text))
     ((= xml-expr-length 3)
      (cond
       ((stringp text)
	(insert (html2texi-string-escape text t)))
       ((consp text) (html2texi-process-xml-expr text))
       (t (error "Le format du text de la balise <a> était inattendu"))))
     ((> xml-expr-length 3)
      (html2texi-process-xml-expr `(div nil ,@(cddr xml-expr)))))
    (and name
      (insert "\n@anchor{" (html2texi-make-anchor (concat "#" name)) "}\n"))))

(html2texi-make-simple-markup-handler b)

(defun html2texi-flush-anchors ()
  (while html2texi-flushable-anchors
    (insert "@anchor{" (pop html2texi-flushable-anchors) "}\n")))


(defun html2texi-tag-handler-h1 (xml-expr)
  (insert "@chapter " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))


(defun html2texi-tag-handler-h2 (xml-expr)
  (insert "@section " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))

(defun html2texi-tag-handler-h3 (xml-expr)
  (insert "@subsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
    (html2texi-flush-anchors))

(defun html2texi-tag-handler-h4 (xml-expr)
  (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))

(defun html2texi-tag-handler-h5 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
     (html2texi-flush-anchors))

(defun html2texi-tag-handler-h6 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
   (html2texi-flush-anchors))

(html2texi-make-simple-markup-handler samp)


(defun html2texi-get-col-span (xml-expr)
  ;; xml-expr is <td> or <th>
  (let ((col-span (cdr-safe (assq 'colspan (nth 1 xml-expr)))))
    (setq col-span
	  (cond
	   ((integerp
	       (setq col-span
		     (if (stringp col-span)
			 (string-to-number col-span)
		       col-span)))
	      col-span)
	   ((null col-span) 1)
	   (t (error "colspan invalide"))))  ))

(html2texi-make-simple-markup-handler sub)
(html2texi-make-simple-markup-handler sup)

(html2texi-make-simple-markup-handler tt)

(defvar html2texi-col-number nil)
(defvar html2texi-row-number nil)
(defvar html2texi-head-on-row-0 nil)
(defvar html2texi-col-count nil)
(defvar html2texi-col-info-length nil)

(defun html2texi-tag-handler-table (xml-expr)
  (let* (html2texi-col-count
	(html2texi-row-number 0)
	html2texi-head-on-row-0
	html2texi-col-number
	;; le premier élément ne correspond pas à une colonne mais servira à
	;; reduire le vecteur des informations sur chaque colonne
	(html2texi-col-info (list 0))
	(html2texi-col-info-last html2texi-col-info)
	(html2texi-col-info-length 0)
	(xml-items (cddr xml-expr)))
    (while xml-items
      (let ((xml-expr (pop xml-items)))
	(cond
	 ((and (consp xml-expr)
	       (eq (car xml-expr) 'tr))
	  ;; plus besoin de chercher une ligne: on compte les colonnes sur la
	  ;; première ligne trouvée
	  (setq xml-items nil)
	  (dolist  (xml-expr (cddr xml-expr))
	    (cond
	     ((consp xml-expr)
	      (if (memq  (car xml-expr) '(th td))
		  (progn
		    (setq html2texi-col-count
			  (+ (or html2texi-col-count 0) (html2texi-get-col-span xml-expr)))
		    (when (> html2texi-col-count html2texi-col-info-length)
		      (let ((l (make-list (- html2texi-col-count html2texi-col-info-length) '(abs 1))))
			(setcdr html2texi-col-info-last l)
			(setq html2texi-col-info-last (last l)
			      html2texi-col-info-length html2texi-col-count))))
		(error "balise inattendu dans une table")))
	     ((stringp xml-expr)
	      (unless (string-match
		       "\\`\\s-*\\(\n\\s-*\\)*\\'"
		       xml-expr)
		(error "Chaîne inattendue")))
	     (t (error "Élément inattendu")))))
	 ((stringp xml-expr)
	  (unless (string-match
		   "\\`\\s-*\\(\n\\s-*\\)*\\'"
		   xml-expr)
	    (error "Chaîne inattendue")))
	 (t (error "Élément inattendu")))))



    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(progn
	  (insert "@multitable @columnfractions ")
	  (let ((total-weight
		  (math-reduce-vec
		   (lambda (r x)
		     (+ r
			(cond
			 ((eq (car x) 'abs) (cadr x))
			 ((eq (car x) 'rel)
			  (setcar x 'abs)
			  (setcar (cdr x) (*  (cadr x) html2texi-col-info-length))
			  (cadr x)))))
		   (cons 'vec html2texi-col-info))))
		(insert (mapconcat
			 (lambda (x)
			   (number-to-string
			    (/ (float (cadr x)) html2texi-col-info-length)))
			 (cdr html2texi-col-info)
			 " ")))
	  (insert "\n"))
      (insert "@table\n"))

    (html2texi-process-xml-expr xml-expr)

    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(insert "@end multitable\n")
      (insert "@end table\n"))))


(defun html2texi-tag-handler-tr (xml-expr)
  (setq html2texi-col-number 0)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n")
  (setq html2texi-row-number (1+ html2texi-row-number)))

(defun html2texi-tag-handler-th (xml-expr)
  (if   (= 0 html2texi-col-number)
      (if (and (= 0 html2texi-row-number)
	       (null html2texi-handle-two-columns-table-as-@table))
	  (progn
	    (setq html2texi-head-on-row-0 t)
	    (insert "@headitem ")
	    (html2texi-process-xml-expr xml-expr))
	(insert "@item ")
	(html2texi-process-xml-expr xml-expr))
    (when (or (> html2texi-col-count 2)
	      (null html2texi-handle-two-columns-table-as-@table))
      (insert "@tab "))
    (html2texi-process-xml-expr xml-expr)
    (unless (and  (= 0 html2texi-row-number) html2texi-head-on-row-0)
	(insert "\n")))
  (setq html2texi-col-number (1+ html2texi-col-number)))

(defun html2texi-tag-handler-td (xml-expr)
  (if (= 0 html2texi-col-number)
	(insert "@item ")
    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
      (insert "@tab ")))
  (html2texi-process-xml-expr xml-expr)
  (insert "\n")
  (setq html2texi-col-number (1+ html2texi-col-number)))


(defun html2texi-cur-dir ()
  "Détermine le répertoire courant relativement au répertoire du
HTML racine de départ. La valeur retournée se termine par une oblique `/'"
  (let ((cur-dir  (nreverse (split-string (cdar html2texi-directory-stack) "/")))
	(ref-dir  (nreverse (split-string html2texi-directory-ref "/"))))
    (unless (and (string= (car cur-dir) "")
		 (string= (car ref-dir) ""))
      (error "Format invalide de répertoire"))
    (setq cur-dir (nreverse (cdr cur-dir))
	  ref-dir (cdr ref-dir))
    (if (or (string= (car cur-dir) "")
	    (string-match "\\`[a-z]:" (car cur-dir)))
	;; cur-dir est un chemin absolu
	(progn
	  (setq ref-dir (nreverse ref-dir))
	  (while (and cur-dir ref-dir (string= (car cur-dir) (car ref-dir)))
	    (setq cur-dir (cdr cur-dir)
		  ref-dir (cdr ref-dir)))
	  (while ref-dir
	    (push ".." cur-dir)
	    (setq ref-dir (cdr ref-dir)))
	  (concat (mapconcat 'identity cur-dir "/") "/"))
      (while (and cur-dir
		  (cond
		   ((string= (car cur-dir) "..")
		    (unless ref-dir
		      (error "Chemin invalide"))
		    (setq ref-dir (cdr ref-dir)
			  cur-dir (cdr cur-dir)))
		   ((string= (car cur-dir) ".")
		    (setq cur-dir (cdr cur-dir)))
		   (t nil))))
      (dolist (e cur-dir)
	(push e ref-dir))
      (mapconcat 'identity  (nreverse (cons "" ref-dir)) "/") )))

(defun html2texi-anchor-escape (anchor)
  (let (ret)
    (setq anchor
	  (mapconcat
	   'identity
	   (split-string anchor "-") "--"))
    (mapc
     (lambda (x)
       (if
	(or (and (>= x ?a) (<= x ?z))
	     (and (>= x ?A) (<= x ?Z))
	     (and (>= x ?0) (<= x ?9))
	     (member x '(?_ ?- ?/)))
	   (push (string x) ret)
	 (push (format "-%04x" x) ret)))
     anchor)
    (apply 'concat (nreverse ret))))

(defun html2texi-make-anchor (name &optional escape-function)
  (let* ((anchor (expand-file-name (concat (html2texi-cur-dir) name)))
	 (l-a (length anchor))
	 (l-r (length html2texi-directory-ref))
	 (l (min l-a l-r))
	 (start 0)
	 (i -1))
    (while (and
	    (< (setq i (1+ i)) l)
	    (prog1
		(= (aref anchor i) (aref html2texi-directory-ref i))
	      (and (= (aref anchor i) ?/)
		   (setq start (1+ i))))))
    (setq anchor (list (substring anchor start)))
    (dotimes (i (length (split-string (substring html2texi-directory-ref start))))
      (push "../" anchor))
    (setq anchor (apply 'concat anchor))
    (html2texi-string-escape (funcall (or escape-function 'html2texi-anchor-escape) anchor))))

(defun html2texi-simple-markup-handle (xml-expr class-alist preamble postamble)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe
			(and class-attribute
			     (assoc-string (cdr class-attribute) class-alist)))
		      (list preamble postamble))))
    (insert (car pre-post))
   (html2texi-process-xml-expr xml-expr)
   (insert (cadr pre-post))))

(defun html2texi-tag-handler-body (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))


(html2texi-make-simple-markup-handler code)

(defun html2texi-tag-handler-br (xml-expr)
  (insert "@*\n"))

(defun html2texi-tag-handler-div (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(html2texi-make-simple-markup-handler dfn)

(defun html2texi-tag-handler-dl (xml-expr)
  (insert "@table @asis\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "@end table\n"))

(defun html2texi-tag-handler-dt (xml-expr)
  (insert "@item ")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(defun html2texi-tag-handler-dd (xml-expr)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(html2texi-make-simple-markup-handler em)

(defun html2texi-tag-handler-frameset (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-frame (xml-expr)
  (let (url text)
    (dolist (x (cadr xml-expr))
      (cond
       ((eq (car x) 'src)
	(setq url (cdr x)))
       ((eq (car x) 'name)
	(setq text (cdr x)))))
    (when url
      (html2texi-process-url url text))))

(defun html2texi-tag-handler-hr (xml-expr)
  (insert "@c <hr/>\n"))

(html2texi-make-simple-markup-handler kbd)

(defun html2texi-tag-handler-html (xml-expr)
  "\
Traitement de la balise html."
  (let* ((attributes (nth 1 xml-expr))
	 (lang (assq 'lang attributes)))
    (when lang
      	(html2texi-set-doc-info 'language (cdr lang))))
    (html2texi-process-xml-expr xml-expr))

(html2texi-make-simple-markup-handler strong)

(defun html2texi-handle-string (str)
  (let (ret (pos0 0) pos1 (len (length str)))
    (while (and
	    (< pos0 len)
	    (setq pos1 (string-match "[{}@]" str pos0)))
      (push (substring str pos0 pos1) ret)
      (push (concat "@" (match-string-no-properties 0 str)) ret)
      (setq pos0 (1+ pos1)))
    (when (< pos0 len)
      (push (substring str pos0 pos1) ret))
    (apply 'concat (nreverse ret))))

(defun html2texi-generate-log-buffer ()
  (let* ((compilation-error-regexp-alist
	 '(html-to-texinfo-error
	   html-to-texinfo-warning
	   html-to-texinfo-info))
	 (b (generate-new-buffer html2texi-log-buffer-name)))
    (display-buffer b)
    (with-current-buffer b
      (compilation-mode)
      b)))

(defun html2texi-fatal-error (format-str xml-expr &rest args)
  (setq html2texi-log-buffer (or html2texi-log-buffer
				 (html2texi-generate-log-buffer)))
  (display-buffer html2texi-log-buffer)
  
  (let ((line-number (line-number-at-pos)))
    (with-current-buffer html2texi-log-buffer
      (let ((inhibit-read-only t))
	(insert (aref html2texi-log-error-names 0) ":" 
		(car html2texi-files-doing-or-done) ":"
		(if (eq xml-expr :html2texi-generic-error)
		    ""
		  (format "%d:" (+ line-number html2texi-line-delta))) 	      
		(apply
		 'format 
		 (concat format-str 
			 "\n" 
			 (aref html2texi-log-error-names 3)
			 ": <<<-----------\n" 
			 (aref html2texi-log-error-names 3)
			 ": xml-expr=%S\n"
			 (aref html2texi-log-error-names 3)
			 ": xml-stack=%S\nInfo: ----------->>>\n")
		 `( ,@args ,xml-expr ,html2texi-xml-stack)) ?\n)))
    (apply 'error format-str args)))

(defun html2texi-error (format-str xml-expr &rest args)
  (setq html2texi-log-buffer (or html2texi-log-buffer
				 (html2texi-generate-log-buffer)))
  (display-buffer html2texi-log-buffer)
  (let ((line-number (line-number-at-pos)))
    (with-current-buffer html2texi-log-buffer
      (let ((inhibit-read-only t))
	(insert (aref 1 html2texi-log-error-names) ":" 
		(car html2texi-files-doing-or-done) ":"
		(if (eq xml-expr :html2texi-generic-error)
		    ""
		  (format "%d:" (+ line-number html2texi-line-delta))) 
		" "
		(apply 'format format-str args) ?\n)))))

(defun html2texi-warning (format-str xml-expr &rest args)
  (setq html2texi-log-buffer (or html2texi-log-buffer
				 (html2texi-generate-log-buffer)))
  (display-buffer html2texi-log-buffer)
  (let ((line-number (line-number-at-pos)))
    (with-current-buffer html2texi-log-buffer
      (let ((inhibit-read-only t))
	(insert (aref html2texi-log-error-names 2) ":"
		(car html2texi-files-doing-or-done) ":"
		(if (eq xml-expr :html2texi-generic-error)
		    ""
		  (format "%d:" (+  line-number html2texi-line-delta))) 
		(apply 'format format-str args) ?\n))  )))

(defun html2texi-decode-url (url)
  "Décode les `%20' et autres séquences hexadécimale"
  (with-temp-buffer
    (insert url)
    (goto-char (point-min))
    (while (re-search-forward "%\\([[:xdigit:]]\\{2\\}\\)" nil t)
      (replace-match (string (math-read-radix
			       (match-string-no-properties 1) 16)) t t))
    (when (eq html2texi-url-encoding :html2texi-utf-8)
      (accents-de-utf-8))
    (buffer-substring (point-min) (point-max))))

(defun html2texi-process-url (url text)
  (let* ((parsed-url (url-generic-parse-url (html2texi-decode-url url)))
	 url-list
	 i file-name locator)
    ;; petit hack parce que url-generic-parse-url ne fait pas complètement le
    ;; boulot
    (when (and
	   (null  (aref parsed-url 1))
	   (setq i (string-match "#" (aref parsed-url 6)))
	   (null (aref parsed-url 7)))
      (aset parsed-url 7 (substring (aref parsed-url 6) (1+ i)))
      (aset parsed-url 6 (substring (aref parsed-url 6) 0 i)))

    (push "@uref{" url-list) ; ça peut être défait ensuite
    ;; URL
    (if (and (eq (aref parsed-url 0)
		 'cl-struct-url)
	     (null (aref parsed-url 1)))
	;; cas où il n'y a pas de protocole
	(cond
	 ;; on point vers un fichier HTML, ce n'est donc pas une URL interne
	 ;; => cas suspect
	 ((member (file-name-extension
		   (setq file-name (aref parsed-url 6)))
		  '("html" "htm"))
	  (setq file-name (expand-file-name
			   file-name
			   (file-name-directory (car html2texi-files-doing-or-done))))
	  (unless (member file-name html2texi-files-doing-or-done)
	    (add-to-list 'html2texi-files-to-do file-name))
	  (when (aref parsed-url 7)
	    (setq file-name (concat file-name "#" (aref parsed-url 7))))
	  (push (html2texi-string-escape file-name) url-list))

	 ;; cas d'une URL interne
	 ((and (string= "" file-name)
	       (setq locator (aref parsed-url 7)))
	  (pop url-list)
	  (push "@ref{" url-list)
	  (push (html2texi-make-anchor (concat "#" locator)) url-list))

	  (t
	    (push (html2texi-string-escape url) url-list)))
        (push (html2texi-string-escape url) url-list))
     ;; Text
     (when text
       (push "," url-list)
       (push (html2texi-string-escape text) url-list))
     (push "}" url-list)
     (apply 'insert (nreverse url-list))))

(defun html2texi-tag-handler-center (xml-expr)
  (let ((start-point (point))
	(start-ln (line-number-at-pos))
	end-mark)
    (html2texi-process-xml-expr xml-expr)
    (when (and (<= (point) (+ start-point html2texi-@center-max-size))
	       (> (point) start-point)
	       ;; test histoire que le code soit à l'épreuve du temps : il se
	       ;; pourrait qu'on soit déjà centré pour une autre raison.
	       (null (save-excursion 
		       (goto-char start-point)
		       (looking-at "\\(\n\\|\\s-\\)*@center\\>")))
	       (let (to-do
		     (ok t)
		     xml-expr
		     (l (cdr-safe (cdr-safe xml-expr))))
		 (while (and ok (or to-do l))
		   (if l
		       (progn
			 (setq xml-expr (pop l))
			 (cond
			  ((stringp xml-expr))
			  ((and (consp xml-expr)
				(memq (car xml-expr) html2texi-allowed-markup-in-@center))
			   (push xml-expr to-do))
			  (t (setq ok nil))))
		     (setq l (cdr-safe (cdr-safe (pop to-do))))))
		 (when ok
		   (setq end-mark (point-marker))
		   (goto-char start-point)
		   (insert "\n@center ")
		   (while (search-forward "\n" end-mark t)
		     (delete-char -1)
		     (insert 32))
		   (goto-char end-mark)
		   (set-marker end-mark nil)))))))

(html2texi-make-simple-markup-handler i)

(defun html2texi-tag-handler-li (xml-expr)
  (insert "\n@item\n")
  (unless (memq (caadr html2texi-xml-stack) '(ol ul))
    (html2texi-fatal-error "<li> était inattendu." xml-expr ))
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-link (xml-expr)
  )

(defun html2texi-tag-handler-ol (xml-expr)
  (insert "\n@enumerate")
   (html2texi-process-xml-expr xml-expr)
  (insert "\n@end enumerate\n"))

(defun html2texi-tag-handler-p (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(defun html2texi-tag-handler-ul (xml-expr)
  (insert "\n@itemize")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n@end itemize\n"))

(defun html2texi-tag-handler-span (xml-expr)
  (insert "@c span: (<span #1>#2</span> => #2.")
  (html2texi-default-handling xml-expr "span: ")
  (html2texi-process-xml-expr xml-expr)
  (insert "@c span: )\n"))

(defun html2texi-tag-handler-style (xml-expr)
  )

(defun html2texi-tag-handler-meta (xml-expr)
  (unless (and (nth 1 html2texi-xml-stack)
	       (eq (caadr html2texi-xml-stack) 'head))
    (html2texi-fatal-error "<meta> inattendu." xml-expr))
  ;; traitement du meta...
  (let* ((attribute-list (nth 1 xml-expr))
	 (http-equiv (assq 'http-equiv attribute-list))
	 (name (assq 'name attribute-list))
	 (content (assq 'content attribute-list)))
    (cond
     ((and (consp name)
	   (consp content)
	   (progn
	     (setq name (cdr name)
		   content (cdr content))
	     (stringp name))
	   (stringp content))
      (cond
       ((string= name "author")
	(html2texi-set-doc-info 'author content))
       ((string= name "language")
	(when (string-match "\\`\\([a-z]\\{2\\}\\(-[A-Z]\\{2\\}\\)?\\)\\'" content)
	  (let ((language (match-string-no-properties 1 content)))
	    (when (= (length language) 5)
	      (aset language 2 ?_))
	    (html2texi-set-doc-info 'language language))))))
     ((and (consp http-equiv)
	   (consp content)
	   (progn (setq http-equiv (cdr http-equiv))
		  (stringp http-equiv))
	   (progn (setq content (cdr content))
		  (stringp content)))
      (setq http-equiv (downcase http-equiv))
      (cond
       ((and (string= http-equiv "content-type")
	     (string-match "charset\\s-*=\\s-*\\([-a-z0-9]+\\)" content))
	(html2texi-set-doc-info 'content-type-charset (match-string-no-properties 1 content)));
       )))))

(defun html2texi-tag-handler-pre (xml-expr)
  (let ((kes html2texi-keep-empty-strings))
    (setq html2texi-keep-empty-strings t)
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-keep-empty-strings kes)))

(defun hmtl2texi-to-plain-text (xml-expr &rest flags)
  (let (ret anchor)
    (dolist (xml-expr (cddr xml-expr))
      (cond
       ((stringp xml-expr)
	(push xml-expr ret))
       ((consp xml-expr)
	(push xml-expr html2texi-xml-stack)
	(cond
	 ((and (eq (car xml-expr) 'a)
	       (setq anchor (assq 'name (nth 1 xml-expr))))
	  (push (html2texi-make-anchor (concat "#" (cdr anchor)))
		html2texi-flushable-anchors) ))
	(let ((str  (hmtl2texi-to-plain-text xml-expr)))
	  (and (null (string= str ""))
	       (push str ret)))
	(pop html2texi-xml-stack))
       (t (html2texi-fatal-error "Expression XML inattendue." xml-expr))))
    (setq  ret (mapconcat 'identity (nreverse ret) " "))
    (if (memq :one-line flags)
	(mapconcat 'identity (split-string ret "\n") " ")
      ret)))


(defun html2texi-tag-handler-title (xml-expr)
  (unless (and  (nth 1 html2texi-xml-stack)
		(eq  (caadr html2texi-xml-stack) 'head))
    (html2texi-fatal-error "<title> inattendu." xml-expr))
  (setq xml-expr (cddr xml-expr))
  (let ((str  (hmtl2texi-to-plain-text xml-expr)))
    (setq str (split-string str "\n")
	  str (mapconcat 'identity str " "))
    (unless (string= str "")
      (html2texi-set-doc-info 'title str))))

(defun html2texi-string-escape (str &optional flatten)
  (cond
   ((stringp str)
    (with-temp-buffer
      (insert str)
      (goto-char (point-min))
      (while (re-search-forward "[,@{}]" nil t)
	(cond
	 ((string= (match-string-no-properties 0) ",")
	  (replace-match "@comma{}"))
	 ((member (match-string-no-properties 0) '("@" "{" "}"))
	  (replace-match (concat "@" (match-string-no-properties 0))))))
      (when flatten
	(goto-char (point-min))
	(while (re-search-forward "\n\\(\\s-*\\)" nil t)
	  (replace-match (if (> 0 (length (match-string 1))) " " "") t t)))
      (buffer-substring (point-min) (point-max))))
   ((and (consp str) (car-safe str))
    (cond
     ((eq (car str) 'span)
      (with-temp-buffer
	(insert "@c span: (<span #1>#2</span> => string-escape of #2.")
	(html2texi-default-handling str "span: ")
	(insert (html2texi-string-escape  (nth 2 str) flatten))
	(insert "@c span: )\n")
	(buffer-substring (point-min) (point-max))))
     (t (html2texi-fatal-error "Une chaîne était attendue" str))))
   (t  (html2texi-fatal-error "Une chaîne était attendue" str))))

(defun html2texi-tag-handler-img (xml-expr)
  (let (filename width height alttext extension)
    (dolist (x (cadr xml-expr))
      (cond
       ((eq (car x) 'src)
	(setq filename (cdr x)))
       ((eq (car x) 'alt)
	(setq alttext (cdr x)))))
    (unless filename
      (html2texi-fatal-error "src=... était attendu" xml-expr))
    (setq filename (html2texi-decode-url filename))
    (setq extension (file-name-extension filename)
	  filename (file-name-sans-extension filename))
    (when (member extension '("png" "jpg" "jpeg" "eps" "txt"))
      (setq extension nil))
    (insert "@image{" (html2texi-make-anchor filename (symbol-function 'identity)))
    (let ((remainder (list width height alttext extension)))
	(while remainder
	  (if (let (non-empty)
		(mapc (lambda (x) (setq non-empty (or non-empty (stringp x))))
		      remainder)
		non-empty)
	      (insert "," (or (pop remainder) "") )
	    (setq remainder nil); rompt la boucle (while remainder...)
	    ))
	(insert "}"))))

(defun html2texi-set-doc-info (tag val)
  "Configure pour l'étiquette TAG la valeur VAL concernant les
informations globales au documents. Ces informations concernent
notamment la langue et l'encodage du document."
  (let ((info (assq tag html2texi-document-information)))
    (if info
	(setcdr info val)
      (push (cons tag val) html2texi-document-information))))

(defun html2texi-tag-handler-head (xml-expr)
  (unless html2texi-ignore-head
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-ignore-head t)))

(defun html2texi-tag-handler-noframes (xml-expr)
  )

(if (boundp 'html2texi-handler-hash-table)
    (makunbound 'html2texi-handler-hash-table))

(defconst html2texi-handler-hash-table
  (let ((ht (make-hash-table)))
    (dolist (v '(a b body center code dfn dl dt dd em i kbd li p hr div ol ul pre
    head meta title frameset frame noframes span strong table th tr td h1 h2
    h3 h4 h5 h5 html link br img samp style sup sub tt))
      (puthash v (symbol-function (intern (concat "html2texi-tag-handler-" (symbol-name v))))
	       ht))
    ht)
  "Table de hashage des traitement associé à chaque balise HTML"
  )

(defun html2texi-remove-empty-strings (xml-expr)
  (setq xml-expr (cdr xml-expr))
  (save-match-data
  (while (cdr xml-expr)
    (if (and (stringp (cadr xml-expr))
	     (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'" (cadr xml-expr)))
	(setcdr xml-expr (cddr xml-expr))
      (setq xml-expr (cdr xml-expr))))))

(defun html2texi-process-xml-expr (xml-expr)
  (push xml-expr html2texi-xml-stack)
  (dolist (xml-expr (cddr xml-expr))
    (cond
     ((consp xml-expr)
      (push xml-expr html2texi-xml-stack)
      (let ((handler (gethash (intern (downcase (symbol-name (car xml-expr))))
			      html2texi-handler-hash-table)))
	(if handler
	    (funcall handler  xml-expr)
	  (html2texi-default-handling xml-expr)))
      (pop html2texi-xml-stack))
     ((stringp xml-expr)
      (and (or html2texi-keep-empty-strings
	       (null (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'"  xml-expr)))
	   (insert (html2texi-handle-string xml-expr))))
     (t (error "Expression XML inattendue %S" xml-expr))))
  (pop html2texi-xml-stack))

(defun html2texi-default-handling (xml-expr &optional prompt)
  (let ((str (split-string (prin1-to-string xml-expr) "\n")))
    (dolist (str-line str)
      (insert "\n@c " (or prompt "") str-line)))
    (insert "\n"))

(defun html2texi-process-region (beg end)
  (goto-char end)
  (let ((end (point-marker))
	is-xhtml
	re-do
	xml-expr)

    ;; Suppression de tout ce qui est en dehors des balise <html> ... </html>
    (goto-char beg)
    (setq html2texi-line-delta (line-number-at-pos))
    (setq is-xhtml
	  (looking-at "[ \t\n\r]*<!DOCTYPE[ \t\n\r]+html[ \t\n\r]+PUBLIC[ \t\n\r]+\"-//W3C//DTD XHTML"))
    (unless (re-search-forward "<html" end t)
      (html2texi-fatal-error "Balise <html> non trouvée" xml-expr))
    (setq html2texi-line-delta (- (line-number-at-pos) (* 2 html2texi-line-delta)))
    (delete-region beg (match-beginning 0))
    (unless (re-search-forward ">" end t)
      (html2texi-fatal-error "Clôture de la balise <html> trouvée" xml-expr))
    (unless  (re-search-forward "</html" end t)
      (html2texi-fatal-error "Balise </html> non trouvée trouvée" xml-expr))
    (unless (re-search-forward ">" end t)
      (html2texi-fatal-error "Clôture de la balise </html> trouvée" xml-expr))
    (delete-region (match-end 0) end)

    (or is-xhtml
	(html2texi-make-html-clean-xml beg end))

    (setq xml-expr
	  (condition-case
	      sig
	      (xml-parse-region beg end)
	    (error
	     (if (consp sig)
		 (html2texi-warning "File is XHTML but xml-parser reported error `%S'" 
				 :html2texi-generic-error
				 (cdr sig))
	       (html2texi-warning "File is XHTML but xml-parser reported errors" 
				  :html2texi-generic-error))
		  (if is-xhtml :html2texi-redo nil)))
	  xml-expr
	  (if (eq xml-expr :html2texi-redo)
	       (progn
		 (html2texi-make-html-clean-xml beg end)
		 (xml-parse-region beg end))
	     xml-expr))
  
    (delete-region beg end)
    (set-marker end nil)
    xml-expr))

(if t
;; plus partique pour déboguer qu'un vrai tampon temporaire
    (defmacro html2texi-with-temp-buffer (&rest body)
      (let ((cur-buff (make-symbol "cur-buff")))
	`(with-current-buffer
	       (let (( ,cur-buff (get-buffer "*HTML2TEXI Temp*")))
		 (and ,cur-buff (kill-buffer ,cur-buff))
		 (get-buffer-create "*HTML2TEXI Temp*"))
       (erase-buffer)
       ,@body)))
  ;;
  (defmacro html2texi-with-temp-buffer (&rest body)
    `(with-temp-buffer ,@body)))



(defun html2texi-make-texi-buffer (&optional buffer )
  (let* ((start-buffer (or buffer (current-buffer)))
	 xml-expr
	 (start-filename  (or (buffer-file-name start-buffer) (buffer-name)))
	 (start-filename-ext (file-name-extension start-filename))
	 (texi-buffer-name
	  (concat (concat  (file-name-sans-extension   (file-name-nondirectory start-filename))
			    ".texi")))
	 done-links-list
	 texi-buffer
	 html2texi-keep-empty-strings
	 html2texi-xml-parsed
	 html2texi-xml-stack
	 (html2texi-line-delta 0)
	 html2texi-ignore-head
	 html2texi-directory-stack
	 html2texi-flushable-anchors
	 html2texi-directory-ref
	 html2texi-files-doing-or-done
	 html2texi-files-to-do
	 html2texi-log-buffer)
    (unless (or (member start-filename-ext '("html" "htm"))
		(y-or-n-p (format "le tampon %s n'a pas une extension html, continuer?"
				  start-filename)))
      (error "Fichier sans extension html"))
    (setq texi-buffer (get-buffer-create texi-buffer-name))
    (set-buffer texi-buffer)
    (erase-buffer)
    (dolist (v html2texi-texi-buffer-local-variables)
      (set (make-local-variable v) nil))
    (insert (with-current-buffer start-buffer
	      (save-restriction
		(widen)
		(buffer-substring (point-min) (point-max)))))
    (accents-de-html)
    (push (cons default-directory "./") html2texi-directory-stack)
    (push start-filename html2texi-files-doing-or-done)
    (setq html2texi-directory-ref default-directory)

    (setq xml-expr (html2texi-process-region (point-min) (point-max)))
    (unless (eq 'html (caar xml-expr))
      (error "Résultat d'analyse XML inattendu"))
    (setq xml-expr `(html2texi-dummy-markup nil ,(car xml-expr)))
    (html2texi-process-xml-expr xml-expr)
    (while html2texi-files-to-do
      (setq file-name (pop html2texi-files-to-do))
      (if (file-exists-p file-name)
	  (progn
	    (push file-name html2texi-files-doing-or-done)
	    (let* ((dir (file-name-as-directory
			 (file-name-directory file-name)))
		   (rel-dir   (let ((d
				     (file-name-directory
				      (file-relative-name file-name html2texi-directory-ref))))
				(if d (file-name-as-directory d)
				  "./"))))
	      (push (cons dir rel-dir) html2texi-directory-stack)
	      (html2texi-with-temp-buffer
	       (insert-file-contents file-name)
	       (accents-de-html)
	       (html2texi-make-html-clean-xml (point-min) (point-max))
	       (setq xml-expr (html2texi-process-region (point-min) (point-max))))
	      (unless (eq 'html (caar xml-expr))
		(error "Résultat d'analyse XML inattendu"))
	      (setq xml-expr (car xml-expr))
	      (html2texi-process-xml-expr xml-expr)
	      (pop html2texi-directory-stack)	))
	(warn "Le fichier `%s' n'existe pas!" file-name)))))

(defun html2texi-insert-doc-info ()
  (let ((author
	 (html2texi-string-escape
	  (or (cdr-safe (assq 'author html2texi-document-information)) "AUTHOR")))
	(title 	 (html2texi-string-escape
		  (or (cdr-safe (assq 'title html2texi-document-information)) "TITLE")))
	(language 	 (let ((language  (cdr-safe (assq 'language html2texi-document-information))))
			   (if language (cons "" (html2texi-string-escape language))
			     (cons "@c " "LANGUAGE"))))
	(encoding  (html2texi-string-escape
			  (or (cdr-safe (assq 'content-type-charset html2texi-document-information))
			      "iso-8859-1"))))

    (goto-char (point-min))
    (insert "\\input texinfo   @c -*-mode:texinfo; coding:" (downcase encoding) "-*-
@setfilename " (file-name-sans-extension (buffer-name)) ".info
" (car language) "@documentlanguage " (cdr language) "
@documentencoding "  (if (let ((case-fold-search t))
			   (string-match "\\`\\(us\\|utf\\|iso\\)" encoding))
			 (upcase encoding) encoding) "
@copying
This manual is for PROGRAM, version VERSION.

Copyright @copyright{} YEARS COPYRIGHT-OWNER.

@quotation
Permission is granted to ...
@end quotation
@end copying

@titlepage
@title " title "@c NAME-OF-MANUAL-WHEN-PRINTED
@c @subtitle SUBTITLE-IF-ANY
@c @subtitle SECOND-SUBTITLE
@author " author "

@c  The following two commands
@c  start the copyright page.
@page
@vskip 0pt plus 1filll
@insertcopying

Published by ...
@end titlepage

@c So the toc is printed at the start.
@contents

@ifnottex
@node Top
@top TITLE

This manual is for PROGRAM, version VERSION.
@end ifnottex
")
    (goto-char (point-max))
    (insert "
@bye") ))

(defun html2texi-post-process ()
  "Remplace les double lignes vides en ligne vides simples."
  (goto-char (point-min))
  (while (re-search-forward "\\(^[ \t]*\n\\)\\{2,\\}" nil t)
    (replace-match "\n"))
  (normal-mode))

;;;###autoload
(defun html2texi ()
  (interactive)
  (html2texi-make-texi-buffer)
  (html2texi-insert-doc-info)
  (html2texi-post-process))

;; Log compilation mode stuff
(defun html2texi-define-error-regexps ()
  (dolist (v `(
	       (html-to-texinfo-error
		. 
		(
		 ,(concat "^" (regexp-opt (list (aref html2texi-log-error-names 0)
						(aref html2texi-log-error-names 1)))
			  ":\\(" html2texi-filepath-re 
			  "\\):\\(?:\\([0-9]+\\):\\)?.*$")
		 1; File
		 2; Line
		 0; Error
		 ))
	       (html-to-texinfo-warning
		. 
		(
		 ,(concat "^" (aref html2texi-log-error-names 2)
			  ":\\(" html2texi-filepath-re 
			  "\\):\\(?:\\([0-9]+\\):\\)?.*$")
		 1; File
		 2; Line
		 1; Warning
		 ))
	       (html-to-texinfo-info
		. 
		(
		 ,(concat "^" (aref html2texi-log-error-names 3)
			  ":")
		 nil; File
		 nil; Line
		 2; Warning
		 ))))
    (add-to-list 'compilation-error-regexp-alist (car v))
    (let ((cell (or (assq (car v) compilation-error-regexp-alist-alist)
		    (car (push (cons  (car v) nil) compilation-error-regexp-alist-alist)))))
      (setcdr cell (cdr v))  )))
(html2texi-define-error-regexps)

;;; html-to-texinfo.el ends here

Revision-number: 19
Prop-content-length: 434
Content-length: 434

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2012-02-08T19:27:47.000000Z
K 7
svn:log
V 331
- Gestion de la liste des fichiers traités et à traiter par la classe `html2texi-files-to-do-listing'.
- Gestion des erreurs avec génération du nom de fichier courant et du numéro de ligne en interne des fonction `html2texi-fatal-error', `html2texi-error', `html2texi-warning'.
- Nouvelle fonction `html2texi-info'.

PROPS-END

Node-path: trunk/lisp/html-to-texinfo.el
Node-kind: file
Node-action: change
Text-content-length: 56206
Text-content-md5: 21bbe2336d7f8571c202dd2fc235c976
Content-length: 56206

;;; html-to-texinfo.el --- -*- coding: iso-8859-1 -*-
;; Copyright 2010/2012 Vincent Belaïche
;;
;; Author: Vincent Belaïche <vincent.b.1@hotmail.fr>
;; Version: $Id: html-to-texinfo.el,v 1.10 2012-02-08 19:27:47 Vincent Exp $
;; Keywords:
;; X-URL: not distributed yet
;;
;; This software is governed by the CeCILL license under French law and
;; abiding by the rules of distribution of free software.  You can  use,
;; modify and/ or redistribute the software under the terms of the CeCILL
;; license as circulated by CEA, CNRS and INRIA at the following URL
;; "http://www.cecill.info".
;;
;; As a counterpart to the access to the source code and  rights to copy,
;; modify and redistribute granted by the license, users are provided only
;; with a limited warranty  and the software's author,  the holder of the
;; economic rights,  and the successive licensors  have only  limited
;; liability.
;;
;; In this respect, the user's attention is drawn to the risks associated
;; with loading,  using,  modifying and/or developing or reproducing the
;; software by the user in light of its specific status of free software,
;; that may mean  that it is complicated to manipulate,  and  that  also
;; therefore means  that it is reserved for developers  and  experienced
;; professionals having in-depth computer knowledge. Users are therefore
;; encouraged to load and test the software's suitability as regards their
;; requirements in conditions enabling the security of their systems and/or
;; data to be ensured and,  more generally, to use and operate it in the
;; same conditions as regards security.
;;
;; The fact that you are presently reading this means that you have had
;; knowledge of the CeCILL license and that you accept its terms.
;;
;;; Commentary:

;;

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'html-to-texinfo)

;;; Code:

(provide 'html-to-texinfo)
(eval-when-compile
  (require 'cl))
(require 'eieio)
(require 'calc-ext)
(require 'accents-ascii)
(require 'compile)

;;;;##########################################################################
;;;;  User Options, Variables
;;;;##########################################################################

(defconst html2texi-suspicious-html-tags
  '("meta" "br" "hr" "link" "img" "frame")
"Liste des balises pour lesquelles le HTML ne suit pas une
syntaxe strictement XML. Par exemple `<br>' est utilisé au lieu
de `<br/>'."  )

(defconst html2texi-suspicious-html-tags-re
  (regexp-opt html2texi-suspicious-html-tags))

(defconst html2texi-non-recursive-tags
  '("p" "li"))

(defconst html2texi-hierarchy-list
  '(
    (li (ul ol))
    (tr (table))
    (th (tr))
    (td (tr))
    (dd (dl))
    (dt (dl))  )
  )

(defconst html2texi-non-recursive-tags-re
  (regexp-opt html2texi-non-recursive-tags))

(defconst html2texi-filepath-re
  "\\(?:[A-Za-z]:\\)?[- ~+A-Za-z_0-9./\\]+")

(defconst html2texi-texi-buffer-local-variables
  '(html2texi-document-information)
    "Liste des variables déclarées localement au tampon Texinfo.")

(defconst html2texi-allowed-markup-in-@center
  '(img b i em tt strong dfn code)
  "Liste des balises autorisées pour @center.")

(defconst html2texi-@center-max-size 1000)

(defclass html2texi-simple-markup ()
  ((class-dependant
    :initarg :class-dependant
    :initform nil
    :custom '(repeat
	  (list
	   (regexp :tag "clef")
	   (string :tag "prologue")
	   (string :tag "épilogue")
	   (boolean :tag "conserver les espaces et retours chariot")
	   ))
    :documentation "\
Liste d'association dont les éléments sont de la forme
 (CLEF PROLOGUE ÉPILOGUE)

Supposons que l'objet décrit le traitement de la balise TAG,
alors lorsque le code HTML `<TAG class=\"CLEF\">CONTENU</TAG>'
est rencontré, alors il est convertie en le code Texinfo
`PROLOGUE TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU.")
   (preamble
    :initarg :preamble
    :type string
    :documentation "\
Prologue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (postamble
    :initarg :postamble
    :type string
    :documentation "\
Épilogue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (space-verb
    :initarg :space-verb
    :initform nil
    :type boolean
    :documentation "\
Vrai lorsque les espaces et retours chariot sont à conserver tels quels."
    ))
  :documentation "\
Un object de type `html2texi-simple-markup'
décrit le traitement d'une balise simple comme par exemple
<code>.")

(defclass html2texi-files-to-do-listing ()
  ((already-to-do
   :initarg :already-to-do
   :initform nil
   :documentation "Liste des fichiers qui ont été trouvés comme
   étant à traiter lors du traitement d'un fichier qui a déjà été
   complètement traité.")
   (doing-or-done
    :initarg :doing-or-done
    :initform nil
    :documentation "Liste des fichier qui ont déjà été traité, le
    premier de la liste est le fichier en cours de traitement."
    )
   (soon-to-do
   :initarg :soon-to-do
   :initform nil
   :documentation "Liste des fichiers qui sont trouvés comme
   étant à traiter lors du traitement du fichier en cours de
   traitement."))
  :documentation "Objet servant à lister les fichiers à
  traiter. Il comprend deux listes: `already-to-do' et
  `soon-to-do' parce que lors du traitement d'un fichier TOTO les
  nouveaux fichiers à traiter sont mis dans `soon-to-do' dans
  l'ordre où ils sont rencontrés, du coup une fois que le fichier
  TOTO a complètement été traité, on inverse cet ordre en
  transvasant le contenu de `soon-to-do' dans `already-to-do'.")

(defmethod html2texi-files-has-to-do ((this html2texi-files-to-do-listing))
  (or (oref this :already-to-do)
      (oref this :soon-to-do))  )

(defmethod html2texi-current-file ((this html2texi-files-to-do-listing))
  (car (oref this :doing-or-done)))

(defmethod html2texi-get-next-file-next-to-do  ((this html2texi-files-to-do-listing))
  "Récupère le prochain fichier à traiter. L'appel de cette
méthode si aucun fichier n'est à traiter génère une erreur."
  (let ((soon-to-do (oref this :soon-to-do))
	(already-to-do (oref this :already-to-do)))
    (when soon-to-do
      (while soon-to-do (push (pop soon-to-do) already-to-do))
      (oset this :soon-to-do nil))
    (let ((next (pop already-to-do)))
      (oset this :already-to-do already-to-do)
      (oset this :doing-or-done (cons next (oref this :doing-or-done)))
      next)))

(defmethod html2texi-add-file-to-do   ((this html2texi-files-to-do-listing) next)
  (unless (or (member next (oref this :already-to-do))
	      (member next (oref this :doing-or-done))
	      (member next (oref this :soon-to-do)))
    (oset this :soon-to-do (cons next (oref this :soon-to-do)))))

(defun html2texi-texinfo-inside-comment-p ()
  "Renvoie non nil lorsque le point est dans un commentaire Texinfo."
  (save-match-data
    (save-excursion
      (let ((cur (point))
	    (end (progn (end-of-line) (point))))
	(beginning-of-line)
	(and (re-search-forward "\\(^\\|[^@]\\)@c\\(omment\\)\\_>" end t)
	     (<= (match-beginning 0) cur))))))

(defmethod html2texi-handle-simple-markup
  ((this html2texi-simple-markup) xml-expr)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe
			(and class-attribute
			     (assoc-string (cdr class-attribute)
					   (oref this :class-dependant))))
		      (list (oref this :preamble)
			    (oref this :postamble)))))
    (insert (car pre-post))
    (let ((beg (point))
	  end)
      (html2texi-process-xml-expr xml-expr)
      (unless (oref this :space-verb)
	(setq end (point-marker))
	(goto-char beg)
	(while (re-search-forward "[\n\r]\\s-*" nil end)
	  (let ((replace-str " "))
	    (save-match-data
	      (cond
	       ((html2texi-texinfo-inside-comment-p)
		(setq replace-str nil))))
	      (and replace-str (replace-match replace-str t t)))))
	(goto-char end)
	(set-marker end nil))
    (insert (cadr pre-post))))


(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-url-encoding
  :html2texi-utf-8
  "Sélectionne le codage des URL."
  :type '(choice 
	  (symbol :tag "UTF-8" :html2texi-utf-8)
	  (symbol :tag "ISO-8859-1" :html2texi-latin-1))
  :group 'html2texi)

(defcustom html2texi-i-simple-markup
  (html2texi-simple-markup "html2texi-i-simple-markup"
   :preamble "@i{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-b-simple-markup
  (html2texi-simple-markup "html2texi-b-simple-markup"
   :preamble "@b{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-kbd-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :preamble "@kbd{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-dfn-simple-markup
  (html2texi-simple-markup "html2texi-dfn-simple-markup"
   :preamble "@dfn{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-em-simple-markup
  (html2texi-simple-markup "html2texi-em-simple-markup"
   :preamble "@emph{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-sub-simple-markup
  (html2texi-simple-markup "html2texi-sub-simple-markup"
   :preamble ""
   :postamble "")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<sub class=\"CLEF\">CONTENU</sub>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-sup-simple-markup
  (html2texi-simple-markup "html2texi-sup-simple-markup"
   :preamble ""
   :postamble "")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<sup class=\"CLEF\">CONTENU</sup>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-samp-simple-markup
  (html2texi-simple-markup "html2texi-samp-simple-markup"
   :preamble "@samp{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<samp class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-strong-simple-markup
  (html2texi-simple-markup "html2texi-strong-simple-markup"
   :preamble "@strong{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-tt-simple-markup
  (html2texi-simple-markup "html2texi-tt-simple-markup"
   :preamble "@t{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<tt class=\"CLEF\">CONTENU</tt>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-handle-two-columns-table-as-@table
  t
 "Si `nil' alors une table `<table>...</table>'
avec deux colonne sera gérée en texinfo par une `@table', si non
`nil', alors elle sera gérée par une `@multitable'."
  :type
  '(choice
    (const :tag "t pour @table" t)
    (const :tag "nil pour @multitable" nil))
  :group 'html2texi)

(defcustom html2texi-log-error-names
   ["Erreur fatale" "Erreur" "Avertissement" "Info"]
   "Liste des types d'erreur préfixant les messages d'erreur dans
le tampon de sortie des erreurs & avertissement de traitement."
   :type
   '(vector
     (string :tag "Erreur fatale")
     (string :tag "Erreur")
     (string :tag "Avertissement")
     (string :tag "Info"))
   :group 'html2texi  )

(defcustom html2texi-log-buffer-name
  "*HTML2TEXI*"
  "Nom du tampon de sortie des erreurs et avertissements de traitement."
  :type 'string
  :group 'html2texi)


(defvar html2texi-document-information nil
  "Liste d'association pour mémoriser les informations (titre,
  auteurs, etc...) propres à un document.")

(defvar html2texi-line-delta 0
  "Décalage entre le numéro de ligne du code XML au sein le
  tampon Texinfo en cours de traitement, et son numéro de ligne
  dans le fichier HTML source.")


(defvar html2texi-xml-parsed nil
  "Résultat de l'analyse syntaxique d'un doc")

(defvar html2texi-xml-stack nil
  "Pile des expressions XML")

(defvar html2texi-keep-empty-strings nil
  "Non nil si les chaînes vides sont à conserver.")

(defvar html2texi-ignore-head nil
  "Non nil si on ignore le <head> (dans un fichier HTML lié).")

(defvar html2texi-directory-stack nil
  "Pile des chemins de répertoire.")

(defvar html2texi-files-to-do nil
  "Base des fichiers non encore traités, instanciée localement
  comme un objet de class `html2texi-files-to-do-listing'.")

(defvar html2texi-flushable-anchors nil
  "Liste de nom d'ancrage de lien dont l'insertion a été remise à
  plus tard." )

(defvar html2texi-postpone-output nil
  "Non `nil' lorsque l'insertion du code est remise à plus tard.")


(defvar html2texi-directory-ref nil
  "Répertoire de référence")

(defvar html2texi-log-buffer nil
  "Tampon de sortie des erreurs et avertissements de traitement.")

(defmacro html2texi-make-simple-markup-handler (tag)
  `(defun ,(intern (concat "html2texi-tag-handler-" (symbol-name tag)))
     (xml-expr)
     (html2texi-handle-simple-markup
      ,(intern (concat "html2texi-"  (symbol-name tag) "-simple-markup"))
      xml-expr) ))

(defun html2texi-make-html-clean-xml (beg end)
  (let  ((end-arg end)
	 end)
    ;; initialisation de end comme un marque
    (if (markerp end-arg)
	(setq end end-arg)
      (goto-char end-arg)
      (setq end (point-marker)))

    ;; rend les balise implicitement auto-closante vraiment auto-closante
    (goto-char beg)
    (while (re-search-forward (concat "<\\(" html2texi-suspicious-html-tags-re "\\)\\>")
			      end t)
      (let ((tag (match-string-no-properties 1)))
	(unless (re-search-forward ">" nil t)
	  (html2texi-fatal-error "Clôture non trouvé pour la balise %s" nil
				 tag))
	(when (null (looking-back "/>"))
	  (backward-char)
	  (insert "/")
	  (forward-char))))

    ;; marque de paragraphe et de ligne
    (goto-char beg)
    (let (tag-stack pos-< pos->
		    tag is-closure self-closing)
      (while (re-search-forward "<\\(/\\)?\\([a-zA-Z]+\\)\\>" end t)
	(setq pos-< (match-beginning 0)
	      tag (match-string-no-properties 2)
	      is-closure (match-string-no-properties 1))
	(unless (string= tag (downcase tag))
	  (replace-match (setq tag (downcase tag)) 2))
	(unless (re-search-forward ">" end t)
	  (html2texi-fatal-error "Soufflet de clôture non trouvé pour la balise %s" nil
		 tag))
	
	(setq pos-> (point)
	      self-closing (looking-back "/>"))
	(cond
	 ((and self-closing  is-closure)
	  (html2texi-fatal-error "balise %s à la fois de clôture et auto-closante" nil
		 tag))

	 (self-closing
	  ;; do nothing
	  )

	 ((null is-closure)
	  (when (and
		 (string-match (concat "\\`" html2texi-non-recursive-tags-re "\\'") tag)
		 tag-stack
		 (string= tag (caar tag-stack)))
	    ;; clôture
	    (save-excursion
	      (goto-char pos-<)
	      (insert "</" tag "><!-- HTML2TEXI: repaired (1) -->")
	      (html2texi-warning "Ajout clôture `</%s>'" nil tag))
	    (pop tag-stack))
	  (push (list tag) tag-stack))

	 (is-closure
	  (if (and tag-stack
		   (string= (caar tag-stack) tag))
	      (pop tag-stack)
	    (let ((first (assoc-string tag tag-stack)) rev)
	      (if first
		  (progn
		    (while (and tag-stack (null (eq (car tag-stack) first)))
		      (push (pop tag-stack) rev))
		    (pop tag-stack)
		    (save-excursion
		      (goto-char pos-<)
		      (dolist (c rev)
			(insert  "</" (car c) "><!-- HTML2TEXI: repaired (2) -->" )
			(html2texi-warning "Ajout clôture `</%s>'" nil tag))))
		
		(save-excursion
		  (goto-char pos->)
		  (insert "-->")
		  (goto-char pos-<)
		  (insert "<!-- HTML2TEXI: repaired (3). "))
		(html2texi-warning "Clôture de %s ne correspondant à aucune ouverture" nil tag)))))))


      (let (p-pos li-pos markup poss pos)
	(while (re-search-forward "<\\(/\\)?\\(p\\|li\\)\\>[^>]*>" end t)
	  (setq markup (match-string-no-properties 2)
		poss (intern (concat markup "-pos"))
		pos (symbol-value poss))
	  (if (match-string-no-properties 1)
	      (if  pos
		  (if (= pos (match-beginning 0))
		      (set poss nil)
		    (html2texi-fatal-error "Clôture de balise %s ne correspondant à aucune ouverture" nil
					   (match-string-no-properties 0)))
		(save-excursion
		  (save-match-data
		    (unless  (re-search-forward
			      (format "<\\(/\\)?\\(%s\\)\\>[^>]+>" markup)
			      end t)
		      (html2texi-fatal-error "Ouverture de balise <%s> sans clôture" nil
					     markup))
		    (set poss (match-beginning 0))
		    (unless (match-string-no-properties 1)
		      (goto-char (match-beginning 0))
		      (insert (format "</%s>" markup))
		      (dolist (symb '(p-pos li-pos))
			(unless (or (null (symbol-value symb))
				    (eq symb poss))
			  (set symb (+ (length markup) 3 (symbol-value symb)))))))))))
	))

    ;; mise entre guillemets anglais des attributs entier sans guillemets
    (goto-char beg)
    (let (p1 p2 added-dquote-attributes p-start p-end)
      ;; tant qu'on trouve potentiellement un attribut sans "..."
      (while (re-search-forward "\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([-+]?[0-9]+\\)"
				nil end)
	(setq p1 (match-beginning 1)
	      p2 (match-end 0))
	(if
	    ;; si la position est bien entre < et >
	    (and (re-search-backward "[<>]" beg t)
		 (looking-at "<\\sw+")
		 (progn
		   (goto-char (setq p-start (match-end 0)))
		   (re-search-forward "[<>]" end t)
		   (string= (match-string-no-properties 0) ">"))
		 (>= (setq p-end (match-beginning 0)) p1))
	    ;; alors on fait la réparation
	    (progn
	      (goto-char p-start)
	      (while
		  (progn
		    (while (looking-at "\\(?:\\s-\\|\n\\)*\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\"[^\"]*\"")
		      (goto-char (match-end 0)))
		    (cond
		     ((looking-at  "\\(?:\\s-\\|\n\\)*\\(\\sw+\\)\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([-+]?[0-9]+\\)")
		      (push (match-string-no-properties 1) added-dquote-attributes)
		      (goto-char (match-beginning 2))
		      (insert ?\")
		      (goto-char (1+ (match-end 2)))
		      (insert ?\")
		      (setq p-end (+ 2 p-end)))
		     ((looking-at "\\(?:\\s-\\|\n\\)*>")
		      (goto-char (match-end 0))
		      (insert "<!-- HTML2TEXI inserted double quotes around values for attibutes: "
			      (mapconcat (lambda (x) (concat "`" x "'"))
					 added-dquote-attributes
					 ", ")
			      " -->")
		      nil)
		     (t (html2texi-error "Attribut au format invalide: %s."
			       (buffer-substring (point) p-end)))))))
	  ;; sinon on continue à chercher un attribut potentiel dont la valeur
	  ;; n'est pas entre "..."
	  (goto-char p2))))

    ;; un peu de ménage...
    (unless (markerp end-arg)
      (set-marker end nil)) ))

;;;==========================================================================
;;; définition des gestionnaires de balise
;;;--------------------------------------------------------------------------

(defun html2texi-tag-handler-a (xml-expr)
  (let (name href text (xml-expr-length (length xml-expr)))
    (dolist (attrib (cadr xml-expr))
      (cond
       ((eq (car attrib) 'href)
	(setq href (cdr attrib)))
       ((eq (car attrib) 'name)
	(setq name (cdr attrib)))))
    (and (cddr xml-expr)
	 (setq text (caddr xml-expr)))
    (cond
     (href (html2texi-process-url href text))
     ((= xml-expr-length 3)
      (cond
       ((stringp text)
	(insert (html2texi-string-escape text t)))
       ((consp text) (html2texi-process-xml-expr text))
       (t (error "Le format du text de la balise <a> était inattendu"))))
     ((> xml-expr-length 3)
      (html2texi-process-xml-expr `(div nil ,@(cddr xml-expr)))))
    (and name
      (insert "\n@anchor{" (html2texi-make-anchor (concat "#" name)) "}\n"))))

(html2texi-make-simple-markup-handler b)

(defun html2texi-flush-anchors ()
  (while html2texi-flushable-anchors
    (insert "@anchor{" (pop html2texi-flushable-anchors) "}\n")))


(defun html2texi-tag-handler-h1 (xml-expr)
  (insert "@chapter " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))


(defun html2texi-tag-handler-h2 (xml-expr)
  (insert "@section " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))

(defun html2texi-tag-handler-h3 (xml-expr)
  (insert "@subsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
    (html2texi-flush-anchors))

(defun html2texi-tag-handler-h4 (xml-expr)
  (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))

(defun html2texi-tag-handler-h5 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
     (html2texi-flush-anchors))

(defun html2texi-tag-handler-h6 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
   (html2texi-flush-anchors))

(html2texi-make-simple-markup-handler samp)


(defun html2texi-get-col-span (xml-expr)
  ;; xml-expr is <td> or <th>
  (let ((col-span (cdr-safe (assq 'colspan (nth 1 xml-expr)))))
    (setq col-span
	  (cond
	   ((integerp
	       (setq col-span
		     (if (stringp col-span)
			 (string-to-number col-span)
		       col-span)))
	      col-span)
	   ((null col-span) 1)
	   (t (error "colspan invalide"))))  ))

(html2texi-make-simple-markup-handler sub)
(html2texi-make-simple-markup-handler sup)

(html2texi-make-simple-markup-handler tt)

(defvar html2texi-col-number nil)
(defvar html2texi-row-number nil)
(defvar html2texi-head-on-row-0 nil)
(defvar html2texi-col-count nil)
(defvar html2texi-col-info-length nil)

(defun html2texi-tag-handler-table (xml-expr)
  (let* (html2texi-col-count
	(html2texi-row-number 0)
	html2texi-head-on-row-0
	html2texi-col-number
	;; le premier élément ne correspond pas à une colonne mais servira à
	;; reduire le vecteur des informations sur chaque colonne
	(html2texi-col-info (list 0))
	(html2texi-col-info-last html2texi-col-info)
	(html2texi-col-info-length 0)
	(xml-items (cddr xml-expr)))
    (while xml-items
      (let ((xml-expr (pop xml-items)))
	(cond
	 ((and (consp xml-expr)
	       (eq (car xml-expr) 'tr))
	  ;; plus besoin de chercher une ligne: on compte les colonnes sur la
	  ;; première ligne trouvée
	  (setq xml-items nil)
	  (dolist  (xml-expr (cddr xml-expr))
	    (cond
	     ((consp xml-expr)
	      (if (memq  (car xml-expr) '(th td))
		  (progn
		    (setq html2texi-col-count
			  (+ (or html2texi-col-count 0) (html2texi-get-col-span xml-expr)))
		    (when (> html2texi-col-count html2texi-col-info-length)
		      (let ((l (make-list (- html2texi-col-count html2texi-col-info-length) '(abs 1))))
			(setcdr html2texi-col-info-last l)
			(setq html2texi-col-info-last (last l)
			      html2texi-col-info-length html2texi-col-count))))
		(error "balise inattendu dans une table")))
	     ((stringp xml-expr)
	      (unless (string-match
		       "\\`\\s-*\\(\n\\s-*\\)*\\'"
		       xml-expr)
		(error "Chaîne inattendue")))
	     (t (error "Élément inattendu")))))
	 ((stringp xml-expr)
	  (unless (string-match
		   "\\`\\s-*\\(\n\\s-*\\)*\\'"
		   xml-expr)
	    (error "Chaîne inattendue")))
	 (t (error "Élément inattendu")))))



    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(progn
	  (insert "@multitable @columnfractions ")
	  (let ((total-weight
		  (math-reduce-vec
		   (lambda (r x)
		     (+ r
			(cond
			 ((eq (car x) 'abs) (cadr x))
			 ((eq (car x) 'rel)
			  (setcar x 'abs)
			  (setcar (cdr x) (*  (cadr x) html2texi-col-info-length))
			  (cadr x)))))
		   (cons 'vec html2texi-col-info))))
		(insert (mapconcat
			 (lambda (x)
			   (number-to-string
			    (/ (float (cadr x)) html2texi-col-info-length)))
			 (cdr html2texi-col-info)
			 " ")))
	  (insert "\n"))
      (insert "@table\n"))

    (html2texi-process-xml-expr xml-expr)

    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(insert "@end multitable\n")
      (insert "@end table\n"))))


(defun html2texi-tag-handler-tr (xml-expr)
  (setq html2texi-col-number 0)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n")
  (setq html2texi-row-number (1+ html2texi-row-number)))

(defun html2texi-tag-handler-th (xml-expr)
  (if   (= 0 html2texi-col-number)
      (if (and (= 0 html2texi-row-number)
	       (null html2texi-handle-two-columns-table-as-@table))
	  (progn
	    (setq html2texi-head-on-row-0 t)
	    (insert "@headitem ")
	    (html2texi-process-xml-expr xml-expr))
	(insert "@item ")
	(html2texi-process-xml-expr xml-expr))
    (when (or (> html2texi-col-count 2)
	      (null html2texi-handle-two-columns-table-as-@table))
      (insert "@tab "))
    (html2texi-process-xml-expr xml-expr)
    (unless (and  (= 0 html2texi-row-number) html2texi-head-on-row-0)
	(insert "\n")))
  (setq html2texi-col-number (1+ html2texi-col-number)))

(defun html2texi-tag-handler-td (xml-expr)
  (if (= 0 html2texi-col-number)
	(insert "@item ")
    (if (or (> html2texi-col-count 2)
	    (null html2texi-handle-two-columns-table-as-@table))
      (insert "@tab ")))
  (html2texi-process-xml-expr xml-expr)
  (insert "\n")
  (setq html2texi-col-number (1+ html2texi-col-number)))


(defun html2texi-cur-dir ()
  "Détermine le répertoire courant relativement au répertoire du
HTML racine de départ. La valeur retournée se termine par une oblique `/'"
  (let ((cur-dir  (nreverse (split-string (cdar html2texi-directory-stack) "/")))
	(ref-dir  (nreverse (split-string html2texi-directory-ref "/"))))
    (unless (and (string= (car cur-dir) "")
		 (string= (car ref-dir) ""))
      (error "Format invalide de répertoire"))
    (setq cur-dir (nreverse (cdr cur-dir))
	  ref-dir (cdr ref-dir))
    (if (or (string= (car cur-dir) "")
	    (string-match "\\`[a-z]:" (car cur-dir)))
	;; cur-dir est un chemin absolu
	(progn
	  (setq ref-dir (nreverse ref-dir))
	  (while (and cur-dir ref-dir (string= (car cur-dir) (car ref-dir)))
	    (setq cur-dir (cdr cur-dir)
		  ref-dir (cdr ref-dir)))
	  (while ref-dir
	    (push ".." cur-dir)
	    (setq ref-dir (cdr ref-dir)))
	  (concat (mapconcat 'identity cur-dir "/") "/"))
      (while (and cur-dir
		  (cond
		   ((string= (car cur-dir) "..")
		    (unless ref-dir
		      (error "Chemin invalide"))
		    (setq ref-dir (cdr ref-dir)
			  cur-dir (cdr cur-dir)))
		   ((string= (car cur-dir) ".")
		    (setq cur-dir (cdr cur-dir)))
		   (t nil))))
      (dolist (e cur-dir)
	(push e ref-dir))
      (mapconcat 'identity  (nreverse (cons "" ref-dir)) "/") )))

(defun html2texi-anchor-escape (anchor)
  (let (ret)
    (setq anchor
	  (mapconcat
	   'identity
	   (split-string anchor "-") "--"))
    (mapc
     (lambda (x)
       (if
	(or (and (>= x ?a) (<= x ?z))
	     (and (>= x ?A) (<= x ?Z))
	     (and (>= x ?0) (<= x ?9))
	     (member x '(?_ ?- ?/)))
	   (push (string x) ret)
	 (push (format "-%04x" x) ret)))
     anchor)
    (apply 'concat (nreverse ret))))

(defun html2texi-make-anchor (name &optional escape-function)
  (let* ((anchor (expand-file-name (concat (html2texi-cur-dir) name)))
	 (l-a (length anchor))
	 (l-r (length html2texi-directory-ref))
	 (l (min l-a l-r))
	 (start 0)
	 (i -1))
    (while (and
	    (< (setq i (1+ i)) l)
	    (prog1
		(= (aref anchor i) (aref html2texi-directory-ref i))
	      (and (= (aref anchor i) ?/)
		   (setq start (1+ i))))))
    (setq anchor (list (substring anchor start)))
    (dotimes (i (length (split-string (substring html2texi-directory-ref start))))
      (push "../" anchor))
    (setq anchor (apply 'concat anchor))
    (html2texi-string-escape (funcall (or escape-function 'html2texi-anchor-escape) anchor))))

(defun html2texi-simple-markup-handle (xml-expr class-alist preamble postamble)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe
			(and class-attribute
			     (assoc-string (cdr class-attribute) class-alist)))
		      (list preamble postamble))))
    (insert (car pre-post))
   (html2texi-process-xml-expr xml-expr)
   (insert (cadr pre-post))))

(defun html2texi-tag-handler-body (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))


(html2texi-make-simple-markup-handler code)

(defun html2texi-tag-handler-br (xml-expr)
  (insert "@*\n"))

(defun html2texi-tag-handler-div (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(html2texi-make-simple-markup-handler dfn)

(defun html2texi-tag-handler-dl (xml-expr)
  (insert "@table @asis\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "@end table\n"))

(defun html2texi-tag-handler-dt (xml-expr)
  (insert "@item ")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(defun html2texi-tag-handler-dd (xml-expr)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(html2texi-make-simple-markup-handler em)

(defun html2texi-tag-handler-frameset (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-frame (xml-expr)
  (let (url text)
    (dolist (x (cadr xml-expr))
      (cond
       ((eq (car x) 'src)
	(setq url (cdr x)))
       ((eq (car x) 'name)
	(setq text (cdr x)))))
    (when url
      (html2texi-process-url url text))))

(defun html2texi-tag-handler-hr (xml-expr)
  (insert "@c <hr/>\n"))

(html2texi-make-simple-markup-handler kbd)

(defun html2texi-tag-handler-html (xml-expr)
  "\
Traitement de la balise html."
  (let* ((attributes (nth 1 xml-expr))
	 (lang (assq 'lang attributes)))
    (when lang
      	(html2texi-set-doc-info 'language (cdr lang))))
    (html2texi-process-xml-expr xml-expr))

(html2texi-make-simple-markup-handler strong)

(defun html2texi-handle-string (str)
  (let (ret (pos0 0) pos1 (len (length str)))
    (while (and
	    (< pos0 len)
	    (setq pos1 (string-match "[{}@]" str pos0)))
      (push (substring str pos0 pos1) ret)
      (push (concat "@" (match-string-no-properties 0 str)) ret)
      (setq pos0 (1+ pos1)))
    (when (< pos0 len)
      (push (substring str pos0 pos1) ret))
    (apply 'concat (nreverse ret))))

(defun html2texi-generate-log-buffer ()
  (let* ((compilation-error-regexp-alist
	 '(html-to-texinfo-error
	   html-to-texinfo-warning
	   html-to-texinfo-info))
	 (b (generate-new-buffer html2texi-log-buffer-name)))
    (display-buffer b)
    (with-current-buffer b
      (compilation-mode)
      b)))

(defun html2texi-fatal-error (format-str xml-expr &rest args)
  (setq html2texi-log-buffer (or html2texi-log-buffer
				 (html2texi-generate-log-buffer)))
  (display-buffer html2texi-log-buffer)
  
  (let ((line-number (line-number-at-pos)))
    (with-current-buffer html2texi-log-buffer
      (let ((inhibit-read-only t))
	(insert (aref html2texi-log-error-names 0) ":" 
		(html2texi-current-file html2texi-files-to-do) ":"
		(if (eq xml-expr :html2texi-generic-error)
		    ""
		  (format "%d:" (+ line-number html2texi-line-delta))) 	      
		(apply
		 'format 
		 (concat format-str 
			 "\n" 
			 (aref html2texi-log-error-names 3)
			 ": <<<-----------\n" 
			 (aref html2texi-log-error-names 3)
			 ": xml-expr=%S\n"
			 (aref html2texi-log-error-names 3)
			 ": xml-stack=%S\nInfo: ----------->>>\n")
		 `( ,@args ,xml-expr ,html2texi-xml-stack)) ?\n)))
    (apply 'error format-str args)))

(defun html2texi-error (format-str xml-expr &rest args)
  (setq html2texi-log-buffer (or html2texi-log-buffer
				 (html2texi-generate-log-buffer)))
  (display-buffer html2texi-log-buffer)
  (let ((line-number (line-number-at-pos)))
    (with-current-buffer html2texi-log-buffer
      (let ((inhibit-read-only t))
	(insert (aref 1 html2texi-log-error-names) ":" 
		(html2texi-current-file html2texi-files-to-do) ":"
		(if (eq xml-expr :html2texi-generic-error)
		    ""
		  (format "%d:" (+ line-number html2texi-line-delta))) 
		" "
		(apply 'format format-str args) ?\n)))))

(defun html2texi-warning (format-str xml-expr &rest args)
  (setq html2texi-log-buffer (or html2texi-log-buffer
				 (html2texi-generate-log-buffer)))
  (display-buffer html2texi-log-buffer)
  (let ((line-number (line-number-at-pos)))
    (with-current-buffer html2texi-log-buffer
      (let ((inhibit-read-only t))
	(insert (aref html2texi-log-error-names 2) ":"
		(html2texi-current-file html2texi-files-to-do)":"
		(if (eq xml-expr :html2texi-generic-error)
		    ""
		  (format "%d:" (+  line-number html2texi-line-delta))) 
		(apply 'format format-str args) ?\n))  )))

(defun html2texi-info (format-str xml-expr &rest args)
  (setq html2texi-log-buffer (or html2texi-log-buffer
				 (html2texi-generate-log-buffer)))
  (display-buffer html2texi-log-buffer)
  (let ((line-number (line-number-at-pos)))
    (with-current-buffer html2texi-log-buffer
      (let ((inhibit-read-only t))
	(insert (aref html2texi-log-error-names 3) ":"
		(html2texi-current-file html2texi-files-to-do)":"
		(if (eq xml-expr :html2texi-generic-error)
		    ""
		  (format "%d:" (+  line-number html2texi-line-delta))) 
		(apply 'format format-str args) ?\n))  )))

(defun html2texi-decode-url (url)
  "Décode les `%20' et autres séquences hexadécimale"
  (with-temp-buffer
    (insert url)
    (goto-char (point-min))
    (while (re-search-forward "%\\([[:xdigit:]]\\{2\\}\\)" nil t)
      (replace-match (string (math-read-radix
			       (match-string-no-properties 1) 16)) t t))
    (when (eq html2texi-url-encoding :html2texi-utf-8)
      (accents-de-utf-8))
    (buffer-substring (point-min) (point-max))))

(defun html2texi-process-url (url text)
  (let* ((parsed-url (url-generic-parse-url (html2texi-decode-url url)))
	 url-list
	 i file-name locator)
    ;; petit hack parce que url-generic-parse-url ne fait pas complètement le
    ;; boulot
    (when (and
	   (null  (aref parsed-url 1))
	   (setq i (string-match "#" (aref parsed-url 6)))
	   (null (aref parsed-url 7)))
      (aset parsed-url 7 (substring (aref parsed-url 6) (1+ i)))
      (aset parsed-url 6 (substring (aref parsed-url 6) 0 i)))

    (push "@uref{" url-list) ; ça peut être défait ensuite
    ;; URL
    (if (and (eq (aref parsed-url 0)
		 'cl-struct-url)
	     (null (aref parsed-url 1)))
	;; cas où il n'y a pas de protocole
	(cond
	 ;; on point vers un fichier HTML, ce n'est donc pas une URL interne
	 ;; => cas suspect
	 ((member (file-name-extension
		   (setq file-name (aref parsed-url 6)))
		  '("html" "htm"))
	  (setq file-name (expand-file-name
			   file-name
			   (file-name-directory (html2texi-current-file html2texi-files-to-do))))
	  (html2texi-add-file-to-do html2texi-files-to-do file-name)
	  (when (aref parsed-url 7)
	    (setq file-name (concat file-name "#" (aref parsed-url 7))))
	  (push (html2texi-string-escape file-name) url-list))

	 ;; cas d'une URL interne
	 ((and (string= "" file-name)
	       (setq locator (aref parsed-url 7)))
	  (pop url-list)
	  (push "@ref{" url-list)
	  (push (html2texi-make-anchor (concat "#" locator)) url-list))

	  (t
	    (push (html2texi-string-escape url) url-list)))
        (push (html2texi-string-escape url) url-list))
     ;; Text
     (when text
       (push "," url-list)
       (push (html2texi-string-escape text) url-list))
     (push "}" url-list)
     (apply 'insert (nreverse url-list))))

(defun html2texi-tag-handler-center (xml-expr)
  (let ((start-point (point))
	(start-ln (line-number-at-pos))
	end-mark)
    (html2texi-process-xml-expr xml-expr)
    (when (and (<= (point) (+ start-point html2texi-@center-max-size))
	       (> (point) start-point)
	       ;; test histoire que le code soit à l'épreuve du temps : il se
	       ;; pourrait qu'on soit déjà centré pour une autre raison.
	       (null (save-excursion 
		       (goto-char start-point)
		       (looking-at "\\(\n\\|\\s-\\)*@center\\>")))
	       (let (to-do
		     (ok t)
		     xml-expr
		     (l (cdr-safe (cdr-safe xml-expr))))
		 (while (and ok (or to-do l))
		   (if l
		       (progn
			 (setq xml-expr (pop l))
			 (cond
			  ((stringp xml-expr))
			  ((and (consp xml-expr)
				(memq (car xml-expr) html2texi-allowed-markup-in-@center))
			   (push xml-expr to-do))
			  (t (setq ok nil))))
		     (setq l (cdr-safe (cdr-safe (pop to-do))))))
		 (when ok
		   (setq end-mark (point-marker))
		   (goto-char start-point)
		   (insert "\n@center ")
		   (while (search-forward "\n" end-mark t)
		     (delete-char -1)
		     (insert 32))
		   (goto-char end-mark)
		   (set-marker end-mark nil)))))))

(html2texi-make-simple-markup-handler i)

(defun html2texi-tag-handler-li (xml-expr)
  (insert "\n@item\n")
  (unless (memq (caadr html2texi-xml-stack) '(ol ul))
    (html2texi-fatal-error "<li> était inattendu." xml-expr ))
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-link (xml-expr)
  )

(defun html2texi-tag-handler-ol (xml-expr)
  (insert "\n@enumerate")
   (html2texi-process-xml-expr xml-expr)
  (insert "\n@end enumerate\n"))

(defun html2texi-tag-handler-p (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(defun html2texi-tag-handler-ul (xml-expr)
  (insert "\n@itemize")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n@end itemize\n"))

(defun html2texi-tag-handler-span (xml-expr)
  (insert "@c span: (<span #1>#2</span> => #2.")
  (html2texi-default-handling xml-expr "span: ")
  (html2texi-process-xml-expr xml-expr)
  (insert "@c span: )\n"))

(defun html2texi-tag-handler-style (xml-expr)
  )

(defun html2texi-tag-handler-meta (xml-expr)
  (unless (and (nth 1 html2texi-xml-stack)
	       (eq (caadr html2texi-xml-stack) 'head))
    (html2texi-fatal-error "<meta> inattendu." xml-expr))
  ;; traitement du meta...
  (let* ((attribute-list (nth 1 xml-expr))
	 (http-equiv (assq 'http-equiv attribute-list))
	 (name (assq 'name attribute-list))
	 (content (assq 'content attribute-list)))
    (cond
     ((and (consp name)
	   (consp content)
	   (progn
	     (setq name (cdr name)
		   content (cdr content))
	     (stringp name))
	   (stringp content))
      (cond
       ((string= name "author")
	(html2texi-set-doc-info 'author content))
       ((string= name "language")
	(when (string-match "\\`\\([a-z]\\{2\\}\\(-[A-Z]\\{2\\}\\)?\\)\\'" content)
	  (let ((language (match-string-no-properties 1 content)))
	    (when (= (length language) 5)
	      (aset language 2 ?_))
	    (html2texi-set-doc-info 'language language))))))
     ((and (consp http-equiv)
	   (consp content)
	   (progn (setq http-equiv (cdr http-equiv))
		  (stringp http-equiv))
	   (progn (setq content (cdr content))
		  (stringp content)))
      (setq http-equiv (downcase http-equiv))
      (cond
       ((and (string= http-equiv "content-type")
	     (string-match "charset\\s-*=\\s-*\\([-a-z0-9]+\\)" content))
	(html2texi-set-doc-info 'content-type-charset (match-string-no-properties 1 content)));
       )))))

(defun html2texi-tag-handler-pre (xml-expr)
  (let ((kes html2texi-keep-empty-strings))
    (setq html2texi-keep-empty-strings t)
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-keep-empty-strings kes)))

(defun hmtl2texi-to-plain-text (xml-expr &rest flags)
  (let (ret anchor)
    (dolist (xml-expr (cddr xml-expr))
      (cond
       ((stringp xml-expr)
	(push xml-expr ret))
       ((consp xml-expr)
	(push xml-expr html2texi-xml-stack)
	(cond
	 ((and (eq (car xml-expr) 'a)
	       (setq anchor (assq 'name (nth 1 xml-expr))))
	  (push (html2texi-make-anchor (concat "#" (cdr anchor)))
		html2texi-flushable-anchors) ))
	(let ((str  (hmtl2texi-to-plain-text xml-expr)))
	  (and (null (string= str ""))
	       (push str ret)))
	(pop html2texi-xml-stack))
       (t (html2texi-fatal-error "Expression XML inattendue." xml-expr))))
    (setq  ret (mapconcat 'identity (nreverse ret) " "))
    (if (memq :one-line flags)
	(mapconcat 'identity (split-string ret "\n") " ")
      ret)))


(defun html2texi-tag-handler-title (xml-expr)
  (unless (and  (nth 1 html2texi-xml-stack)
		(eq  (caadr html2texi-xml-stack) 'head))
    (html2texi-fatal-error "<title> inattendu." xml-expr))
  (setq xml-expr (cddr xml-expr))
  (let ((str  (hmtl2texi-to-plain-text xml-expr)))
    (setq str (split-string str "\n")
	  str (mapconcat 'identity str " "))
    (unless (string= str "")
      (html2texi-set-doc-info 'title str))))

(defun html2texi-string-escape (str &optional flatten)
  (cond
   ((stringp str)
    (with-temp-buffer
      (insert str)
      (goto-char (point-min))
      (while (re-search-forward "[,@{}]" nil t)
	(cond
	 ((string= (match-string-no-properties 0) ",")
	  (replace-match "@comma{}"))
	 ((member (match-string-no-properties 0) '("@" "{" "}"))
	  (replace-match (concat "@" (match-string-no-properties 0))))))
      (when flatten
	(goto-char (point-min))
	(while (re-search-forward "\n\\(\\s-*\\)" nil t)
	  (replace-match (if (> 0 (length (match-string 1))) " " "") t t)))
      (buffer-substring (point-min) (point-max))))
   ((and (consp str) (car-safe str))
    (cond
     ((eq (car str) 'span)
      (with-temp-buffer
	(insert "@c span: (<span #1>#2</span> => string-escape of #2.")
	(html2texi-default-handling str "span: ")
	(insert (html2texi-string-escape  (nth 2 str) flatten))
	(insert "@c span: )\n")
	(buffer-substring (point-min) (point-max))))
     (t (html2texi-fatal-error "Une chaîne était attendue" :html2texi-generic-error str))))
   (t  (html2texi-fatal-error "Une chaîne était attendue" :html2texi-generic-error str))))

(defun html2texi-tag-handler-img (xml-expr)
  (let (filename width height alttext extension)
    (dolist (x (cadr xml-expr))
      (cond
       ((eq (car x) 'src)
	(setq filename (cdr x)))
       ((eq (car x) 'alt)
	(setq alttext (cdr x)))))
    (unless filename
      (html2texi-fatal-error "src=... était attendu" xml-expr))
    (setq filename (html2texi-decode-url filename))
    (setq extension (file-name-extension filename)
	  filename (file-name-sans-extension filename))
    (when (member extension '("png" "jpg" "jpeg" "eps" "txt"))
      (setq extension nil))
    (insert "@image{" (html2texi-make-anchor filename (symbol-function 'identity)))
    (let ((remainder (list width height alttext extension)))
	(while remainder
	  (if (let (non-empty)
		(mapc (lambda (x) (setq non-empty (or non-empty (stringp x))))
		      remainder)
		non-empty)
	      (insert "," (or (pop remainder) "") )
	    (setq remainder nil); rompt la boucle (while remainder...)
	    ))
	(insert "}"))))

(defun html2texi-set-doc-info (tag val)
  "Configure pour l'étiquette TAG la valeur VAL concernant les
informations globales au documents. Ces informations concernent
notamment la langue et l'encodage du document."
  (let ((info (assq tag html2texi-document-information)))
    (if info
	(setcdr info val)
      (push (cons tag val) html2texi-document-information))))

(defun html2texi-tag-handler-head (xml-expr)
  (unless html2texi-ignore-head
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-ignore-head t)))

(defun html2texi-tag-handler-noframes (xml-expr)
  )

(if (boundp 'html2texi-handler-hash-table)
    (makunbound 'html2texi-handler-hash-table))

(defconst html2texi-handler-hash-table
  (let ((ht (make-hash-table)))
    (dolist (v '(a b body center code dfn dl dt dd em i kbd li p hr div ol ul pre
    head meta title frameset frame noframes span strong table th tr td h1 h2
    h3 h4 h5 h5 html link br img samp style sup sub tt))
      (puthash v (symbol-function (intern (concat "html2texi-tag-handler-" (symbol-name v))))
	       ht))
    ht)
  "Table de hashage des traitement associé à chaque balise HTML"
  )

(defun html2texi-remove-empty-strings (xml-expr)
  (setq xml-expr (cdr xml-expr))
  (save-match-data
  (while (cdr xml-expr)
    (if (and (stringp (cadr xml-expr))
	     (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'" (cadr xml-expr)))
	(setcdr xml-expr (cddr xml-expr))
      (setq xml-expr (cdr xml-expr))))))

(defun html2texi-process-xml-expr (xml-expr)
  (push xml-expr html2texi-xml-stack)
  (dolist (xml-expr (cddr xml-expr))
    (cond
     ((consp xml-expr)
      (push xml-expr html2texi-xml-stack)
      (let ((handler (gethash (intern (downcase (symbol-name (car xml-expr))))
			      html2texi-handler-hash-table)))
	(if handler
	    (funcall handler  xml-expr)
	  (html2texi-default-handling xml-expr)))
      (pop html2texi-xml-stack))
     ((stringp xml-expr)
      (and (or html2texi-keep-empty-strings
	       (null (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'"  xml-expr)))
	   (insert (html2texi-handle-string xml-expr))))
     (t (error "Expression XML inattendue %S" xml-expr))))
  (pop html2texi-xml-stack))

(defun html2texi-default-handling (xml-expr &optional prompt)
  (let ((str (split-string (prin1-to-string xml-expr) "\n")))
    (dolist (str-line str)
      (insert "\n@c " (or prompt "") str-line)))
    (insert "\n"))

(defun html2texi-process-region (beg end)
  (goto-char end)
  (let ((end (point-marker))
	is-xhtml
	re-do
	xml-expr)

    ;; Suppression de tout ce qui est en dehors des balise <html> ... </html>
    (goto-char beg)
    (setq html2texi-line-delta (line-number-at-pos))
    (setq is-xhtml
	  (looking-at "[ \t\n\r]*<!DOCTYPE[ \t\n\r]+html[ \t\n\r]+PUBLIC[ \t\n\r]+\"-//W3C//DTD XHTML"))
    (unless (re-search-forward "<html" end t)
      (html2texi-fatal-error "Balise <html> non trouvée" xml-expr))
    (setq html2texi-line-delta (- (line-number-at-pos) (* 2 html2texi-line-delta)))
    (delete-region beg (match-beginning 0))
    (unless (re-search-forward ">" end t)
      (html2texi-fatal-error "Clôture de la balise <html> trouvée" xml-expr))
    (unless  (re-search-forward "</html" end t)
      (html2texi-fatal-error "Balise </html> non trouvée trouvée" xml-expr))
    (unless (re-search-forward ">" end t)
      (html2texi-fatal-error "Clôture de la balise </html> trouvée" xml-expr))
    (delete-region (match-end 0) end)

    (or is-xhtml
	(html2texi-make-html-clean-xml beg end))

    (setq xml-expr
	  (condition-case
	      sig
	      (xml-parse-region beg end)
	    (error
	     (if (consp sig)
		 (html2texi-warning "File is XHTML but xml-parser reported error `%S'" 
				 :html2texi-generic-error
				 (cdr sig))
	       (html2texi-warning "File is XHTML but xml-parser reported errors" 
				  :html2texi-generic-error))
		  (if is-xhtml :html2texi-redo nil)))
	  xml-expr
	  (if (eq xml-expr :html2texi-redo)
	       (progn
		 (html2texi-make-html-clean-xml beg end)
		 (xml-parse-region beg end))
	     xml-expr))
  
    (delete-region beg end)
    (set-marker end nil)
    xml-expr))

(if t
;; plus partique pour déboguer qu'un vrai tampon temporaire
    (defmacro html2texi-with-temp-buffer (&rest body)
      (let ((cur-buff (make-symbol "cur-buff")))
	`(with-current-buffer
	       (let (( ,cur-buff (get-buffer "*HTML2TEXI Temp*")))
		 (and ,cur-buff (kill-buffer ,cur-buff))
		 (get-buffer-create "*HTML2TEXI Temp*"))
       (erase-buffer)
       ,@body)))
  ;;
  (defmacro html2texi-with-temp-buffer (&rest body)
    `(with-temp-buffer ,@body)))



(defun html2texi-make-texi-buffer (&optional buffer )
  (let* ((start-buffer (or buffer (current-buffer)))
	 xml-expr
	 (start-filename  (or (buffer-file-name start-buffer) (buffer-name)))
	 (start-filename-ext (file-name-extension start-filename))
	 (texi-buffer-name
	  (concat (concat  (file-name-sans-extension   (file-name-nondirectory start-filename))
			    ".texi")))
	 done-links-list
	 texi-buffer
	 html2texi-keep-empty-strings
	 html2texi-xml-parsed
	 html2texi-xml-stack
	 (html2texi-line-delta 0)
	 html2texi-ignore-head
	 html2texi-directory-stack
	 html2texi-flushable-anchors
	 html2texi-directory-ref
	 (html2texi-files-to-do (html2texi-files-to-do-listing "À traiter"))
	 html2texi-log-buffer)
    (unless (or (member start-filename-ext '("html" "htm"))
		(y-or-n-p (format "le tampon %s n'a pas une extension html, continuer?"
				  start-filename)))
      (error "Fichier sans extension html"))
    (setq texi-buffer (get-buffer-create texi-buffer-name))
    (set-buffer texi-buffer)
    (erase-buffer)
    (dolist (v html2texi-texi-buffer-local-variables)
      (set (make-local-variable v) nil))
    (push (cons default-directory "./") html2texi-directory-stack)
    (setq html2texi-directory-ref default-directory)
    (html2texi-add-file-to-do html2texi-files-to-do start-filename)
    (while (html2texi-files-has-to-do html2texi-files-to-do)
      (setq file-name (html2texi-get-next-file-next-to-do html2texi-files-to-do))
      (if (file-exists-p file-name)
	  (progn
	    (let* ((dir (file-name-as-directory
			 (file-name-directory file-name)))
		   (rel-dir   (let ((d
				     (file-name-directory
				      (file-relative-name file-name html2texi-directory-ref))))
				(if d (file-name-as-directory d)
				  "./"))))
	      (push (cons dir rel-dir) html2texi-directory-stack)
	      (html2texi-with-temp-buffer
	       (insert-file-contents file-name)
	       (accents-de-html)
	       (html2texi-make-html-clean-xml (point-min) (point-max))
	       (setq xml-expr (html2texi-process-region (point-min) (point-max))))
	      (unless (eq 'html (caar xml-expr))
		(html2texi-fatal-error "Résultat d'analyse XML inattendu" xml-expr))
	      (setq xml-expr (car xml-expr))
	      (html2texi-process-xml-expr xml-expr)
	      (pop html2texi-directory-stack)	))
	(html2texi-warning "Le fichier `%s' n'existe pas!" :html2texi-generic-error file-name)))))

(defun html2texi-insert-doc-info ()
  (let ((author
	 (html2texi-string-escape
	  (or (cdr-safe (assq 'author html2texi-document-information)) "AUTHOR")))
	(title 	 (html2texi-string-escape
		  (or (cdr-safe (assq 'title html2texi-document-information)) "TITLE")))
	(language 	 (let ((language  (cdr-safe (assq 'language html2texi-document-information))))
			   (if language (cons "" (html2texi-string-escape language))
			     (cons "@c " "LANGUAGE"))))
	(encoding  (html2texi-string-escape
			  (or (cdr-safe (assq 'content-type-charset html2texi-document-information))
			      "iso-8859-1"))))

    (goto-char (point-min))
    (insert "\\input texinfo   @c -*-mode:texinfo; coding:" (downcase encoding) "-*-
@setfilename " (file-name-sans-extension (buffer-name)) ".info
" (car language) "@documentlanguage " (cdr language) "
@documentencoding "  (if (let ((case-fold-search t))
			   (string-match "\\`\\(us\\|utf\\|iso\\)" encoding))
			 (upcase encoding) encoding) "
@copying
This manual is for PROGRAM, version VERSION.

Copyright @copyright{} YEARS COPYRIGHT-OWNER.

@quotation
Permission is granted to ...
@end quotation
@end copying

@titlepage
@title " title "@c NAME-OF-MANUAL-WHEN-PRINTED
@c @subtitle SUBTITLE-IF-ANY
@c @subtitle SECOND-SUBTITLE
@author " author "

@c  The following two commands
@c  start the copyright page.
@page
@vskip 0pt plus 1filll
@insertcopying

Published by ...
@end titlepage

@c So the toc is printed at the start.
@contents

@ifnottex
@node Top
@top TITLE

This manual is for PROGRAM, version VERSION.
@end ifnottex
")
    (goto-char (point-max))
    (insert "
@bye") ))

(defun html2texi-post-process ()
  "Remplace les double lignes vides en ligne vides simples."
  (goto-char (point-min))
  (while (re-search-forward "\\(^[ \t]*\n\\)\\{2,\\}" nil t)
    (replace-match "\n"))
  (normal-mode))

;;;###autoload
(defun html2texi ()
  (interactive)
  (html2texi-make-texi-buffer)
  (html2texi-insert-doc-info)
  (html2texi-post-process)
  (html2texi-info "Fin de la conversion en HTML !" :html2texi-generic-error ))

;; Log compilation mode stuff
(defun html2texi-define-error-regexps ()
  (dolist (v `(
	       (html-to-texinfo-error
		. 
		(
		 ,(concat "^" (regexp-opt (list (aref html2texi-log-error-names 0)
						(aref html2texi-log-error-names 1)))
			  ":\\(" html2texi-filepath-re 
			  "\\):\\(?:\\([0-9]+\\):\\)?.*$")
		 1; File
		 2; Line
		 0; Error
		 ))
	       (html-to-texinfo-warning
		. 
		(
		 ,(concat "^" (aref html2texi-log-error-names 2)
			  ":\\(" html2texi-filepath-re 
			  "\\):\\(?:\\([0-9]+\\):\\)?.*$")
		 1; File
		 2; Line
		 1; Warning
		 ))
	       (html-to-texinfo-info
		. 
		(
		 ,(concat "^" (aref html2texi-log-error-names 3)
			  ":")
		 nil; File
		 nil; Line
		 2; Warning
		 ))))
    (add-to-list 'compilation-error-regexp-alist (car v))
    (let ((cell (or (assq (car v) compilation-error-regexp-alist-alist)
		    (car (push (cons  (car v) nil) compilation-error-regexp-alist-alist)))))
      (setcdr cell (cdr v))  )))
(html2texi-define-error-regexps)

;;; html-to-texinfo.el ends here

Revision-number: 20
Prop-content-length: 323
Content-length: 323

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2012-02-10T22:10:55.000000Z
K 7
svn:log
V 220
Gestion dans les tables de tbody, thead et tfoot
Pour les table utiliser un context unique (classe `html2texi-table-fmt-ctxt') plutôt que plein de variables.
Réutilisation du tampon de log entre deux compilations.

PROPS-END

Node-path: trunk/lisp/html-to-texinfo.el
Node-kind: file
Node-action: change
Text-content-length: 61112
Text-content-md5: 9047062fef0264fad4e831bb5decd8fc
Content-length: 61112

;;; html-to-texinfo.el --- -*- coding: iso-8859-1 -*-
;; Copyright 2010/2012 Vincent Belaïche
;;
;; Author: Vincent Belaïche <vincent.b.1@hotmail.fr>
;; Version: $Id: html-to-texinfo.el,v 1.11 2012-02-10 22:10:55 Vincent Exp $
;; Keywords: Texinfo, HTML, conversion
;; X-URL: not distributed yet
;;
;; This software is governed by the CeCILL license under French law and
;; abiding by the rules of distribution of free software.  You can  use,
;; modify and/ or redistribute the software under the terms of the CeCILL
;; license as circulated by CEA, CNRS and INRIA at the following URL
;; "http://www.cecill.info".
;;
;; As a counterpart to the access to the source code and  rights to copy,
;; modify and redistribute granted by the license, users are provided only
;; with a limited warranty  and the software's author,  the holder of the
;; economic rights,  and the successive licensors  have only  limited
;; liability.
;;
;; In this respect, the user's attention is drawn to the risks associated
;; with loading,  using,  modifying and/or developing or reproducing the
;; software by the user in light of its specific status of free software,
;; that may mean  that it is complicated to manipulate,  and  that  also
;; therefore means  that it is reserved for developers  and  experienced
;; professionals having in-depth computer knowledge. Users are therefore
;; encouraged to load and test the software's suitability as regards their
;; requirements in conditions enabling the security of their systems and/or
;; data to be ensured and,  more generally, to use and operate it in the
;; same conditions as regards security.
;;
;; The fact that you are presently reading this means that you have had
;; knowledge of the CeCILL license and that you accept its terms.
;;
;;; Commentary:

;;

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'html-to-texinfo)

;;; Code:

(provide 'html-to-texinfo)
(eval-when-compile
  (require 'cl))
(require 'eieio)
(require 'calc-ext)
(require 'accents-ascii)
(require 'compile)

;;;;##########################################################################
;;;;  User Options, Variables
;;;;##########################################################################

(defconst html2texi-suspicious-html-tags
  '("meta" "br" "hr" "link" "img" "frame")
"Liste des balises pour lesquelles le HTML ne suit pas une
syntaxe strictement XML. Par exemple `<br>' est utilisé au lieu
de `<br/>'."  )

(defconst html2texi-suspicious-html-tags-re
  (regexp-opt html2texi-suspicious-html-tags))

(defconst html2texi-non-recursive-tags
  '("p" "li"))

(defconst html2texi-hierarchy-list
  '(
    (li (ul ol))
    (tr (table))
    (th (tr))
    (td (tr))
    (dd (dl))
    (dt (dl))  )
  )

(defconst html2texi-non-recursive-tags-re
  (regexp-opt html2texi-non-recursive-tags))

(defconst html2texi-filepath-re
  "\\(?:[A-Za-z]:\\)?[- ~+A-Za-z_0-9./\\]+")

(defconst html2texi-texi-buffer-local-variables
  '(html2texi-document-information)
    "Liste des variables déclarées localement au tampon Texinfo.")

(defconst html2texi-allowed-markup-in-@center
  '(img b i em tt strong dfn code)
  "Liste des balises autorisées pour @center.")

(defconst html2texi-@center-max-size 1000)

(defclass html2texi-simple-markup ()
  ((class-dependant
    :initarg :class-dependant
    :initform nil
    :custom '(repeat
	  (list
	   (regexp :tag "clef")
	   (string :tag "prologue")
	   (string :tag "épilogue")
	   (boolean :tag "conserver les espaces et retours chariot")
	   ))
    :documentation "\
Liste d'association dont les éléments sont de la forme
 (CLEF PROLOGUE ÉPILOGUE)

Supposons que l'objet décrit le traitement de la balise TAG,
alors lorsque le code HTML `<TAG class=\"CLEF\">CONTENU</TAG>'
est rencontré, alors il est convertie en le code Texinfo
`PROLOGUE TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU.")
   (preamble
    :initarg :preamble
    :type string
    :documentation "\
Prologue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (postamble
    :initarg :postamble
    :type string
    :documentation "\
Épilogue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (space-verb
    :initarg :space-verb
    :initform nil
    :type boolean
    :documentation "\
Vrai lorsque les espaces et retours chariot sont à conserver tels quels."
    ))
  :documentation "\
Un object de type `html2texi-simple-markup'
décrit le traitement d'une balise simple comme par exemple
<code>.")

(defclass html2texi-files-to-do-listing ()
  ((already-to-do
   :initarg :already-to-do
   :initform nil
   :documentation "Liste des fichiers qui ont été trouvés comme
   étant à traiter lors du traitement d'un fichier qui a déjà été
   complètement traité.")
   (doing-or-done
    :initarg :doing-or-done
    :initform nil
    :documentation "Liste des fichier qui ont déjà été traité, le
    premier de la liste est le fichier en cours de traitement."
    )
   (soon-to-do
   :initarg :soon-to-do
   :initform nil
   :documentation "Liste des fichiers qui sont trouvés comme
   étant à traiter lors du traitement du fichier en cours de
   traitement."))
  :documentation "Objet servant à lister les fichiers à
  traiter. Il comprend deux listes: `already-to-do' et
  `soon-to-do' parce que lors du traitement d'un fichier TOTO les
  nouveaux fichiers à traiter sont mis dans `soon-to-do' dans
  l'ordre où ils sont rencontrés, du coup une fois que le fichier
  TOTO a complètement été traité, on inverse cet ordre en
  transvasant le contenu de `soon-to-do' dans `already-to-do'.")


(defclass html2texi-table-fmt-ctxt ()
  ((col-number
    :initarg :col-number
    :initform 0
    :type integer)
   (row-number
    :initarg :row-number
    :initform 0
    :type integer)
   (head-on-row-0
    :initarg :head-on-row-0
    :initform nil
    :type boolean)
   (force-head
    :initarg :force-head
    :initform nil
    :type boolean)
   (col-count
    :initarg :col-count
    :initform 0
    :type integer
    :documentation 
    "Nombre de colonnes dans le tableau.")
   (col-info
    :initarg :col-info
    :documentation
    "Liste d'information sur chaque colonne. Le premier élément
    est factice est ne correspond à aucune colonne.")
   (col-info-last
    :initarg :col-info-last
    :documentation
    "Pointe sur la dernière cons-cell de l'attribut `:col-info'.")
   (col-info-length
    :initarg :col-info-length
    :initform 0
    :type integer))
  :documentation "Contexte de formattage d'une table.")

(defmethod initialize-instance ((this html2texi-table-fmt-ctxt) &rest fields)
  (call-next-method)
  (let ((ci (list 0)))
    ;; le premier élément ne correspond pas à une colonne mais servira à
    ;; reduire le vecteur des informations sur chaque colonne
    (oset this :col-info ci)
    (oset this :col-info-last ci)))


(defmethod html2texi-files-has-to-do ((this html2texi-files-to-do-listing))
  (or (oref this :already-to-do)
      (oref this :soon-to-do))  )

(defmethod html2texi-current-file ((this html2texi-files-to-do-listing))
  (car (oref this :doing-or-done)))

(defmethod html2texi-get-next-file-next-to-do  ((this html2texi-files-to-do-listing))
  "Récupère le prochain fichier à traiter. L'appel de cette
méthode si aucun fichier n'est à traiter génère une erreur."
  (let ((soon-to-do (oref this :soon-to-do))
	(already-to-do (oref this :already-to-do)))
    (when soon-to-do
      (while soon-to-do (push (pop soon-to-do) already-to-do))
      (oset this :soon-to-do nil))
    (let ((next (pop already-to-do)))
      (oset this :already-to-do already-to-do)
      (oset this :doing-or-done (cons next (oref this :doing-or-done)))
      next)))

(defmethod html2texi-add-file-to-do   ((this html2texi-files-to-do-listing) next)
  (unless (or (member next (oref this :already-to-do))
	      (member next (oref this :doing-or-done))
	      (member next (oref this :soon-to-do)))
    (oset this :soon-to-do (cons next (oref this :soon-to-do)))))

(defun html2texi-texinfo-inside-comment-p ()
  "Renvoie non nil lorsque le point est dans un commentaire Texinfo."
  (save-match-data
    (save-excursion
      (let ((cur (point))
	    (end (progn (end-of-line) (point))))
	(beginning-of-line)
	(and (re-search-forward "\\(^\\|[^@]\\)@c\\(omment\\)\\_>" end t)
	     (<= (match-beginning 0) cur))))))

(defmethod html2texi-handle-simple-markup
  ((this html2texi-simple-markup) xml-expr)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe
			(and class-attribute
			     (assoc-string (cdr class-attribute)
					   (oref this :class-dependant))))
		      (list (oref this :preamble)
			    (oref this :postamble)))))
    (insert (car pre-post))
    (let ((beg (point))
	  end)
      (html2texi-process-xml-expr xml-expr)
      (unless (oref this :space-verb)
	(setq end (point-marker))
	(goto-char beg)
	(while (re-search-forward "[\n\r]\\s-*" nil end)
	  (let ((replace-str " "))
	    (save-match-data
	      (cond
	       ((html2texi-texinfo-inside-comment-p)
		(setq replace-str nil))))
	      (and replace-str (replace-match replace-str t t)))))
	(goto-char end)
	(set-marker end nil))
    (insert (cadr pre-post))))


(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-reuse-log-buffer t
  "Mettre à `nil' pour que le tampon de sorite des erreurs &
avertissement soit re-généré avec un nom unique à chaque
traitement."
  :type 'boolean
  :group 'html2texi)

(defcustom html2texi-url-encoding
  :html2texi-utf-8
  "Sélectionne le codage des URL."
  :type '(choice
	  (symbol :tag "UTF-8" :html2texi-utf-8)
	  (symbol :tag "ISO-8859-1" :html2texi-latin-1))
  :group 'html2texi)

(defcustom html2texi-i-simple-markup
  (html2texi-simple-markup "html2texi-i-simple-markup"
   :preamble "@i{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-b-simple-markup
  (html2texi-simple-markup "html2texi-b-simple-markup"
   :preamble "@b{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-kbd-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :preamble "@kbd{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-dfn-simple-markup
  (html2texi-simple-markup "html2texi-dfn-simple-markup"
   :preamble "@dfn{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-em-simple-markup
  (html2texi-simple-markup "html2texi-em-simple-markup"
   :preamble "@emph{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-sub-simple-markup
  (html2texi-simple-markup "html2texi-sub-simple-markup"
   :preamble ""
   :postamble "")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<sub class=\"CLEF\">CONTENU</sub>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-sup-simple-markup
  (html2texi-simple-markup "html2texi-sup-simple-markup"
   :preamble ""
   :postamble "")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<sup class=\"CLEF\">CONTENU</sup>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-samp-simple-markup
  (html2texi-simple-markup "html2texi-samp-simple-markup"
   :preamble "@samp{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<samp class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-strong-simple-markup
  (html2texi-simple-markup "html2texi-strong-simple-markup"
   :preamble "@strong{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-tt-simple-markup
  (html2texi-simple-markup "html2texi-tt-simple-markup"
   :preamble "@t{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<tt class=\"CLEF\">CONTENU</tt>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-handle-two-columns-table-as-@table
  t
 "Si `nil' alors une table `<table>...</table>'
avec deux colonne sera gérée en texinfo par une `@table', si non
`nil', alors elle sera gérée par une `@multitable'."
  :type
  '(choice
    (const :tag "t pour @table" t)
    (const :tag "nil pour @multitable" nil))
  :group 'html2texi)

(defcustom html2texi-log-error-names
   ["Erreur fatale" "Erreur" "Avertissement" "Info"]
   "Liste des types d'erreur préfixant les messages d'erreur dans
le tampon de sortie des erreurs & avertissement de traitement."
   :type
   '(vector
     (string :tag "Erreur fatale")
     (string :tag "Erreur")
     (string :tag "Avertissement")
     (string :tag "Info"))
   :group 'html2texi  )

(defcustom html2texi-log-buffer-name
  "*HTML2TEXI*"
  "Nom du tampon de sortie des erreurs et avertissements de traitement."
  :type 'string
  :group 'html2texi)


(defvar html2texi-document-information nil
  "Liste d'association pour mémoriser les informations (titre,
  auteurs, etc...) propres à un document.")

(defvar html2texi-line-delta 0
  "Décalage entre le numéro de ligne du code XML au sein le
  tampon Texinfo en cours de traitement, et son numéro de ligne
  dans le fichier HTML source.")


(defvar html2texi-xml-stack nil
  "Pile des expressions XML")

(defvar html2texi-keep-empty-strings nil
  "Non nil si les chaînes vides sont à conserver.")

(defvar html2texi-ignore-head nil
  "Non nil si on ignore le <head> (dans un fichier HTML lié).")

(defvar html2texi-directory-stack nil
  "Pile des chemins de répertoire.")

(defvar html2texi-files-to-do nil
  "Base des fichiers non encore traités, instanciée localement
  comme un objet de class `html2texi-files-to-do-listing'.")

(defvar html2texi-flushable-anchors nil
  "Liste de nom d'ancrage de lien dont l'insertion a été remise à
  plus tard." )

(defvar html2texi-postpone-output nil
  "Non `nil' lorsque l'insertion du code est remise à plus tard.")


(defvar html2texi-directory-ref nil
  "Répertoire de référence")

(defvar html2texi-log-buffer nil
  "Tampon de sortie des erreurs et avertissements de traitement.")

(defmacro html2texi-make-simple-markup-handler (tag)
  `(defun ,(intern (concat "html2texi-tag-handler-" (symbol-name tag)))
     (xml-expr)
     (html2texi-handle-simple-markup
      ,(intern (concat "html2texi-"  (symbol-name tag) "-simple-markup"))
      xml-expr) ))

(defun html2texi-make-html-clean-xml (beg end)
  (let  ((end-arg end)
	 end)
    ;; initialisation de end comme un marque
    (if (markerp end-arg)
	(setq end end-arg)
      (goto-char end-arg)
      (setq end (point-marker)))

    ;; rend les balise implicitement auto-closante vraiment auto-closante
    (goto-char beg)
    (while (re-search-forward (concat "<\\(" html2texi-suspicious-html-tags-re "\\)\\>")
			      end t)
      (let ((tag (match-string-no-properties 1)))
	(unless (re-search-forward ">" nil t)
	  (html2texi-fatal-error "Clôture non trouvé pour la balise %s" nil
				 tag))
	(when (null (looking-back "/>"))
	  (backward-char)
	  (insert "/")
	  (forward-char))))

    ;; marque de paragraphe et de ligne
    (goto-char beg)
    (let (tag-stack pos-< pos->
		    tag is-closure self-closing)
      (while (re-search-forward "<\\(/\\)?\\([a-zA-Z]+\\)\\>" end t)
	(setq pos-< (match-beginning 0)
	      tag (match-string-no-properties 2)
	      is-closure (match-string-no-properties 1))
	(unless (string= tag (downcase tag))
	  (replace-match (setq tag (downcase tag)) 2))
	(unless (re-search-forward ">" end t)
	  (html2texi-fatal-error "Soufflet de clôture non trouvé pour la balise %s" nil
		 tag))

	(setq pos-> (point)
	      self-closing (looking-back "/>"))
	(cond
	 ((and self-closing  is-closure)
	  (html2texi-fatal-error "balise %s à la fois de clôture et auto-closante" nil
		 tag))

	 (self-closing
	  ;; do nothing
	  )

	 ((null is-closure)
	  (when (and
		 (string-match (concat "\\`" html2texi-non-recursive-tags-re "\\'") tag)
		 tag-stack
		 (string= tag (caar tag-stack)))
	    ;; clôture
	    (save-excursion
	      (goto-char pos-<)
	      (insert "</" tag "><!-- HTML2TEXI: repaired (1) -->")
	      (html2texi-warning "Ajout clôture `</%s>'" nil tag))
	    (pop tag-stack))
	  (push (list tag) tag-stack))

	 (is-closure
	  (if (and tag-stack
		   (string= (caar tag-stack) tag))
	      (pop tag-stack)
	    (let ((first (assoc-string tag tag-stack)) rev)
	      (if first
		  (progn
		    (while (and tag-stack (null (eq (car tag-stack) first)))
		      (push (pop tag-stack) rev))
		    (pop tag-stack)
		    (save-excursion
		      (goto-char pos-<)
		      (dolist (c rev)
			(insert  "</" (car c) "><!-- HTML2TEXI: repaired (2) -->" )
			(html2texi-warning "Ajout clôture `</%s>'" nil tag))))

		(save-excursion
		  (goto-char pos->)
		  (insert "-->")
		  (goto-char pos-<)
		  (insert "<!-- HTML2TEXI: repaired (3). "))
		(html2texi-warning "Clôture de %s ne correspondant à aucune ouverture" nil tag)))))))


      (let (p-pos li-pos markup poss pos)
	(while (re-search-forward "<\\(/\\)?\\(p\\|li\\)\\>[^>]*>" end t)
	  (setq markup (match-string-no-properties 2)
		poss (intern (concat markup "-pos"))
		pos (symbol-value poss))
	  (if (match-string-no-properties 1)
	      (if  pos
		  (if (= pos (match-beginning 0))
		      (set poss nil)
		    (html2texi-fatal-error "Clôture de balise %s ne correspondant à aucune ouverture" nil
					   (match-string-no-properties 0)))
		(save-excursion
		  (save-match-data
		    (unless  (re-search-forward
			      (format "<\\(/\\)?\\(%s\\)\\>[^>]+>" markup)
			      end t)
		      (html2texi-fatal-error "Ouverture de balise <%s> sans clôture" nil
					     markup))
		    (set poss (match-beginning 0))
		    (unless (match-string-no-properties 1)
		      (goto-char (match-beginning 0))
		      (insert (format "</%s>" markup))
		      (dolist (symb '(p-pos li-pos))
			(unless (or (null (symbol-value symb))
				    (eq symb poss))
			  (set symb (+ (length markup) 3 (symbol-value symb)))))))))))
	))

    ;; mise entre guillemets anglais des attributs entier sans guillemets
    (goto-char beg)
    (let (p1 p2 added-dquote-attributes p-start p-end)
      ;; tant qu'on trouve potentiellement un attribut sans "..."
      (while (re-search-forward "\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([-+]?[0-9]+\\)"
				nil end)
	(setq p1 (match-beginning 1)
	      p2 (match-end 0))
	(if
	    ;; si la position est bien entre < et >
	    (and (re-search-backward "[<>]" beg t)
		 (looking-at "<\\sw+")
		 (progn
		   (goto-char (setq p-start (match-end 0)))
		   (re-search-forward "[<>]" end t)
		   (string= (match-string-no-properties 0) ">"))
		 (>= (setq p-end (match-beginning 0)) p1))
	    ;; alors on fait la réparation
	    (progn
	      (goto-char p-start)
	      (while
		  (progn
		    (while (looking-at "\\(?:\\s-\\|\n\\)*\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\"[^\"]*\"")
		      (goto-char (match-end 0)))
		    (cond
		     ((looking-at  "\\(?:\\s-\\|\n\\)*\\(\\sw+\\)\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([-+]?[0-9]+\\)")
		      (push (match-string-no-properties 1) added-dquote-attributes)
		      (goto-char (match-beginning 2))
		      (insert ?\")
		      (goto-char (1+ (match-end 2)))
		      (insert ?\")
		      (setq p-end (+ 2 p-end)))
		     ((looking-at "\\(?:\\s-\\|\n\\)*>")
		      (goto-char (match-end 0))
		      (insert "<!-- HTML2TEXI inserted double quotes around values for attibutes: "
			      (mapconcat (lambda (x) (concat "`" x "'"))
					 added-dquote-attributes
					 ", ")
			      " -->")
		      nil)
		     (t (html2texi-error "Attribut au format invalide: %s."
			       (buffer-substring (point) p-end)))))))
	  ;; sinon on continue à chercher un attribut potentiel dont la valeur
	  ;; n'est pas entre "..."
	  (goto-char p2))))

    ;; un peu de ménage...
    (unless (markerp end-arg)
      (set-marker end nil)) ))

;;;==========================================================================
;;; définition des gestionnaires de balise
;;;--------------------------------------------------------------------------

(defun html2texi-tag-handler-a (xml-expr)
  (let (name href text (xml-expr-length (length xml-expr)))
    (dolist (attrib (cadr xml-expr))
      (cond
       ((eq (car attrib) 'href)
	(setq href (cdr attrib)))
       ((eq (car attrib) 'name)
	(setq name (cdr attrib)))))
    (and (cddr xml-expr)
	 (setq text (caddr xml-expr)))
    (cond
     (href (html2texi-process-url href text))
     ((= xml-expr-length 3)
      (cond
       ((stringp text)
	(insert (html2texi-string-escape text t)))
       ((consp text) (html2texi-process-xml-expr text))
       (t (error "Le format du text de la balise <a> était inattendu"))))
     ((> xml-expr-length 3)
      (html2texi-process-xml-expr `(div nil ,@(cddr xml-expr)))))
    (and name
      (insert "\n@anchor{" (html2texi-make-anchor (concat "#" name)) "}\n"))))

(html2texi-make-simple-markup-handler b)

(defun html2texi-flush-anchors ()
  (while html2texi-flushable-anchors
    (insert "@anchor{" (pop html2texi-flushable-anchors) "}\n")))


(defun html2texi-tag-handler-h1 (xml-expr)
  (insert "@chapter " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))


(defun html2texi-tag-handler-h2 (xml-expr)
  (insert "@section " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))

(defun html2texi-tag-handler-h3 (xml-expr)
  (insert "@subsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
    (html2texi-flush-anchors))

(defun html2texi-tag-handler-h4 (xml-expr)
  (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))

(defun html2texi-tag-handler-h5 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
     (html2texi-flush-anchors))

(defun html2texi-tag-handler-h6 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
   (html2texi-flush-anchors))

(html2texi-make-simple-markup-handler samp)


(defun html2texi-get-col-span (xml-expr)
  ;; xml-expr is <td> or <th>
  (let ((col-span (cdr-safe (assq 'colspan (nth 1 xml-expr)))))
    (setq col-span
	  (cond
	   ((integerp
	       (setq col-span
		     (if (stringp col-span)
			 (string-to-number col-span)
		       col-span)))
	      col-span)
	   ((null col-span) 1)
	   (t (error "colspan invalide"))))  ))

(html2texi-make-simple-markup-handler sub)
(html2texi-make-simple-markup-handler sup)

(html2texi-make-simple-markup-handler tt)

(defvar html2texi-table-fmt-current-ctxt nil)

(defun html2texi-tag-handler-table (xml-expr)
  (let* ((html2texi-table-fmt-current-ctxt (html2texi-table-fmt-ctxt "Table formatting context"))
	 (xml-table-info
	  (vector xml-expr;0: table items
		  nil;1: thead items
		  nil;2: tbody items
		  nil;3: tfoot items
		  0;4: bitmap champ trouvé:
					; 1 = plain table (found a tr item not a thead|tbody|tfoot)
					; 2 = thead found
					; 4 = tbody found
					; 8 = tfoot found
		  0;5: bitmap traité
		  1;6: en cours de traitement
		  ))
	 (xml-items (cddr xml-expr)))

    ;; tout d'abord on analyse la table pour trouver le nombre de colonne
    (while (or xml-items (/= (aref xml-table-info 4)  (aref xml-table-info 5)))
      (if xml-items
	  (let ((xml-expr (pop xml-items)))
	    (cond
	     ((and (consp xml-expr)
		   (eq (car xml-expr) 'tr))
	      (when (= (aref xml-table-info 6) 1)
		;; cas d'une table avec les lignes directement sous <table> ... </table>
		(and (/= (logand (aref xml-table-info 4)
				 14) 0)
		     (html2texi-error "Table avec à la fois des lignes directement sous <table> ... </table>\
 et des lignes sous une balise <X>...</X> avec X dans {thead, tbody, tfoot}" xml-expr))
		(aset xml-table-info 4 (logior (aref xml-table-info 4) 1)))
	      ;; plus besoin de chercher une ligne: on compte les colonnes sur la
	      ;; première ligne trouvée
	      (setq xml-items nil)
	      (dolist  (xml-expr (cddr xml-expr))
		(cond
		 ((consp xml-expr)
		  (if (memq  (car xml-expr) '(th td))
		      (progn
			(oset html2texi-table-fmt-current-ctxt :col-count
			      (+ (oref html2texi-table-fmt-current-ctxt :col-count)
				 (html2texi-get-col-span xml-expr)))
			(when (> (oref html2texi-table-fmt-current-ctxt :col-count) 
				 (oref html2texi-table-fmt-current-ctxt :col-info-length))
			  (let ((l (make-list (- (oref html2texi-table-fmt-current-ctxt :col-count) 
						 (oref html2texi-table-fmt-current-ctxt :col-info-length))
					      '(abs 1))))
			    (setcdr (oref html2texi-table-fmt-current-ctxt :col-info-last) l)
			    (oset html2texi-table-fmt-current-ctxt :col-info-last (last l))
			    (oset html2texi-table-fmt-current-ctxt :col-info-length 
				  (oref html2texi-table-fmt-current-ctxt :col-count)))))
		    (html2texi-error "balise inattendu dans une table" xml-expr)))
		 ((stringp xml-expr)
		  (unless (string-match
			   "\\`\\s-*\\(\n\\s-*\\)*\\'"
			   xml-expr)
		    (html2texi-error "Chaîne inattendue" xml-expr)))
		 (t (html2texi-error "Élément inattendu" xml-expr)))))

	     ;; la table est organisé en thead/tbody/tfoot
	     ((and (consp xml-expr)
		   (memq (car xml-expr) '(thead tbody tfoot)))
	      (let* ((thead 1) (tbody 2) (tfoot 3) (index (symbol-value (car xml-expr))))
		(and (/= (logand (aref xml-table-info 4)
				 (lsh 1 index)) 0)
		     (html2texi-error "Balise `%s' en double dans la table" 
				      (aref xml-table-info 0)
				      (symbol-name (car xml-expr))))
		(aset xml-table-info 4 (logior  (aref xml-table-info 4) (lsh 1 index)))
		(aset xml-table-info index xml-expr)))

	     ;; chaîne qui n'est pas un blanc au beau milieu de la table...
	     ((stringp xml-expr)
	      (unless (string-match
		       "\\`\\s-*\\(\n\\s-*\\)*\\'"
		       xml-expr)
		(html2texi-error "Chaîne inattendue" xml-expr)))
	     (t (html2texi-error "Élément inattendu" xml-expr))))
	;; xml-items est nil

	;; on marque le champ courant (c.-à-d. table | thead | tbody | tfoot)
	;; comme ayant été traité
	(aset xml-table-info 5 (logior
				(aref xml-table-info 5)
				(logand 
				 (aref xml-table-info 4)
				 (aref xml-table-info 6))))
	;; maintenant on cherche s'il en est un champ restant à parcourir
	(let ((index 0)
	      (to-be-processed (logxor  (aref xml-table-info 4)
					(aref xml-table-info 5))))
	  (while (and (/= to-be-processed 0)
		      (= (logand to-be-processed 1) 0))
	    (setq index (1+ index)
		  to-be-processed (lsh to-be-processed -1)))
	  (when (/= to-be-processed 0)
	    (setq xml-items (cdr-safe (cdr-safe (aref xml-table-info index))))
	    (aset xml-table-info 6 (lsh 1 index))) )))


    ;; maintenant qu'on a fini d'analyser la table, on peut la traiter.
    (if (or (> (oref html2texi-table-fmt-current-ctxt :col-count) 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(progn
	  (insert "@multitable @columnfractions ")
	  ;(debug)
	  (let ((total-weight
		 (math-reduce-vec
		  (lambda (r x)
		    (+ r
		       (cond
			((eq (car x) 'abs) (cadr x))
			((eq (car x) 'rel)
			 (setcar x 'abs)
			 (setcar (cdr x) 
				 (* (cadr x) 
				    (oref html2texi-table-fmt-current-ctxt :col-info-length))) (cadr x)))))
		  (cons 'vec (oref html2texi-table-fmt-current-ctxt :col-info)))))
	    (insert
	     (mapconcat
	      (lambda (x)
		(number-to-string
		 (/ (float (cadr x)) (oref html2texi-table-fmt-current-ctxt :col-info-length)))) 
	      (cdr (oref html2texi-table-fmt-current-ctxt :col-info)) 
	      " ")))
	  (insert "\n"))
      (insert "@table\n"))

    (dotimes (i 4)
      (when (/= 0 (logand (aref xml-table-info 4) (lsh 1 i)))
	(if (/= i 2)
	    (html2texi-process-xml-expr  (aref xml-table-info i))
	  (oset html2texi-table-fmt-current-ctxt :force-head t)
	  (html2texi-process-xml-expr  (aref xml-table-info 2))
	  (oset html2texi-table-fmt-current-ctxt :force-head nil))))

    (if (or (> (oref html2texi-table-fmt-current-ctxt :col-count) 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(insert "@end multitable\n")
      (insert "@end table\n"))))


(defun html2texi-tag-handler-tr (xml-expr)
  (oset html2texi-table-fmt-current-ctxt :col-number 0)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n")
  (oset html2texi-table-fmt-current-ctxt :row-number 
	(1+ (oref html2texi-table-fmt-current-ctxt :row-number))))

(defun html2texi-tag-handler-th (xml-expr)
  (if   (= 0 (oref html2texi-table-fmt-current-ctxt :col-number))     
      (if (and (= 0 (oref html2texi-table-fmt-current-ctxt :row-number))
	       (null html2texi-handle-two-columns-table-as-@table))
	  (progn
	    (oset html2texi-table-fmt-current-ctxt :head-on-row-0 t)
	    (insert "@headitem ")
	    (html2texi-process-xml-expr xml-expr))
	(insert "@item ")
	(html2texi-process-xml-expr xml-expr))
    (when (or (> (oref html2texi-table-fmt-current-ctxt :col-count) 2)
	      (null html2texi-handle-two-columns-table-as-@table))
      (insert "@tab "))
    (html2texi-process-xml-expr xml-expr)
    (unless (and  (= 0 (oref html2texi-table-fmt-current-ctxt :row-number)) 
		  (oref html2texi-table-fmt-current-ctxt :head-on-row-0))
	(insert "\n")))
  (oset html2texi-table-fmt-current-ctxt :col-number 
	(1+ (oref html2texi-table-fmt-current-ctxt :col-number))))

(defun html2texi-tag-handler-td (xml-expr)
  (if  (oref html2texi-table-fmt-current-ctxt :force-head)
      (html2texi-tag-handler-th xml-expr)
    (if (= 0 (oref html2texi-table-fmt-current-ctxt :col-number))
	(insert "@item ")
      (if (or (> (oref html2texi-table-fmt-current-ctxt :col-count) 2)
	      (null html2texi-handle-two-columns-table-as-@table))
	  (insert "@tab ")))
    (html2texi-process-xml-expr xml-expr)
    (insert "\n")
    (oset html2texi-table-fmt-current-ctxt :col-number 
	  (1+ (oref html2texi-table-fmt-current-ctxt :col-number)))))

(defun html2texi-cur-dir ()
  "Détermine le répertoire courant relativement au répertoire du
HTML racine de départ. La valeur retournée se termine par une oblique `/'"
  (let ((cur-dir  (nreverse (split-string (cdar html2texi-directory-stack) "/")))
	(ref-dir  (nreverse (split-string html2texi-directory-ref "/"))))
    (unless (and (string= (car cur-dir) "")
		 (string= (car ref-dir) ""))
      (error "Format invalide de répertoire"))
    (setq cur-dir (nreverse (cdr cur-dir))
	  ref-dir (cdr ref-dir))
    (if (or (string= (car cur-dir) "")
	    (string-match "\\`[a-z]:" (car cur-dir)))
	;; cur-dir est un chemin absolu
	(progn
	  (setq ref-dir (nreverse ref-dir))
	  (while (and cur-dir ref-dir (string= (car cur-dir) (car ref-dir)))
	    (setq cur-dir (cdr cur-dir)
		  ref-dir (cdr ref-dir)))
	  (while ref-dir
	    (push ".." cur-dir)
	    (setq ref-dir (cdr ref-dir)))
	  (concat (mapconcat 'identity cur-dir "/") "/"))
      (while (and cur-dir
		  (cond
		   ((string= (car cur-dir) "..")
		    (unless ref-dir
		      (error "Chemin invalide"))
		    (setq ref-dir (cdr ref-dir)
			  cur-dir (cdr cur-dir)))
		   ((string= (car cur-dir) ".")
		    (setq cur-dir (cdr cur-dir)))
		   (t nil))))
      (dolist (e cur-dir)
	(push e ref-dir))
      (mapconcat 'identity  (nreverse (cons "" ref-dir)) "/") )))

(defun html2texi-anchor-escape (anchor)
  (let (ret)
    (setq anchor
	  (mapconcat
	   'identity
	   (split-string anchor "-") "--"))
    (mapc
     (lambda (x)
       (if
	(or (and (>= x ?a) (<= x ?z))
	     (and (>= x ?A) (<= x ?Z))
	     (and (>= x ?0) (<= x ?9))
	     (member x '(?_ ?- ?/)))
	   (push (string x) ret)
	 (push (format "-%04x" x) ret)))
     anchor)
    (apply 'concat (nreverse ret))))

(defun html2texi-make-anchor (name &optional escape-function)
  (let* ((anchor (expand-file-name (concat (html2texi-cur-dir) name)))
	 (l-a (length anchor))
	 (l-r (length html2texi-directory-ref))
	 (l (min l-a l-r))
	 (start 0)
	 (i -1))
    (while (and
	    (< (setq i (1+ i)) l)
	    (prog1
		(= (aref anchor i) (aref html2texi-directory-ref i))
	      (and (= (aref anchor i) ?/)
		   (setq start (1+ i))))))
    (setq anchor (list (substring anchor start)))
    (dotimes (i (length (split-string (substring html2texi-directory-ref start))))
      (push "../" anchor))
    (setq anchor (apply 'concat anchor))
    (html2texi-string-escape (funcall (or escape-function 'html2texi-anchor-escape) anchor))))

(defun html2texi-simple-markup-handle (xml-expr class-alist preamble postamble)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe
			(and class-attribute
			     (assoc-string (cdr class-attribute) class-alist)))
		      (list preamble postamble))))
    (insert (car pre-post))
   (html2texi-process-xml-expr xml-expr)
   (insert (cadr pre-post))))

(defun html2texi-tag-handler-body (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))


(html2texi-make-simple-markup-handler code)

(defun html2texi-tag-handler-br (xml-expr)
  (insert "@*\n"))

(defun html2texi-tag-handler-div (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(html2texi-make-simple-markup-handler dfn)

(defun html2texi-tag-handler-dl (xml-expr)
  (insert "@table @asis\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "@end table\n"))

(defun html2texi-tag-handler-dt (xml-expr)
  (insert "@item ")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(defun html2texi-tag-handler-dd (xml-expr)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(html2texi-make-simple-markup-handler em)

(defun html2texi-tag-handler-frameset (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-frame (xml-expr)
  (let (url text)
    (dolist (x (cadr xml-expr))
      (cond
       ((eq (car x) 'src)
	(setq url (cdr x)))
       ((eq (car x) 'name)
	(setq text (cdr x)))))
    (when url
      (html2texi-process-url url text))))

(defun html2texi-tag-handler-hr (xml-expr)
  (insert "@c <hr/>\n"))

(html2texi-make-simple-markup-handler kbd)

(defun html2texi-tag-handler-html (xml-expr)
  "\
Traitement de la balise html."
  (let* ((attributes (nth 1 xml-expr))
	 (lang (assq 'lang attributes)))
    (when lang
      	(html2texi-set-doc-info 'language (cdr lang))))
    (html2texi-process-xml-expr xml-expr))

(html2texi-make-simple-markup-handler strong)

(defun html2texi-handle-string (str)
  (let (ret (pos0 0) pos1 (len (length str)))
    (while (and
	    (< pos0 len)
	    (setq pos1 (string-match "[{}@]" str pos0)))
      (push (substring str pos0 pos1) ret)
      (push (concat "@" (match-string-no-properties 0 str)) ret)
      (setq pos0 (1+ pos1)))
    (when (< pos0 len)
      (push (substring str pos0 pos1) ret))
    (apply 'concat (nreverse ret))))

(defun html2texi-generate-log-buffer ()
  (let* ((compilation-error-regexp-alist
	 '(html-to-texinfo-error
	   html-to-texinfo-warning
	   html-to-texinfo-info))
	 (b (generate-new-buffer html2texi-log-buffer-name)))
    (display-buffer b)
    (with-current-buffer b
      (compilation-mode)
      b)))

(defun html2texi-fatal-error (format-str xml-expr &rest args)
  (setq html2texi-log-buffer (if (buffer-live-p html2texi-log-buffer)
				 html2texi-log-buffer
				 (html2texi-generate-log-buffer)))
  (display-buffer html2texi-log-buffer)

  (let ((line-number (line-number-at-pos)))
    (with-current-buffer html2texi-log-buffer
      (let ((inhibit-read-only t))
	(insert (aref html2texi-log-error-names 0) ":"
		(html2texi-current-file html2texi-files-to-do) ":"
		(if (eq xml-expr :html2texi-generic-error)
		    ""
		  (format "%d:" (+ line-number html2texi-line-delta)))
		(apply
		 'format
		 (concat format-str
			 "\n"
			 (aref html2texi-log-error-names 3)
			 ": <<<-----------\n"
			 (aref html2texi-log-error-names 3)
			 ": xml-expr=%S\n"
			 (aref html2texi-log-error-names 3)
			 ": xml-stack=%S\nInfo: ----------->>>\n")
		 `( ,@args ,xml-expr ,html2texi-xml-stack)) ?\n)))
    (apply 'error format-str args)))

(defmacro html2texi-with-log (&rest body)
  `(progn
     (setq html2texi-log-buffer (if (buffer-live-p html2texi-log-buffer)
				    html2texi-log-buffer
				    (html2texi-generate-log-buffer)))
     (display-buffer html2texi-log-buffer)
     (let ((line-number (line-number-at-pos)))
       (with-current-buffer html2texi-log-buffer
	 (let ((inhibit-read-only t))
	   ,@body)))))


(defun html2texi-error (format-str xml-expr &rest args)
  (html2texi-with-log
   (insert (aref html2texi-log-error-names 1) ":"
	   (html2texi-current-file html2texi-files-to-do) ":"
	   (if (eq xml-expr :html2texi-generic-error)
	       ""
	     (format "%d:" (+ line-number html2texi-line-delta)))
	   " "
	   (apply 'format format-str args) ?\n)))

(defun html2texi-warning (format-str xml-expr &rest args)
  (html2texi-with-log
   (insert (aref html2texi-log-error-names 2) ":"
	   (html2texi-current-file html2texi-files-to-do)":"
	   (if (eq xml-expr :html2texi-generic-error)
	       ""
	     (format "%d:" (+  line-number html2texi-line-delta)))
	   (apply 'format format-str args) ?\n)))

(defun html2texi-info (format-str xml-expr &rest args)
  (html2texi-with-log
   (insert (aref html2texi-log-error-names 3) ":"
	   (html2texi-current-file html2texi-files-to-do)":"
	   (if (eq xml-expr :html2texi-generic-error)
	       ""
	     (format "%d:" (+  line-number html2texi-line-delta)))
	   (apply 'format format-str args) ?\n)))

(defun html2texi-decode-url (url)
  "Décode les `%20' et autres séquences hexadécimale"
  (with-temp-buffer
    (insert url)
    (goto-char (point-min))
    (while (re-search-forward "%\\([[:xdigit:]]\\{2\\}\\)" nil t)
      (replace-match (string (math-read-radix
			       (match-string-no-properties 1) 16)) t t))
    (when (eq html2texi-url-encoding :html2texi-utf-8)
      (accents-de-utf-8))
    (buffer-substring (point-min) (point-max))))

(defun html2texi-process-url (url text)
  (let* ((parsed-url (url-generic-parse-url (html2texi-decode-url url)))
	 url-list
	 i file-name locator)
    ;; petit hack parce que url-generic-parse-url ne fait pas complètement le
    ;; boulot
    (when (and
	   (null  (aref parsed-url 1))
	   (setq i (string-match "#" (aref parsed-url 6)))
	   (null (aref parsed-url 7)))
      (aset parsed-url 7 (substring (aref parsed-url 6) (1+ i)))
      (aset parsed-url 6 (substring (aref parsed-url 6) 0 i)))

    (push "@uref{" url-list) ; ça peut être défait ensuite
    ;; URL
    (if (and (eq (aref parsed-url 0)
		 'cl-struct-url)
	     (null (aref parsed-url 1)))
	;; cas où il n'y a pas de protocole
	(cond
	 ;; on point vers un fichier HTML, ce n'est donc pas une URL interne
	 ;; => cas suspect
	 ((member (file-name-extension
		   (setq file-name (aref parsed-url 6)))
		  '("html" "htm"))
	  (setq file-name (expand-file-name
			   file-name
			   (file-name-directory (html2texi-current-file html2texi-files-to-do))))
	  (html2texi-add-file-to-do html2texi-files-to-do file-name)
	  (when (aref parsed-url 7)
	    (setq file-name (concat file-name "#" (aref parsed-url 7))))
	  (push (html2texi-string-escape file-name) url-list))

	 ;; cas d'une URL interne
	 ((and (string= "" file-name)
	       (setq locator (aref parsed-url 7)))
	  (pop url-list)
	  (push "@ref{" url-list)
	  (push (html2texi-make-anchor (concat "#" locator)) url-list))

	  (t
	    (push (html2texi-string-escape url) url-list)))
        (push (html2texi-string-escape url) url-list))
     ;; Text
     (when text
       (push "," url-list)
       (push (html2texi-string-escape text) url-list))
     (push "}" url-list)
     (apply 'insert (nreverse url-list))))

(defun html2texi-tag-handler-center (xml-expr)
  (let ((start-point (point))
	(start-ln (line-number-at-pos))
	end-mark)
    (html2texi-process-xml-expr xml-expr)
    (when (and (<= (point) (+ start-point html2texi-@center-max-size))
	       (> (point) start-point)
	       ;; test histoire que le code soit à l'épreuve du temps : il se
	       ;; pourrait qu'on soit déjà centré pour une autre raison.
	       (null (save-excursion
		       (goto-char start-point)
		       (looking-at "\\(\n\\|\\s-\\)*@center\\>")))
	       (let (to-do
		     (ok t)
		     xml-expr
		     (l (cdr-safe (cdr-safe xml-expr))))
		 (while (and ok (or to-do l))
		   (if l
		       (progn
			 (setq xml-expr (pop l))
			 (cond
			  ((stringp xml-expr))
			  ((and (consp xml-expr)
				(memq (car xml-expr) html2texi-allowed-markup-in-@center))
			   (push xml-expr to-do))
			  (t (setq ok nil))))
		     (setq l (cdr-safe (cdr-safe (pop to-do))))))
		 (when ok
		   (setq end-mark (point-marker))
		   (goto-char start-point)
		   (insert "\n@center ")
		   (while (search-forward "\n" end-mark t)
		     (delete-char -1)
		     (insert 32))
		   (goto-char end-mark)
		   (set-marker end-mark nil)))))))

(html2texi-make-simple-markup-handler i)

(defun html2texi-tag-handler-li (xml-expr)
  (insert "\n@item\n")
  (unless (memq (caadr html2texi-xml-stack) '(ol ul))
    (html2texi-fatal-error "<li> était inattendu." xml-expr ))
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-link (xml-expr)
  )

(defun html2texi-tag-handler-ol (xml-expr)
  (insert "\n@enumerate")
   (html2texi-process-xml-expr xml-expr)
  (insert "\n@end enumerate\n"))

(defun html2texi-tag-handler-p (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(defun html2texi-tag-handler-tbody (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-thead (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-tfoot (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-ul (xml-expr)
  (insert "\n@itemize")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n@end itemize\n"))

(defun html2texi-tag-handler-span (xml-expr)
  (insert "@c span: (<span #1>#2</span> => #2.")
  (html2texi-default-handling xml-expr "span: ")
  (html2texi-process-xml-expr xml-expr)
  (insert "@c span: )\n"))

(defun html2texi-tag-handler-style (xml-expr)
  )

(defun html2texi-tag-handler-meta (xml-expr)
  (unless (and (nth 1 html2texi-xml-stack)
	       (eq (caadr html2texi-xml-stack) 'head))
    (html2texi-fatal-error "<meta> inattendu." xml-expr))
  ;; traitement du meta...
  (let* ((attribute-list (nth 1 xml-expr))
	 (http-equiv (assq 'http-equiv attribute-list))
	 (name (assq 'name attribute-list))
	 (content (assq 'content attribute-list)))
    (cond
     ((and (consp name)
	   (consp content)
	   (progn
	     (setq name (cdr name)
		   content (cdr content))
	     (stringp name))
	   (stringp content))
      (cond
       ((string= name "author")
	(html2texi-set-doc-info 'author content))
       ((string= name "language")
	(when (string-match "\\`\\([a-z]\\{2\\}\\(-[A-Z]\\{2\\}\\)?\\)\\'" content)
	  (let ((language (match-string-no-properties 1 content)))
	    (when (= (length language) 5)
	      (aset language 2 ?_))
	    (html2texi-set-doc-info 'language language))))))
     ((and (consp http-equiv)
	   (consp content)
	   (progn (setq http-equiv (cdr http-equiv))
		  (stringp http-equiv))
	   (progn (setq content (cdr content))
		  (stringp content)))
      (setq http-equiv (downcase http-equiv))
      (cond
       ((and (string= http-equiv "content-type")
	     (string-match "charset\\s-*=\\s-*\\([-a-z0-9]+\\)" content))
	(html2texi-set-doc-info 'content-type-charset (match-string-no-properties 1 content)));
       )))))

(defun html2texi-tag-handler-pre (xml-expr)
  (let ((kes html2texi-keep-empty-strings))
    (setq html2texi-keep-empty-strings t)
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-keep-empty-strings kes)))

(defun hmtl2texi-to-plain-text (xml-expr &rest flags)
  (let (ret anchor)
    (dolist (xml-expr (cddr xml-expr))
      (cond
       ((stringp xml-expr)
	(push xml-expr ret))
       ((consp xml-expr)
	(push xml-expr html2texi-xml-stack)
	(cond
	 ((and (eq (car xml-expr) 'a)
	       (setq anchor (assq 'name (nth 1 xml-expr))))
	  (push (html2texi-make-anchor (concat "#" (cdr anchor)))
		html2texi-flushable-anchors) ))
	(let ((str  (hmtl2texi-to-plain-text xml-expr)))
	  (and (null (string= str ""))
	       (push str ret)))
	(pop html2texi-xml-stack))
       (t (html2texi-fatal-error "Expression XML inattendue." xml-expr))))
    (setq  ret (mapconcat 'identity (nreverse ret) " "))
    (if (memq :one-line flags)
	(mapconcat 'identity (split-string ret "\n") " ")
      ret)))


(defun html2texi-tag-handler-title (xml-expr)
  (unless (and  (nth 1 html2texi-xml-stack)
		(eq  (caadr html2texi-xml-stack) 'head))
    (html2texi-fatal-error "<title> inattendu." xml-expr))
  (setq xml-expr (cddr xml-expr))
  (let ((str  (hmtl2texi-to-plain-text xml-expr)))
    (setq str (split-string str "\n")
	  str (mapconcat 'identity str " "))
    (unless (string= str "")
      (html2texi-set-doc-info 'title str))))

(defun html2texi-string-escape (str &optional flatten)
  (cond
   ((stringp str)
    (with-temp-buffer
      (insert str)
      (goto-char (point-min))
      (while (re-search-forward "[,@{}]" nil t)
	(cond
	 ((string= (match-string-no-properties 0) ",")
	  (replace-match "@comma{}"))
	 ((member (match-string-no-properties 0) '("@" "{" "}"))
	  (replace-match (concat "@" (match-string-no-properties 0))))))
      (when flatten
	(goto-char (point-min))
	(while (re-search-forward "\n\\(\\s-*\\)" nil t)
	  (replace-match (if (> 0 (length (match-string 1))) " " "") t t)))
      (buffer-substring (point-min) (point-max))))
   ((and (consp str) (car-safe str))
    (cond
     ((eq (car str) 'span)
      (with-temp-buffer
	(insert "@c span: (<span #1>#2</span> => string-escape of #2.")
	(html2texi-default-handling str "span: ")
	(insert (html2texi-string-escape  (nth 2 str) flatten))
	(insert "@c span: )\n")
	(buffer-substring (point-min) (point-max))))
     (t (html2texi-fatal-error "Une chaîne était attendue" :html2texi-generic-error str))))
   (t  (html2texi-fatal-error "Une chaîne était attendue" :html2texi-generic-error str))))

(defun html2texi-tag-handler-img (xml-expr)
  (let (filename width height alttext extension)
    (dolist (x (cadr xml-expr))
      (cond
       ((eq (car x) 'src)
	(setq filename (cdr x)))
       ((eq (car x) 'alt)
	(setq alttext (cdr x)))))
    (unless filename
      (html2texi-fatal-error "src=... était attendu" xml-expr))
    (setq filename (html2texi-decode-url filename))
    (setq extension (file-name-extension filename)
	  filename (file-name-sans-extension filename))
    (when (member extension '("png" "jpg" "jpeg" "eps" "txt"))
      (setq extension nil))
    (insert "@image{" (html2texi-make-anchor filename (symbol-function 'identity)))
    (let ((remainder (list width height alttext extension)))
	(while remainder
	  (if (let (non-empty)
		(mapc (lambda (x) (setq non-empty (or non-empty (stringp x))))
		      remainder)
		non-empty)
	      (insert "," (or (pop remainder) "") )
	    (setq remainder nil); rompt la boucle (while remainder...)
	    ))
	(insert "}"))))

(defun html2texi-set-doc-info (tag val)
  "Configure pour l'étiquette TAG la valeur VAL concernant les
informations globales au documents. Ces informations concernent
notamment la langue et l'encodage du document."
  (let ((info (assq tag html2texi-document-information)))
    (if info
	(setcdr info val)
      (push (cons tag val) html2texi-document-information))))

(defun html2texi-tag-handler-head (xml-expr)
  (unless html2texi-ignore-head
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-ignore-head t)))

(defun html2texi-tag-handler-noframes (xml-expr)
  )

(if (boundp 'html2texi-handler-hash-table)
    (makunbound 'html2texi-handler-hash-table))

(defconst html2texi-handler-hash-table
  (let ((ht (make-hash-table)))
    (dolist (v '(a b body center code dfn dl dt dd em i kbd li p
    hr div ol ul pre head meta title frameset frame noframes span
    strong table tbody thead tfoot th tr td h1 h2 h3 h4 h5 h5
    html link br img samp style sup sub tt))
      (puthash v (symbol-function (intern (concat "html2texi-tag-handler-" (symbol-name v))))
	       ht))
    ht)
  "Table de hashage des traitement associé à chaque balise HTML"
  )

(defun html2texi-remove-empty-strings (xml-expr)
  (setq xml-expr (cdr xml-expr))
  (save-match-data
  (while (cdr xml-expr)
    (if (and (stringp (cadr xml-expr))
	     (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'" (cadr xml-expr)))
	(setcdr xml-expr (cddr xml-expr))
      (setq xml-expr (cdr xml-expr))))))

(defun html2texi-process-xml-expr (xml-expr)
  (push xml-expr html2texi-xml-stack)
  (dolist (xml-expr (cddr xml-expr))
    (cond
     ((consp xml-expr)
      (push xml-expr html2texi-xml-stack)
      (let ((handler (gethash (intern (downcase (symbol-name (car xml-expr))))
			      html2texi-handler-hash-table)))
	(if handler
	    (funcall handler  xml-expr)
	  (html2texi-default-handling xml-expr)))
      (pop html2texi-xml-stack))
     ((stringp xml-expr)
      (and (or html2texi-keep-empty-strings
	       (null (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'"  xml-expr)))
	   (insert (html2texi-handle-string xml-expr))))
     (t (error "Expression XML inattendue %S" xml-expr))))
  (pop html2texi-xml-stack))

(defun html2texi-default-handling (xml-expr &optional prompt)
  (let ((str (split-string (prin1-to-string xml-expr) "\n")))
    (dolist (str-line str)
      (insert "\n@c " (or prompt "") str-line)))
    (insert "\n"))

(defun html2texi-process-region (beg end)
  (goto-char end)
  (let ((end (point-marker))
	is-xhtml
	re-do
	xml-expr)

    ;; Suppression de tout ce qui est en dehors des balise <html> ... </html>
    (goto-char beg)
    (setq html2texi-line-delta (line-number-at-pos))
    (setq is-xhtml
	  (looking-at "[ \t\n\r]*<!DOCTYPE[ \t\n\r]+html[ \t\n\r]+PUBLIC[ \t\n\r]+\"-//W3C//DTD XHTML"))
    (unless (re-search-forward "<html" end t)
      (html2texi-fatal-error "Balise <html> non trouvée" xml-expr))
    (setq html2texi-line-delta (- (line-number-at-pos) (* 2 html2texi-line-delta)))
    (delete-region beg (match-beginning 0))
    (unless (re-search-forward ">" end t)
      (html2texi-fatal-error "Clôture de la balise <html> trouvée" xml-expr))
    (unless  (re-search-forward "</html" end t)
      (html2texi-fatal-error "Balise </html> non trouvée trouvée" xml-expr))
    (unless (re-search-forward ">" end t)
      (html2texi-fatal-error "Clôture de la balise </html> trouvée" xml-expr))
    (delete-region (match-end 0) end)

    (or is-xhtml
	(html2texi-make-html-clean-xml beg end))

    (setq xml-expr
	  (condition-case
	      sig
	      (xml-parse-region beg end)
	    (error
	     (if (consp sig)
		 (html2texi-warning "File is XHTML but xml-parser reported error `%S'"
				 :html2texi-generic-error
				 (cdr sig))
	       (html2texi-warning "File is XHTML but xml-parser reported errors"
				  :html2texi-generic-error))
		  (if is-xhtml :html2texi-redo nil)))
	  xml-expr
	  (if (eq xml-expr :html2texi-redo)
	       (progn
		 (html2texi-make-html-clean-xml beg end)
		 (xml-parse-region beg end))
	     xml-expr))

    (delete-region beg end)
    (set-marker end nil)
    xml-expr))

(if t
;; plus partique pour déboguer qu'un vrai tampon temporaire
    (defmacro html2texi-with-temp-buffer (&rest body)
      (let ((cur-buff (make-symbol "cur-buff")))
	`(with-current-buffer
	       (let (( ,cur-buff (get-buffer "*HTML2TEXI Temp*")))
		 (and ,cur-buff (kill-buffer ,cur-buff))
		 (get-buffer-create "*HTML2TEXI Temp*"))
       (erase-buffer)
       ,@body)))
  ;;
  (defmacro html2texi-with-temp-buffer (&rest body)
    `(with-temp-buffer ,@body)))



(defun html2texi-make-texi-buffer (&optional buffer )
  (let* ((start-buffer (or buffer (current-buffer)))
	 xml-expr
	 (start-filename  (or (buffer-file-name start-buffer) (buffer-name)))
	 (start-filename-ext (file-name-extension start-filename))
	 (texi-buffer-name
	  (concat (concat  (file-name-sans-extension   (file-name-nondirectory start-filename))
			    ".texi")))
	 done-links-list
	 texi-buffer)
    (unless (or (member start-filename-ext '("html" "htm"))
		(y-or-n-p (format "le tampon %s n'a pas une extension html, continuer?"
				  start-filename)))
      (error "Fichier sans extension html"))
    (setq texi-buffer (get-buffer-create texi-buffer-name))
    (set-buffer texi-buffer)
    (erase-buffer)
    (dolist (v html2texi-texi-buffer-local-variables)
      (set (make-local-variable v) nil))
    (push (cons default-directory "./") html2texi-directory-stack)
    (setq html2texi-directory-ref default-directory)
 (html2texi-add-file-to-do html2texi-files-to-do start-filename)
    (while (html2texi-files-has-to-do html2texi-files-to-do)
      (setq file-name (html2texi-get-next-file-next-to-do html2texi-files-to-do))
      (if (file-exists-p file-name)
	  (progn
	    (let* ((dir (file-name-as-directory
			 (file-name-directory file-name)))
		   (rel-dir   (let ((d
				     (file-name-directory
				      (file-relative-name file-name html2texi-directory-ref))))
				(if d (file-name-as-directory d)
				  "./"))))
	      (push (cons dir rel-dir) html2texi-directory-stack)
	      (html2texi-with-temp-buffer
	       (insert-file-contents file-name)
	       (accents-de-html)
	       (html2texi-make-html-clean-xml (point-min) (point-max))
	       (setq xml-expr (html2texi-process-region (point-min) (point-max))))
	      (unless (eq 'html (caar xml-expr))
		(html2texi-fatal-error "Résultat d'analyse XML inattendu" xml-expr))
	      (setq xml-expr (car xml-expr))
	      (html2texi-process-xml-expr xml-expr)
	      (pop html2texi-directory-stack)	))
	(html2texi-warning "Le fichier `%s' n'existe pas!" :html2texi-generic-error file-name)))))

(defun html2texi-insert-doc-info ()
  (let ((author
	 (html2texi-string-escape
	  (or (cdr-safe (assq 'author html2texi-document-information)) "AUTHOR")))
	(title 	 (html2texi-string-escape
		  (or (cdr-safe (assq 'title html2texi-document-information)) "TITLE")))
	(language 	 (let ((language  (cdr-safe (assq 'language html2texi-document-information))))
			   (if language (cons "" (html2texi-string-escape language))
			     (cons "@c " "LANGUAGE"))))
	(encoding  (html2texi-string-escape
			  (or (cdr-safe (assq 'content-type-charset html2texi-document-information))
			      "iso-8859-1"))))

    (goto-char (point-min))
    (insert "\\input texinfo   @c -*-mode:texinfo; coding:" (downcase encoding) "-*-
@setfilename " (file-name-sans-extension (buffer-name)) ".info
" (car language) "@documentlanguage " (cdr language) "
@documentencoding "  (if (let ((case-fold-search t))
			   (string-match "\\`\\(us\\|utf\\|iso\\)" encoding))
			 (upcase encoding) encoding) "
@copying
This manual is for PROGRAM, version VERSION.

Copyright @copyright{} YEARS COPYRIGHT-OWNER.

@quotation
Permission is granted to ...
@end quotation
@end copying

@titlepage
@title " title "@c NAME-OF-MANUAL-WHEN-PRINTED
@c @subtitle SUBTITLE-IF-ANY
@c @subtitle SECOND-SUBTITLE
@author " author "

@c  The following two commands
@c  start the copyright page.
@page
@vskip 0pt plus 1filll
@insertcopying

Published by ...
@end titlepage

@c So the toc is printed at the start.
@contents

@ifnottex
@node Top
@top TITLE

This manual is for PROGRAM, version VERSION.
@end ifnottex
")
    (goto-char (point-max))
    (insert "
@bye") ))

(defun html2texi-post-process ()
  "Remplace les double lignes vides en ligne vides simples."
  (goto-char (point-min))
  (while (re-search-forward "\\(^[ \t]*\n\\)\\{2,\\}" nil t)
    (replace-match "\n"))
  (normal-mode))

;;;###autoload
(defun html2texi ()
  (interactive)
  (let (html2texi-keep-empty-strings
	html2texi-xml-stack
	(html2texi-line-delta 0)
	html2texi-ignore-head
	html2texi-directory-stack
	html2texi-flushable-anchors
	html2texi-directory-ref
	(html2texi-files-to-do (html2texi-files-to-do-listing "À traiter"))
	(html2texi-log-buffer (and html2texi-reuse-log-buffer html2texi-log-buffer)))
  (html2texi-make-texi-buffer)
  (html2texi-insert-doc-info)
  (html2texi-post-process)
  (html2texi-info "Fin de la conversion en HTML !" :html2texi-generic-error )))

;; Log compilation mode stuff
(defun html2texi-define-error-regexps ()
  (dolist (v `(
	       (html-to-texinfo-error
		.
		(
		 ,(concat "^" (regexp-opt (list (aref html2texi-log-error-names 0)
						(aref html2texi-log-error-names 1)))
			  ":\\(" html2texi-filepath-re
			  "\\):\\(?:\\([0-9]+\\):\\)?.*$")
		 1; File
		 2; Line
		 0; Error
		 ))
	       (html-to-texinfo-warning
		.
		(
		 ,(concat "^" (aref html2texi-log-error-names 2)
			  ":\\(" html2texi-filepath-re
			  "\\):\\(?:\\([0-9]+\\):\\)?.*$")
		 1; File
		 2; Line
		 1; Warning
		 ))
	       (html-to-texinfo-info
		.
		(
		 ,(concat "^" (aref html2texi-log-error-names 3)
			  ":")
		 nil; File
		 nil; Line
		 2; Warning
		 ))))
    (add-to-list 'compilation-error-regexp-alist (car v))
    (let ((cell (or (assq (car v) compilation-error-regexp-alist-alist)
		    (car (push (cons  (car v) nil) compilation-error-regexp-alist-alist)))))
      (setcdr cell (cdr v))  )))
(html2texi-define-error-regexps)

;;; html-to-texinfo.el ends here

Revision-number: 21
Prop-content-length: 112
Content-length: 112

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2012-02-20T21:07:15.000000Z
K 7
svn:log
V 10
Creation.

PROPS-END

Node-path: trunk/lisp/doubly-linked-list.el
Node-kind: file
Node-action: add
Prop-content-length: 10
Text-content-length: 6178
Text-content-md5: 907ed33ba3c0a635b9a61aea5531b38b
Content-length: 6188

PROPS-END
;;; doubly-linked-list.el --- -*- coding: iso-8859-1 -*-
;; Copyright 2012 Vincent Belaïche
;;
;; Author: Vincent Belaïche <vincentb1@users.sourceforge.net>
;; Version: $Id: doubly-linked-list.el,v 1.1 2012-02-20 21:07:15 Vincent Exp $
;; Keywords: 
;; X-URL: not distributed yet

;; 
;; This software is governed by the CeCILL license under French law and
;; abiding by the rules of distribution of free software.  You can  use, 
;; modify and/ or redistribute the software under the terms of the CeCILL
;; license as circulated by CEA, CNRS and INRIA at the following URL
;; "http://www.cecill.info". 
;; 
;; As a counterpart to the access to the source code and  rights to copy,
;; modify and redistribute granted by the license, users are provided only
;; with a limited warranty  and the software's author,  the holder of the
;; economic rights,  and the successive licensors  have only  limited
;; liability. 
;; 
;; In this respect, the user's attention is drawn to the risks associated
;; with loading,  using,  modifying and/or developing or reproducing the
;; software by the user in light of its specific status of free software,
;; that may mean  that it is complicated to manipulate,  and  that  also
;; therefore means  that it is reserved for developers  and  experienced
;; professionals having in-depth computer knowledge. Users are therefore
;; encouraged to load and test the software's suitability as regards their
;; requirements in conditions enabling the security of their systems and/or 
;; data to be ensured and,  more generally, to use and operate it in the 
;; same conditions as regards security. 
;; 
;; The fact that you are presently reading this means that you have had
;; knowledge of the CeCILL license and that you accept its terms.
;; 
;;; Commentary:

;; 

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'doubly-linked-list)

;;; Code:
(require 'eieio)
(eval-when-compile
  (require 'cl))



;;;;##########################################################################
;;;;  User Options, Variables
;;;;##########################################################################

(defclass doli2-list ()
  ((head
    :initarg :head
    :initform nil
    :documentation "Pointe sur le premier élément de la liste si
   la liste est non-vide.")  
   (tail
    :initarg :tail
    :initform nil
    :documentation "Pointe sur le dernier élément de la liste si
    la liste est non vide.")
   (size
    :initarg :size
    :initform 0
    :documentation "Nombre d'éléments de la liste."))
  :documentation "Liste doublement chaînée.")

(defclass doli2-element ()
  ((next 
    :initarg :next
    :initform nil
    :type (or null doli2-element) 
    :documentation "Élément suivant dans la liste, `nil' pour le
    dernier élément.")
   (previous
    :initarg :previous
    :initform nil
    :type (or null doli2-element)
    :documentation "Élément précédent dans la liste, `nil'
    pour le dernier élément."  )) 
  :abstract t
  :documention "Classe de base pour les éléments d'objets de classe
  `doli2-list'.")

(defgeneric doli2-equal ((this doli2-element) (other doli2-element))
  "Comparaison de deux `doli2-element'.")

(defmethod doli2-add-first
  ((this doli2-list)
   (elt doli2-element))
  "Ajoute un nouvel élément en tête de liste."
  (when 
      (or (oref elt :next)
	  (oref elt :previous))
    (error "L'élément est déjà dans une liste"))
  (let ((size (oref this :size)))
    (if (= 0 size)
	(progn
	  (oset this :head elt)
	  (oset this :tail elt)
	  (oset this :size 1))
      (let ((head  (oref this :head)))
	(oset elt :next head)
	(oset head :previous elt))
      (oset this :size (1+ size)))))
  
(defmethod doli2-add-last
  ((this doli2-list)
   (elt doli2-element))
  "Ajoute un nouvel élément en queue de liste."
  (when 
      (or (oref elt :next)
	  (oref elt :previous))
    (error "L'élément est déjà dans une liste"))
  (let ((size (oref this :size)))
    (if (= 0 size)
	(progn
	  (oset this :head elt)
	  (oset this :tail elt)
	  (oset this :size 1))
      (let ((tail  (oref this :tail)))
	(oset elt :previous tail)
	(oset tail :next elt))
      (oset this :size (1+ size)))))

(defmethod doli2-remove
  ((this doli2-list)
   (elt doli2-element))
  "Retranche `elt' de la liste `this'."
  (let ((size (oref this :size)))
  (cond
   ((<= 0 size)
    (error "Liste vide %S" this))
   ((= 1 size)
    (oset this :head nil)
    (oset this :tail nil)
    (oset this :size 0))
   ((eq (oref this :head) elt)
    (let ((next (oref elt :next)))
      (oset this :head next)
      (oset this :size (1- size))
      (oset elt :previous nil)
      (oset elt :next nil)))
   ((eq (oref this :tail) elt)
    (let ((previous (oref elt :previous)))
      (oset this :tail previous)
      (oset this :size (1- size))
      (oset elt :previous nil)
      (oset elt :next nil)))
   (t
    (let ((next (oref elt :next))
	  (previous (oref elt :previous)))
      (oset elt :next nil)
      (oset elt :previous nil)
      (oset this :size (1- size))
      (oset next :previous previous)
      (oset previous :next next))))))

(defmethod doli2-remove-first 
  ((this doli2-list))
  "Retranche le premier élément de la liste `this'. Génère une
erreur si la liste est vide."
  (let ((ret (oref this :head))
	(size (1- (oref this :size))))
    (if (> 0 size)
	(error "Liste vide")
      (oset this :size size)
      (if (< 0  size)
	  (oset this :head (oref ret :next))
	(oset this :head nil)
	(oset this :tail nil)))
     (oset ret :next nil)
     ret))

(defmacro doli2-.>x-dolist (spec &rest body)
  "(doli2-.>x-dolist (FROM TO) BODY) itère sur BODY depuis FROM
inclus, jusqu'à TO exclus en parcourant la liste dans le sens normal."
  `(while (null (eq ,(car spec) ,(cadr spec)))
     ,@body
     (setq ,(car spec) (oref ,(car spec) :next))))

(defmacro doli2-x<.-dolist (args &rest body)
  "(doli2-.>x-dolist (FROM TO) BODY) itère sur BODY depuis FROM
inclus, jusqu'à TO exclus dans le sens inverse."
  `(while (null (eq ,(car spec) ,(cadr spec)))
      ,@body
      (setq ,(car spec) (oref ,(car spec) :previous))))))

(provide 'doubly-linked-list)

;;; doubly-linked-list.el ends here


Revision-number: 22
Prop-content-length: 406
Content-length: 406

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2012-02-20T21:10:07.000000Z
K 7
svn:log
V 303
Ajout de la génération des @node

Ajout de l'embellissement des locator (pas encore abouti)

Correction des problèmes sur les @ref internes lorsqu'on a une @ref interne mais qui n'a pas encore été génére
on met quand même @ref et pas @uref, en se basant sur un test file-exists.

PROPS-END

Node-path: trunk/lisp/html-to-texinfo.el
Node-kind: file
Node-action: change
Text-content-length: 66818
Text-content-md5: 7077f8e01c8ffa9b001d8cd2676b070d
Content-length: 66818

;;; html-to-texinfo.el --- -*- coding: iso-8859-1 -*-
;; Copyright 2010/2012 Vincent Belaïche
;;
;; Author: Vincent Belaïche <vincent.b.1@hotmail.fr>
;; Version: $Id: html-to-texinfo.el,v 1.12 2012-02-20 21:10:07 Vincent Exp $
;; Keywords: Texinfo, HTML, conversion
;; X-URL: not distributed yet
;;
;; This software is governed by the CeCILL license under French law and
;; abiding by the rules of distribution of free software.  You can  use,
;; modify and/ or redistribute the software under the terms of the CeCILL
;; license as circulated by CEA, CNRS and INRIA at the following URL
;; "http://www.cecill.info".
;;
;; As a counterpart to the access to the source code and  rights to copy,
;; modify and redistribute granted by the license, users are provided only
;; with a limited warranty  and the software's author,  the holder of the
;; economic rights,  and the successive licensors  have only  limited
;; liability.
;;
;; In this respect, the user's attention is drawn to the risks associated
;; with loading,  using,  modifying and/or developing or reproducing the
;; software by the user in light of its specific status of free software,
;; that may mean  that it is complicated to manipulate,  and  that  also
;; therefore means  that it is reserved for developers  and  experienced
;; professionals having in-depth computer knowledge. Users are therefore
;; encouraged to load and test the software's suitability as regards their
;; requirements in conditions enabling the security of their systems and/or
;; data to be ensured and,  more generally, to use and operate it in the
;; same conditions as regards security.
;;
;; The fact that you are presently reading this means that you have had
;; knowledge of the CeCILL license and that you accept its terms.
;;
;;; Commentary:

;;

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'html-to-texinfo)

;;; Code:

(provide 'html-to-texinfo)
(eval-when-compile
  (require 'cl))
(require 'eieio)
(require 'calc-ext)
(require 'accents-ascii)
(require 'doubly-linked-list)
(require 'compile)

;;;;##########################################################################
;;;;  User Options, Variables
;;;;##########################################################################

(defconst html2texi-suspicious-html-tags
  '("meta" "br" "hr" "link" "img" "frame")
"Liste des balises pour lesquelles le HTML ne suit pas une
syntaxe strictement XML. Par exemple `<br>' est utilisé au lieu
de `<br/>'."  )

(defconst html2texi-suspicious-html-tags-re
  (regexp-opt html2texi-suspicious-html-tags))

(defconst html2texi-non-recursive-tags
  '("p" "li"))

(defconst html2texi-hierarchy-list
  '(
    (li (ul ol))
    (tr (table))
    (th (tr))
    (td (tr))
    (dd (dl))
    (dt (dl))  )
  )

(defconst html2texi-non-recursive-tags-re
  (regexp-opt html2texi-non-recursive-tags))

(defconst html2texi-filepath-re
  "\\(?:[A-Za-z]:\\)?[- ~+A-Za-z_0-9./\\]+")

(defconst html2texi-texi-buffer-local-variables
  '(html2texi-document-information)
    "Liste des variables déclarées localement au tampon Texinfo.")

(defconst html2texi-allowed-markup-in-@center
  '(img b i em tt strong dfn code)
  "Liste des balises autorisées pour @center.")

(defconst html2texi-@center-max-size 1000)

(defclass html2texi-simple-markup ()
  ((class-dependant
    :initarg :class-dependant
    :initform nil
    :custom '(repeat
	  (list
	   (regexp :tag "clef")
	   (string :tag "prologue")
	   (string :tag "épilogue")
	   (boolean :tag "conserver les espaces et retours chariot")
	   ))
    :documentation "\
Liste d'association dont les éléments sont de la forme
 (CLEF PROLOGUE ÉPILOGUE)

Supposons que l'objet décrit le traitement de la balise TAG,
alors lorsque le code HTML `<TAG class=\"CLEF\">CONTENU</TAG>'
est rencontré, alors il est convertie en le code Texinfo
`PROLOGUE TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU.")
   (preamble
    :initarg :preamble
    :type string
    :documentation "\
Prologue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (postamble
    :initarg :postamble
    :type string
    :documentation "\
Épilogue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (space-verb
    :initarg :space-verb
    :initform nil
    :type boolean
    :documentation "\
Vrai lorsque les espaces et retours chariot sont à conserver tels quels."
    ))
  :documentation "\
Un object de type `html2texi-simple-markup'
décrit le traitement d'une balise simple comme par exemple
<code>.")

(defclass html2texi-locator-info (doli2-element)
 ((id
   :initarg :id
   :type string
   :documentation "Identifiant d'ancre.")
  (type
   :initarg :type
   :type symbol
   :documentation "Soit `:html2texi-@anchor', `:html2texi-@ref',
   ou `:html2texi-@node'."  )
  (position
   :initarg :position
   :type integer
   :documention "Point dans le tampon Texinfo où l'ancre est utilisée."))
:documentation "Détient l'information concernant une ancre
utilisée soit par un `@anchor', soit un `@node', soit un
`@ref'.")

(defclass html2texi-locator-listing (doli2-list)
  ((hash-table
    :initarg :hash-table))
  :documentation "Liste de `html2texi-locator-info', c'est à dire
    de pointeurs sur des `@node', `@ref' ou `@anchor', de sorte à
    embellir les nom d'ancre a postériori."  )

(defmethod initialize-instance ((this html2texi-locator-listing) &rest fields)
  (call-next-method)
  (oset this :hash-table (make-hash-table :test 'string=)))

(defmethod html2texi-add-locator ((this html2texi-locator-listing) locator-info)
  (let* ((locator-id (oref locator-info :id))
	 (table (oref this :hash-table))
	 (previous  (oref this :locator-info-list)))
    (oset locator-info :previous previous)
    (oset this :locator-info-list (cons locator-info previous))
    (puthash
     locator-id
     (cons locator-info (gethash locator-id table))
     table)))

(defclass html2texi-files-to-do-listing ()
  ((already-to-do
   :initarg :already-to-do
   :initform nil
   :documentation "Liste des fichiers qui ont été trouvés comme
   étant à traiter lors du traitement d'un fichier qui a déjà été
   complètement traité.")
   (doing-or-done
    :initarg :doing-or-done
    :initform nil
    :documentation "Liste des fichiers qui ont déjà été traités, le
    premier de la liste est le fichier en cours de traitement."
    )
   (added-file-count
    :initarg :added-file-count
    :initform 0
    :documentation "Nombre de fichier qui est été ajouté à la
  liste des fichiers à traiter.")
   (soon-to-do
   :initarg :soon-to-do
   :initform nil
   :documentation "Liste des fichiers qui sont trouvés comme
   étant à traiter lors du traitement du fichier en cours de
   traitement."))
  :documentation "Objet servant à lister les fichiers à
  traiter. Il comprend deux listes: `already-to-do' et
  `soon-to-do' parce que lors du traitement d'un fichier TOTO les
  nouveaux fichiers à traiter sont mis dans `soon-to-do' dans
  l'ordre où ils sont rencontrés, du coup une fois que le fichier
  TOTO a complètement été traité, on inverse cet ordre en
  transvasant le contenu de `soon-to-do' dans `already-to-do'.")

(defclass html2texi-table-fmt-ctxt ()
  ((col-number
    :initarg :col-number
    :initform 0
    :type integer)
   (row-number
    :initarg :row-number
    :initform 0
    :type integer)
   (head-on-row-0
    :initarg :head-on-row-0
    :initform nil
    :type boolean)
   (force-head
    :initarg :force-head
    :initform nil
    :type boolean)
   (col-count
    :initarg :col-count
    :initform 0
    :type integer
    :documentation
    "Nombre de colonnes dans le tableau.")
   (col-info
    :initarg :col-info
    :documentation
    "Liste d'information sur chaque colonne. Le premier élément
    est factice est ne correspond à aucune colonne.")
   (col-info-last
    :initarg :col-info-last
    :documentation
    "Pointe sur la dernière cons-cell de l'attribut `:col-info'.")
   (col-info-length
    :initarg :col-info-length
    :initform 0
    :type integer))
  :documentation "Contexte de formattage d'une table.")

(defmethod initialize-instance ((this html2texi-table-fmt-ctxt) &rest fields)
  (call-next-method)
  (let ((ci (list 0)))
    ;; le premier élément ne correspond pas à une colonne mais servira à
    ;; reduire le vecteur des informations sur chaque colonne
    (oset this :col-info ci)
    (oset this :col-info-last ci)))


(defmethod html2texi-files-has-to-do ((this html2texi-files-to-do-listing))
  (or (oref this :already-to-do)
      (oref this :soon-to-do))  )

(defmethod html2texi-current-file ((this html2texi-files-to-do-listing))
  (car (oref this :doing-or-done)))

(defmethod html2texi-get-next-file-next-to-do  ((this html2texi-files-to-do-listing))
  "Récupère le prochain fichier à traiter. L'appel de cette
méthode si aucun fichier n'est à traiter génère une erreur."
  (let ((soon-to-do (oref this :soon-to-do))
	(already-to-do (oref this :already-to-do)))
    (when soon-to-do
      (while soon-to-do (push (pop soon-to-do) already-to-do))
      (oset this :soon-to-do nil))
    (let ((next (pop already-to-do)))
      (oset this :already-to-do already-to-do)
      (oset this :doing-or-done (cons next (oref this :doing-or-done)))
      next)))

(defmethod html2texi-add-file-to-do   ((this html2texi-files-to-do-listing) next)
  "Ajoute le fichier dont le nom absolu est NEXT à la liste des
fichier à traiter. Renvoie `nil' si le fichier était déjà
connu, non-`nil' sinon."
  (unless (or (member next (oref this :already-to-do))
	      (member next (oref this :doing-or-done))
	      (member next (oref this :soon-to-do)))
    (oset this :soon-to-do (cons next (oref this :soon-to-do)))
    (oset this :added-file-count (1+ (oref this :added-file-count)))))

(defun html2texi-texinfo-inside-comment-p ()
  "Renvoie non nil lorsque le point est dans un commentaire Texinfo."
  (save-match-data
    (save-excursion
      (let ((cur (point))
	    (end (progn (end-of-line) (point))))
	(beginning-of-line)
	(and (re-search-forward "\\(^\\|[^@]\\)@c\\(omment\\)\\_>" end t)
	     (<= (match-beginning 0) cur))))))

(defmethod html2texi-handle-simple-markup
  ((this html2texi-simple-markup) xml-expr)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe
			(and class-attribute
			     (assoc-string (cdr class-attribute)
					   (oref this :class-dependant))))
		      (list (oref this :preamble)
			    (oref this :postamble)))))
    (insert (car pre-post))
    (let ((beg (point))
	  end)
      (html2texi-process-xml-expr xml-expr)
      (unless (oref this :space-verb)
	(setq end (point-marker))
	(goto-char beg)
	(while (re-search-forward "[\n\r]\\s-*" nil end)
	  (let ((replace-str " "))
	    (save-match-data
	      (cond
	       ((html2texi-texinfo-inside-comment-p)
		(setq replace-str nil))))
	      (and replace-str (replace-match replace-str t t)))))
	(goto-char end)
	(set-marker end nil))
    (insert (cadr pre-post))))


(defcustom html2texi-save-texi-buffer-confirm-p
  t
  "`nil' pour sauvegarder sans confirmation le tampon Texinfo
après la conversion, `t' sinon."
  :type '(radio
	  (const :tag "Sans confirmation" nil)
	  (const :tag "Demander confirmation" t))
  :group 'html2texi)

(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-reuse-log-buffer t
  "Mettre à `nil' pour que le tampon de sortie des erreurs &
avertissement soit re-généré avec un nom unique à chaque
traitement."
  :type  '(radio
	  (const :tag "Créer un nouveau tampon d'erreurs à chaque conversion." nil)
	  (const :tag "Réutiliser le tampon d'erreurs s'il existe déjà." t))
  :group 'html2texi)

(defcustom html2texi-url-encoding
  :html2texi-utf-8
  "Sélectionne le codage des URL."
  :type '(radio
	  (symbol :tag "UTF-8" :html2texi-utf-8)
	  (symbol :tag "ISO-8859-1" :html2texi-latin-1))
  :group 'html2texi)

(defcustom html2texi-i-simple-markup
  (html2texi-simple-markup "html2texi-i-simple-markup"
   :preamble "@i{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-b-simple-markup
  (html2texi-simple-markup "html2texi-b-simple-markup"
   :preamble "@b{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-kbd-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :preamble "@kbd{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-dfn-simple-markup
  (html2texi-simple-markup "html2texi-dfn-simple-markup"
   :preamble "@dfn{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-em-simple-markup
  (html2texi-simple-markup "html2texi-em-simple-markup"
   :preamble "@emph{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-sub-simple-markup
  (html2texi-simple-markup "html2texi-sub-simple-markup"
   :preamble ""
   :postamble "")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<sub class=\"CLEF\">CONTENU</sub>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-sup-simple-markup
  (html2texi-simple-markup "html2texi-sup-simple-markup"
   :preamble ""
   :postamble "")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<sup class=\"CLEF\">CONTENU</sup>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-samp-simple-markup
  (html2texi-simple-markup "html2texi-samp-simple-markup"
   :preamble "@samp{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<samp class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-strong-simple-markup
  (html2texi-simple-markup "html2texi-strong-simple-markup"
   :preamble "@strong{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-tt-simple-markup
  (html2texi-simple-markup "html2texi-tt-simple-markup"
   :preamble "@t{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<tt class=\"CLEF\">CONTENU</tt>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-handle-two-columns-table-as-@table
  t
 "Si `nil' alors une table `<table>...</table>'
avec deux colonne sera gérée en texinfo par une `@table', si non
`nil', alors elle sera gérée par une `@multitable'."
  :type
  '(choice
    (const :tag "t pour @table" t)
    (const :tag "nil pour @multitable" nil))
  :group 'html2texi)

(defcustom html2texi-log-error-names
   ["Erreur fatale" "Erreur" "Avertissement" "Info"]
   "Liste des types d'erreur préfixant les messages d'erreur dans
le tampon de sortie des erreurs & avertissement de traitement."
   :type
   '(vector
     (string :tag "Erreur fatale")
     (string :tag "Erreur")
     (string :tag "Avertissement")
     (string :tag "Info"))
   :group 'html2texi  )

(defcustom html2texi-log-buffer-name
  "*HTML2TEXI*"
  "Nom du tampon de sortie des erreurs et avertissements de traitement."
  :type 'string
  :group 'html2texi)

(defcustom html2texi-beautify-locators
  t
  "Embellit les identificateur de localisateur après génération
  du Texinfo."
  :type '(radio
	  (const :tag "Ne pas embellir les identificateurs de localisateur." nil)
	  (const :tag "Embellir les identificateurs de localisateur." t))
  :group 'html2texi )

(defvar html2texi-document-information nil
  "Liste d'association pour mémoriser les informations (titre,
  auteurs, etc...) propres à un document.")

(defvar html2texi-line-delta 0
  "Décalage entre le numéro de ligne du code XML au sein le
  tampon Texinfo en cours de traitement, et son numéro de ligne
  dans le fichier HTML source.")

(defvar html2texi-xml-stack nil
  "Pile des expressions XML")

(defvar html2texi-keep-empty-strings nil
  "Non nil si les chaînes vides sont à conserver.")

(defvar html2texi-ignore-head nil
  "Non nil si on ignore le <head> (dans un fichier HTML lié).")

(defvar html2texi-directory-stack nil
  "Pile des chemins de répertoire.")

(defvar html2texi-files-to-do nil
  "Base des fichiers non encore traités, instanciée localement
  comme un objet de class `html2texi-files-to-do-listing'.")

(defvar html2texi-flushable-anchors nil
  "Liste de nom d'ancrage de lien dont l'insertion a été remise à
  plus tard." )

(defvar html2texi-postpone-output nil
  "Non `nil' lorsque l'insertion du code est remise à plus tard.")

(defvar html2texi-directory-ref nil
  "Répertoire de référence")

(defvar html2texi-log-buffer nil
  "Tampon de sortie des erreurs et avertissements de traitement.")

(defvar html2texi-texi-buffer-name nil
  "Nom du tampon Texinfo généré.")

(defvar html2texi-anchor-list nil
  "Liste des ancres, pour post-traitement d'embellissement des
  identificateur d'ancre.")

(defmacro html2texi-make-simple-markup-handler (tag)
  `(defun ,(intern (concat "html2texi-tag-handler-" (symbol-name tag)))
     (xml-expr)
     (html2texi-handle-simple-markup
      ,(intern (concat "html2texi-"  (symbol-name tag) "-simple-markup"))
      xml-expr) ))

(defun html2texi-make-html-clean-xml (beg end)
  (let  ((end-arg end)
	 end)
    ;; initialisation de end comme un marque
    (if (markerp end-arg)
	(setq end end-arg)
      (goto-char end-arg)
      (setq end (point-marker)))

    ;; rend les balise implicitement auto-closante vraiment auto-closante
    (goto-char beg)
    (while (re-search-forward (concat "<\\(" html2texi-suspicious-html-tags-re "\\)\\>")
			      end t)
      (let ((tag (match-string-no-properties 1)))
	(unless (re-search-forward ">" nil t)
	  (html2texi-fatal-error "Clôture non trouvé pour la balise %s" nil
				 tag))
	(when (null (looking-back "/>"))
	  (backward-char)
	  (insert "/")
	  (forward-char))))

    ;; marque de paragraphe et de ligne
    (goto-char beg)
    (let (tag-stack pos-< pos->
		    tag is-closure self-closing)
      (while (re-search-forward "<\\(/\\)?\\([a-zA-Z]+\\)\\>" end t)
	(setq pos-< (match-beginning 0)
	      tag (match-string-no-properties 2)
	      is-closure (match-string-no-properties 1))
	(unless (string= tag (downcase tag))
	  (replace-match (setq tag (downcase tag)) 2))
	(unless (re-search-forward ">" end t)
	  (html2texi-fatal-error "Soufflet de clôture non trouvé pour la balise %s" nil
		 tag))

	(setq pos-> (point)
	      self-closing (looking-back "/>"))
	(cond
	 ((and self-closing  is-closure)
	  (html2texi-fatal-error "balise %s à la fois de clôture et auto-closante" nil
		 tag))

	 (self-closing
	  ;; do nothing
	  )

	 ((null is-closure)
	  (when (and
		 (string-match (concat "\\`" html2texi-non-recursive-tags-re "\\'") tag)
		 tag-stack
		 (string= tag (caar tag-stack)))
	    ;; clôture
	    (save-excursion
	      (goto-char pos-<)
	      (insert "</" tag "><!-- HTML2TEXI: repaired (1) -->")
	      (html2texi-warning "Ajout clôture `</%s>'" nil tag))
	    (pop tag-stack))
	  (push (list tag) tag-stack))

	 (is-closure
	  (if (and tag-stack
		   (string= (caar tag-stack) tag))
	      (pop tag-stack)
	    (let ((first (assoc-string tag tag-stack)) rev)
	      (if first
		  (progn
		    (while (and tag-stack (null (eq (car tag-stack) first)))
		      (push (pop tag-stack) rev))
		    (pop tag-stack)
		    (save-excursion
		      (goto-char pos-<)
		      (dolist (c rev)
			(insert  "</" (car c) "><!-- HTML2TEXI: repaired (2) -->" )
			(html2texi-warning "Ajout clôture `</%s>'" nil tag))))

		(save-excursion
		  (goto-char pos->)
		  (insert "-->")
		  (goto-char pos-<)
		  (insert "<!-- HTML2TEXI: repaired (3). "))
		(html2texi-warning "Clôture de %s ne correspondant à aucune ouverture" nil tag)))))))


      (let (p-pos li-pos markup poss pos)
	(while (re-search-forward "<\\(/\\)?\\(p\\|li\\)\\>[^>]*>" end t)
	  (setq markup (match-string-no-properties 2)
		poss (intern (concat markup "-pos"))
		pos (symbol-value poss))
	  (if (match-string-no-properties 1)
	      (if  pos
		  (if (= pos (match-beginning 0))
		      (set poss nil)
		    (html2texi-fatal-error "Clôture de balise %s ne correspondant à aucune ouverture" nil
					   (match-string-no-properties 0)))
		(save-excursion
		  (save-match-data
		    (unless  (re-search-forward
			      (format "<\\(/\\)?\\(%s\\)\\>[^>]+>" markup)
			      end t)
		      (html2texi-fatal-error "Ouverture de balise <%s> sans clôture" nil
					     markup))
		    (set poss (match-beginning 0))
		    (unless (match-string-no-properties 1)
		      (goto-char (match-beginning 0))
		      (insert (format "</%s>" markup))
		      (dolist (symb '(p-pos li-pos))
			(unless (or (null (symbol-value symb))
				    (eq symb poss))
			  (set symb (+ (length markup) 3 (symbol-value symb)))))))))))
	))

    ;; mise entre guillemets anglais des attributs entier sans guillemets
    (goto-char beg)
    (let (p1 p2 added-dquote-attributes p-start p-end)
      ;; tant qu'on trouve potentiellement un attribut sans "..."
      (while (re-search-forward "\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([-+]?[0-9]+\\)"
				nil end)
	(setq p1 (match-beginning 1)
	      p2 (match-end 0))
	(if
	    ;; si la position est bien entre < et >
	    (and (re-search-backward "[<>]" beg t)
		 (looking-at "<\\sw+")
		 (progn
		   (goto-char (setq p-start (match-end 0)))
		   (re-search-forward "[<>]" end t)
		   (string= (match-string-no-properties 0) ">"))
		 (>= (setq p-end (match-beginning 0)) p1))
	    ;; alors on fait la réparation
	    (progn
	      (goto-char p-start)
	      (while
		  (progn
		    (while (looking-at "\\(?:\\s-\\|\n\\)*\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\"[^\"]*\"")
		      (goto-char (match-end 0)))
		    (cond
		     ((looking-at  "\\(?:\\s-\\|\n\\)*\\(\\sw+\\)\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([-+]?[0-9]+\\)")
		      (push (match-string-no-properties 1) added-dquote-attributes)
		      (goto-char (match-beginning 2))
		      (insert ?\")
		      (goto-char (1+ (match-end 2)))
		      (insert ?\")
		      (setq p-end (+ 2 p-end)))
		     ((looking-at "\\(?:\\s-\\|\n\\)*>")
		      (goto-char (match-end 0))
		      (insert "<!-- HTML2TEXI inserted double quotes around values for attibutes: "
			      (mapconcat (lambda (x) (concat "`" x "'"))
					 added-dquote-attributes
					 ", ")
			      " -->")
		      nil)
		     (t (html2texi-error "Attribut au format invalide: %s."
			       (buffer-substring (point) p-end)))))))
	  ;; sinon on continue à chercher un attribut potentiel dont la valeur
	  ;; n'est pas entre "..."
	  (goto-char p2))))

    ;; un peu de ménage...
    (unless (markerp end-arg)
      (set-marker end nil)) ))

;;;==========================================================================
;;; définition des gestionnaires de balise
;;;--------------------------------------------------------------------------

(defun html2texi-tag-handler-a (xml-expr)
  (let (name href text (xml-expr-length (length xml-expr)))
    (dolist (attrib (cadr xml-expr))
      (cond
       ((eq (car attrib) 'href)
	(setq href (cdr attrib)))
       ((eq (car attrib) 'name)
	(setq name (cdr attrib)))))
    (and (cddr xml-expr)
	 (setq text (caddr xml-expr)))
    (cond
     (href (html2texi-process-url href text))
     ((= xml-expr-length 3)
      (cond
       ((stringp text)
	(insert (html2texi-string-escape text t)))
       ((consp text) (html2texi-process-xml-expr text))
       (t (error "Le format du text de la balise <a> était inattendu"))))
     ((> xml-expr-length 3)
      (html2texi-process-xml-expr `(div nil ,@(cddr xml-expr)))))
    (and name
      (insert "\n@anchor{" (html2texi-make-anchor (concat "#" name)) "}\n"))))

(html2texi-make-simple-markup-handler b)

(defun html2texi-flush-anchors ()
  (while html2texi-flushable-anchors
    (insert "@anchor{" (pop html2texi-flushable-anchors) "}\n")))


(defun html2texi-tag-handler-h1 (xml-expr)
  (insert "@chapter " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))


(defun html2texi-tag-handler-h2 (xml-expr)
  (insert "@section " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))

(defun html2texi-tag-handler-h3 (xml-expr)
  (insert "@subsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
    (html2texi-flush-anchors))

(defun html2texi-tag-handler-h4 (xml-expr)
  (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))

(defun html2texi-tag-handler-h5 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
     (html2texi-flush-anchors))

(defun html2texi-tag-handler-h6 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
   (html2texi-flush-anchors))

(html2texi-make-simple-markup-handler samp)


(defun html2texi-get-col-span (xml-expr)
  ;; xml-expr is <td> or <th>
  (let ((col-span (cdr-safe (assq 'colspan (nth 1 xml-expr)))))
    (setq col-span
	  (cond
	   ((integerp
	       (setq col-span
		     (if (stringp col-span)
			 (string-to-number col-span)
		       col-span)))
	      col-span)
	   ((null col-span) 1)
	   (t (error "colspan invalide"))))  ))

(html2texi-make-simple-markup-handler sub)
(html2texi-make-simple-markup-handler sup)

(html2texi-make-simple-markup-handler tt)

(defvar html2texi-table-fmt-current-ctxt nil)

(defun html2texi-tag-handler-table (xml-expr)
  (let* ((html2texi-table-fmt-current-ctxt (html2texi-table-fmt-ctxt "Table formatting context"))
	 (xml-table-info
	  (vector xml-expr;0: table items
		  nil;1: thead items
		  nil;2: tbody items
		  nil;3: tfoot items
		  0;4: bitmap champ trouvé:
					; 1 = plain table (found a tr item not a thead|tbody|tfoot)
					; 2 = thead found
					; 4 = tbody found
					; 8 = tfoot found
		  0;5: bitmap traité
		  1;6: en cours de traitement
		  ))
	 (xml-items (cddr xml-expr)))

    ;; tout d'abord on analyse la table pour trouver le nombre de colonne
    (while (or xml-items (/= (aref xml-table-info 4)  (aref xml-table-info 5)))
      (if xml-items
	  (let ((xml-expr (pop xml-items)))
	    (cond
	     ((and (consp xml-expr)
		   (eq (car xml-expr) 'tr))
	      (when (= (aref xml-table-info 6) 1)
		;; cas d'une table avec les lignes directement sous <table> ... </table>
		(and (/= (logand (aref xml-table-info 4)
				 14) 0)
		     (html2texi-error "Table avec à la fois des lignes directement sous <table> ... </table>\
 et des lignes sous une balise <X>...</X> avec X dans {thead, tbody, tfoot}" xml-expr))
		(aset xml-table-info 4 (logior (aref xml-table-info 4) 1)))
	      ;; plus besoin de chercher une ligne: on compte les colonnes sur la
	      ;; première ligne trouvée
	      (setq xml-items nil)
	      (dolist  (xml-expr (cddr xml-expr))
		(cond
		 ((consp xml-expr)
		  (if (memq  (car xml-expr) '(th td))
		      (progn
			(oset html2texi-table-fmt-current-ctxt :col-count
			      (+ (oref html2texi-table-fmt-current-ctxt :col-count)
				 (html2texi-get-col-span xml-expr)))
			(when (> (oref html2texi-table-fmt-current-ctxt :col-count)
				 (oref html2texi-table-fmt-current-ctxt :col-info-length))
			  (let ((l (make-list (- (oref html2texi-table-fmt-current-ctxt :col-count)
						 (oref html2texi-table-fmt-current-ctxt :col-info-length))
					      '(abs 1))))
			    (setcdr (oref html2texi-table-fmt-current-ctxt :col-info-last) l)
			    (oset html2texi-table-fmt-current-ctxt :col-info-last (last l))
			    (oset html2texi-table-fmt-current-ctxt :col-info-length
				  (oref html2texi-table-fmt-current-ctxt :col-count)))))
		    (html2texi-error "balise inattendu dans une table" xml-expr)))
		 ((stringp xml-expr)
		  (unless (string-match
			   "\\`\\s-*\\(\n\\s-*\\)*\\'"
			   xml-expr)
		    (html2texi-error "Chaîne inattendue" xml-expr)))
		 (t (html2texi-error "Élément inattendu" xml-expr)))))

	     ;; la table est organisé en thead/tbody/tfoot
	     ((and (consp xml-expr)
		   (memq (car xml-expr) '(thead tbody tfoot)))
	      (let* ((thead 1) (tbody 2) (tfoot 3) (index (symbol-value (car xml-expr))))
		(and (/= (logand (aref xml-table-info 4)
				 (lsh 1 index)) 0)
		     (html2texi-error "Balise `%s' en double dans la table"
				      (aref xml-table-info 0)
				      (symbol-name (car xml-expr))))
		(aset xml-table-info 4 (logior  (aref xml-table-info 4) (lsh 1 index)))
		(aset xml-table-info index xml-expr)))

	     ;; chaîne qui n'est pas un blanc au beau milieu de la table...
	     ((stringp xml-expr)
	      (unless (string-match
		       "\\`\\s-*\\(\n\\s-*\\)*\\'"
		       xml-expr)
		(html2texi-error "Chaîne inattendue" xml-expr)))
	     (t (html2texi-error "Élément inattendu" xml-expr))))
	;; xml-items est nil

	;; on marque le champ courant (c.-à-d. table | thead | tbody | tfoot)
	;; comme ayant été traité
	(aset xml-table-info 5 (logior
				(aref xml-table-info 5)
				(logand
				 (aref xml-table-info 4)
				 (aref xml-table-info 6))))
	;; maintenant on cherche s'il en est un champ restant à parcourir
	(let ((index 0)
	      (to-be-processed (logxor  (aref xml-table-info 4)
					(aref xml-table-info 5))))
	  (while (and (/= to-be-processed 0)
		      (= (logand to-be-processed 1) 0))
	    (setq index (1+ index)
		  to-be-processed (lsh to-be-processed -1)))
	  (when (/= to-be-processed 0)
	    (setq xml-items (cdr-safe (cdr-safe (aref xml-table-info index))))
	    (aset xml-table-info 6 (lsh 1 index))) )))


    ;; maintenant qu'on a fini d'analyser la table, on peut la traiter.
    (if (or (> (oref html2texi-table-fmt-current-ctxt :col-count) 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(progn
	  (insert "@multitable @columnfractions ")
	  ;(debug)
	  (let ((total-weight
		 (math-reduce-vec
		  (lambda (r x)
		    (+ r
		       (cond
			((eq (car x) 'abs) (cadr x))
			((eq (car x) 'rel)
			 (setcar x 'abs)
			 (setcar (cdr x)
				 (* (cadr x)
				    (oref html2texi-table-fmt-current-ctxt :col-info-length))) (cadr x)))))
		  (cons 'vec (oref html2texi-table-fmt-current-ctxt :col-info)))))
	    (insert
	     (mapconcat
	      (lambda (x)
		(number-to-string
		 (/ (float (cadr x)) (oref html2texi-table-fmt-current-ctxt :col-info-length))))
	      (cdr (oref html2texi-table-fmt-current-ctxt :col-info))
	      " ")))
	  (insert "\n"))
      (insert "@table\n"))

    (dotimes (i 4)
      (when (/= 0 (logand (aref xml-table-info 4) (lsh 1 i)))
	(if (/= i 2)
	    (html2texi-process-xml-expr  (aref xml-table-info i))
	  (oset html2texi-table-fmt-current-ctxt :force-head t)
	  (html2texi-process-xml-expr  (aref xml-table-info 2))
	  (oset html2texi-table-fmt-current-ctxt :force-head nil))))

    (if (or (> (oref html2texi-table-fmt-current-ctxt :col-count) 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(insert "@end multitable\n")
      (insert "@end table\n"))))


(defun html2texi-tag-handler-tr (xml-expr)
  (oset html2texi-table-fmt-current-ctxt :col-number 0)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n")
  (oset html2texi-table-fmt-current-ctxt :row-number
	(1+ (oref html2texi-table-fmt-current-ctxt :row-number))))

(defun html2texi-tag-handler-th (xml-expr)
  (if   (= 0 (oref html2texi-table-fmt-current-ctxt :col-number))
      (if (and (= 0 (oref html2texi-table-fmt-current-ctxt :row-number))
	       (null html2texi-handle-two-columns-table-as-@table))
	  (progn
	    (oset html2texi-table-fmt-current-ctxt :head-on-row-0 t)
	    (insert "@headitem ")
	    (html2texi-process-xml-expr xml-expr))
	(insert "@item ")
	(html2texi-process-xml-expr xml-expr))
    (when (or (> (oref html2texi-table-fmt-current-ctxt :col-count) 2)
	      (null html2texi-handle-two-columns-table-as-@table))
      (insert "@tab "))
    (html2texi-process-xml-expr xml-expr)
    (unless (and  (= 0 (oref html2texi-table-fmt-current-ctxt :row-number))
		  (oref html2texi-table-fmt-current-ctxt :head-on-row-0))
	(insert "\n")))
  (oset html2texi-table-fmt-current-ctxt :col-number
	(1+ (oref html2texi-table-fmt-current-ctxt :col-number))))

(defun html2texi-tag-handler-td (xml-expr)
  (if  (oref html2texi-table-fmt-current-ctxt :force-head)
      (html2texi-tag-handler-th xml-expr)
    (if (= 0 (oref html2texi-table-fmt-current-ctxt :col-number))
	(insert "@item ")
      (if (or (> (oref html2texi-table-fmt-current-ctxt :col-count) 2)
	      (null html2texi-handle-two-columns-table-as-@table))
	  (insert "@tab ")))
    (html2texi-process-xml-expr xml-expr)
    (insert "\n")
    (oset html2texi-table-fmt-current-ctxt :col-number
	  (1+ (oref html2texi-table-fmt-current-ctxt :col-number)))))

(defun html2texi-cur-dir ()
  "Détermine le répertoire courant relativement au répertoire du
HTML racine de départ. La valeur retournée se termine par une oblique `/'"
  (let ((cur-dir  (nreverse (split-string (cdar html2texi-directory-stack) "/")))
	(ref-dir  (nreverse (split-string html2texi-directory-ref "/"))))
    (unless (and (string= (car cur-dir) "")
		 (string= (car ref-dir) ""))
      (error "Format invalide de répertoire"))
    (setq cur-dir (nreverse (cdr cur-dir))
	  ref-dir (cdr ref-dir))
    (if (or (string= (car cur-dir) "")
	    (string-match "\\`[a-z]:" (car cur-dir)))
	;; cur-dir est un chemin absolu
	(progn
	  (setq ref-dir (nreverse ref-dir))
	  (while (and cur-dir ref-dir (string= (car cur-dir) (car ref-dir)))
	    (setq cur-dir (cdr cur-dir)
		  ref-dir (cdr ref-dir)))
	  (while ref-dir
	    (push ".." cur-dir)
	    (setq ref-dir (cdr ref-dir)))
	  (concat (mapconcat 'identity cur-dir "/") "/"))
      (while (and cur-dir
		  (cond
		   ((string= (car cur-dir) "..")
		    (unless ref-dir
		      (error "Chemin invalide"))
		    (setq ref-dir (cdr ref-dir)
			  cur-dir (cdr cur-dir)))
		   ((string= (car cur-dir) ".")
		    (setq cur-dir (cdr cur-dir)))
		   (t nil))))
      (dolist (e cur-dir)
	(push e ref-dir))
      (mapconcat 'identity  (nreverse (cons "" ref-dir)) "/") )))

(defun html2texi-anchor-escape (anchor)
  (let (ret)
    (setq anchor
	  (mapconcat
	   'identity
	   (split-string anchor "-") "--"))
    (mapc
     (lambda (x)
       (if
	(or (and (>= x ?a) (<= x ?z))
	     (and (>= x ?A) (<= x ?Z))
	     (and (>= x ?0) (<= x ?9))
	     (member x '(?_ ?- ?/)))
	   (push (string x) ret)
	 (push (format "-%04x" x) ret)))
     anchor)
    (apply 'concat (nreverse ret))))

(defun html2texi-make-anchor (name &optional escape-function)
  (let* ((anchor (expand-file-name (concat (html2texi-cur-dir) name)))
	 (l-a (length anchor))
	 (l-r (length html2texi-directory-ref))
	 (l (min l-a l-r))
	 (start 0)
	 (i -1))
    (while (and
	    (< (setq i (1+ i)) l)
	    (prog1
		(= (aref anchor i) (aref html2texi-directory-ref i))
	      (and (= (aref anchor i) ?/)
		   (setq start (1+ i))))))
    (setq anchor (list (substring anchor start)))
    (dotimes (i (length (split-string (substring html2texi-directory-ref start))))
      (push "../" anchor))
    (setq anchor (apply 'concat anchor))
    (html2texi-string-escape (funcall (or escape-function 'html2texi-anchor-escape) anchor))))

(defun html2texi-simple-markup-handle (xml-expr class-alist preamble postamble)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe
			(and class-attribute
			     (assoc-string (cdr class-attribute) class-alist)))
		      (list preamble postamble))))
    (insert (car pre-post))
   (html2texi-process-xml-expr xml-expr)
   (insert (cadr pre-post))))

(defun html2texi-tag-handler-body (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))


(html2texi-make-simple-markup-handler code)

(defun html2texi-tag-handler-br (xml-expr)
  (insert "@*\n"))

(defun html2texi-tag-handler-div (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(html2texi-make-simple-markup-handler dfn)

(defun html2texi-tag-handler-dl (xml-expr)
  (insert "@table @asis\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "@end table\n"))

(defun html2texi-tag-handler-dt (xml-expr)
  (insert "@item ")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(defun html2texi-tag-handler-dd (xml-expr)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(html2texi-make-simple-markup-handler em)

(defun html2texi-tag-handler-frameset (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-frame (xml-expr)
  (let (url text)
    (dolist (x (cadr xml-expr))
      (cond
       ((eq (car x) 'src)
	(setq url (cdr x)))
       ((eq (car x) 'name)
	(setq text (cdr x)))))
    (when url
      (html2texi-process-url url text))))

(defun html2texi-tag-handler-hr (xml-expr)
  (insert "@c <hr/>\n"))

(html2texi-make-simple-markup-handler kbd)

(defun html2texi-tag-handler-html (xml-expr)
  "\
Traitement de la balise html."
  (let* ((attributes (nth 1 xml-expr))
	 (lang (assq 'lang attributes)))
    (when lang
      	(html2texi-set-doc-info 'language (cdr lang))))
    (html2texi-process-xml-expr xml-expr))

(html2texi-make-simple-markup-handler strong)

(defun html2texi-handle-string (str)
  (let (ret (pos0 0) pos1 (len (length str)))
    (while (and
	    (< pos0 len)
	    (setq pos1 (string-match "[{}@]" str pos0)))
      (push (substring str pos0 pos1) ret)
      (push (concat "@" (match-string-no-properties 0 str)) ret)
      (setq pos0 (1+ pos1)))
    (when (< pos0 len)
      (push (substring str pos0 pos1) ret))
    (apply 'concat (nreverse ret))))

(defun html2texi-generate-log-buffer ()
  (let* ((compilation-error-regexp-alist
	 '(html-to-texinfo-error
	   html-to-texinfo-warning
	   html-to-texinfo-info))
	 (b (generate-new-buffer html2texi-log-buffer-name)))
    (display-buffer b)
    (with-current-buffer b
      (compilation-mode)
      b)))

(defun html2texi-fatal-error (format-str xml-expr &rest args)
  (setq html2texi-log-buffer (if (buffer-live-p html2texi-log-buffer)
				 html2texi-log-buffer
				 (html2texi-generate-log-buffer)))
  (display-buffer html2texi-log-buffer)

  (let ((line-number (line-number-at-pos)))
    (with-current-buffer html2texi-log-buffer
      (let ((inhibit-read-only t))
	(insert (aref html2texi-log-error-names 0) ":"
		(html2texi-current-file html2texi-files-to-do) ":"
		(if (eq xml-expr :html2texi-generic-error)
		    ""
		  (format "%d:" (+ line-number html2texi-line-delta)))
		(apply
		 'format
		 (concat format-str
			 "\n"
			 (aref html2texi-log-error-names 3)
			 ": <<<-----------\n"
			 (aref html2texi-log-error-names 3)
			 ": xml-expr=%S\n"
			 (aref html2texi-log-error-names 3)
			 ": xml-stack=%S\nInfo: ----------->>>\n")
		 `( ,@args ,xml-expr ,html2texi-xml-stack)) ?\n)))
    (apply 'error format-str args)))

(defmacro html2texi-with-log (&rest body)
  `(progn
     (setq html2texi-log-buffer (if (buffer-live-p html2texi-log-buffer)
				    html2texi-log-buffer
				    (html2texi-generate-log-buffer)))
     (display-buffer html2texi-log-buffer)
     (let ((line-number (line-number-at-pos)))
       (with-current-buffer html2texi-log-buffer
	 (let ((inhibit-read-only t))
	   ,@body)))))


(defun html2texi-error (format-str xml-expr &rest args)
  (html2texi-with-log
   (insert (aref html2texi-log-error-names 1) ":"
	   (html2texi-current-file html2texi-files-to-do) ":"
	   (if (eq xml-expr :html2texi-generic-error)
	       ""
	     (format "%d:" (+ line-number html2texi-line-delta)))
	   " "
	   (apply 'format format-str args) ?\n)))

(defun html2texi-warning (format-str xml-expr &rest args)
  (html2texi-with-log
   (insert (aref html2texi-log-error-names 2) ":"
	   (html2texi-current-file html2texi-files-to-do)":"
	   (if (eq xml-expr :html2texi-generic-error)
	       ""
	     (format "%d:" (+  line-number html2texi-line-delta)))
	   (apply 'format format-str args) ?\n)))

(defun html2texi-info (format-str xml-expr &rest args)
  (html2texi-with-log
   (insert (aref html2texi-log-error-names 3) ":"
	   (html2texi-current-file html2texi-files-to-do)":"
	   (if (eq xml-expr :html2texi-generic-error)
	       ""
	     (format "%d:" (+  line-number html2texi-line-delta)))
	   (apply 'format format-str args) ?\n)))

(defun html2texi-decode-url (url)
  "Décode les `%20' et autres séquences hexadécimale"
  (with-temp-buffer
    (insert url)
    (goto-char (point-min))
    (while (re-search-forward "%\\([[:xdigit:]]\\{2\\}\\)" nil t)
      (replace-match (string (math-read-radix
			       (match-string-no-properties 1) 16)) t t))
    (when (eq html2texi-url-encoding :html2texi-utf-8)
      (accents-de-utf-8))
    (buffer-substring (point-min) (point-max))))

(defun html2texi-process-url (url text)
  (let* ((parsed-url (url-generic-parse-url (html2texi-decode-url url)))
	 url-list
	 i
	 absolute-file-name
	 locator
	 relative-file-name
	 qualifed-locator)
    ;; petit hack parce que url-generic-parse-url ne fait pas complètement le
    ;; boulot
    (when (and
	   (null  (aref parsed-url 1))
	   (setq i (string-match "#" (aref parsed-url 6)))
	   (null (aref parsed-url 7)))
      (aset parsed-url 7 (substring (aref parsed-url 6) (1+ i)))
      (aset parsed-url 6 (substring (aref parsed-url 6) 0 i)))

    (push "@uref{" url-list) ; ça peut être défait ensuite
    ;; URL
    (if (and (eq (aref parsed-url 0)
		 'cl-struct-url)
	     (null (aref parsed-url 1)))
	;; cas où il n'y a pas de protocole
	(cond
	 ;; on pointe vers un fichier HTML, ce n'est donc pas forcément une URL interne
	 ;; => cas suspect
	 ((member (file-name-extension
		   (setq absolute-file-name
			 (expand-file-name
			  (aref parsed-url 6)
			  (file-name-directory (html2texi-current-file html2texi-files-to-do)))))
		  '("html" "htm"))
	  (html2texi-add-file-to-do html2texi-files-to-do absolute-file-name)
	  (setq
	   locator (aref parsed-url 7)
	   relative-file-name (file-relative-name absolute-file-name html2texi-directory-ref)
	   qualified-locator (if locator (concat relative-file-name "#" locator) relative-file-name))

	  (if (and (file-exists-p absolute-file-name)
		   (null (file-name-absolute-p relative-file-name)))
	      (setq
	       url-list (list
			 (html2texi-make-anchor qualified-locator)
			 "@ref{"))
	    (push (html2texi-string-escape qualified-locator) url-list)))

	 ;; cas d'une URL interne
	 ((and (string= "" absolute-file-name)
	       (setq locator (aref parsed-url 7)))
	  (setq qualified-locator  (concat "#" locator)
		url-list
		(list
		 (html2texi-make-anchor qualified-locator)
		 "@ref{")))

	 ;; cas d'une URL dont on est sûr quelle est externe.
	  (t
	    (push (html2texi-string-escape url) url-list)))
        (push (html2texi-string-escape url) url-list))
     ;; Text
     (when text
       (push "," url-list)
       (push (html2texi-string-escape text) url-list))
     (push "}" url-list)
     (apply 'insert (nreverse url-list))))

(defun html2texi-tag-handler-center (xml-expr)
  (let ((start-point (point))
	(start-ln (line-number-at-pos))
	end-mark)
    (html2texi-process-xml-expr xml-expr)
    (when (and (<= (point) (+ start-point html2texi-@center-max-size))
	       (> (point) start-point)
	       ;; test histoire que le code soit à l'épreuve du temps : il se
	       ;; pourrait qu'on soit déjà centré pour une autre raison.
	       (null (save-excursion
		       (goto-char start-point)
		       (looking-at "\\(\n\\|\\s-\\)*@center\\>")))
	       (let (to-do
		     (ok t)
		     xml-expr
		     (l (cdr-safe (cdr-safe xml-expr))))
		 (while (and ok (or to-do l))
		   (if l
		       (progn
			 (setq xml-expr (pop l))
			 (cond
			  ((stringp xml-expr))
			  ((and (consp xml-expr)
				(memq (car xml-expr) html2texi-allowed-markup-in-@center))
			   (push xml-expr to-do))
			  (t (setq ok nil))))
		     (setq l (cdr-safe (cdr-safe (pop to-do))))))
		 (when ok
		   (setq end-mark (point-marker))
		   (goto-char start-point)
		   (insert "\n@center ")
		   (while (search-forward "\n" end-mark t)
		     (delete-char -1)
		     (insert 32))
		   (goto-char end-mark)
		   (set-marker end-mark nil)))))))

(html2texi-make-simple-markup-handler i)

(defun html2texi-tag-handler-li (xml-expr)
  (insert "\n@item\n")
  (unless (memq (caadr html2texi-xml-stack) '(ol ul))
    (html2texi-fatal-error "<li> était inattendu." xml-expr ))
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-link (xml-expr)
  )

(defun html2texi-tag-handler-ol (xml-expr)
  (insert "\n@enumerate")
   (html2texi-process-xml-expr xml-expr)
  (insert "\n@end enumerate\n"))

(defun html2texi-tag-handler-p (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(defun html2texi-tag-handler-tbody (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-thead (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-tfoot (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-ul (xml-expr)
  (insert "\n@itemize")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n@end itemize\n"))

(defun html2texi-tag-handler-span (xml-expr)
  (insert "@c span: (<span #1>#2</span> => #2.")
  (html2texi-default-handling xml-expr "span: ")
  (html2texi-process-xml-expr xml-expr)
  (insert "@c span: )\n"))

(defun html2texi-tag-handler-style (xml-expr)
  )

(defun html2texi-tag-handler-meta (xml-expr)
  (unless (and (nth 1 html2texi-xml-stack)
	       (eq (caadr html2texi-xml-stack) 'head))
    (html2texi-fatal-error "<meta> inattendu." xml-expr))
  ;; traitement du meta...
  (let* ((attribute-list (nth 1 xml-expr))
	 (http-equiv (assq 'http-equiv attribute-list))
	 (name (assq 'name attribute-list))
	 (content (assq 'content attribute-list)))
    (cond
     ((and (consp name)
	   (consp content)
	   (progn
	     (setq name (cdr name)
		   content (cdr content))
	     (stringp name))
	   (stringp content))
      (cond
       ((string= name "author")
	(html2texi-set-doc-info 'author content))
       ((string= name "language")
	(when (string-match "\\`\\([a-z]\\{2\\}\\(-[A-Z]\\{2\\}\\)?\\)\\'" content)
	  (let ((language (match-string-no-properties 1 content)))
	    (when (= (length language) 5)
	      (aset language 2 ?_))
	    (html2texi-set-doc-info 'language language))))))
     ((and (consp http-equiv)
	   (consp content)
	   (progn (setq http-equiv (cdr http-equiv))
		  (stringp http-equiv))
	   (progn (setq content (cdr content))
		  (stringp content)))
      (setq http-equiv (downcase http-equiv))
      (cond
       ((and (string= http-equiv "content-type")
	     (string-match "charset\\s-*=\\s-*\\([-a-z0-9]+\\)" content))
	(html2texi-set-doc-info 'content-type-charset (match-string-no-properties 1 content)));
       )))))

(defun html2texi-tag-handler-pre (xml-expr)
  (let ((kes html2texi-keep-empty-strings))
    (setq html2texi-keep-empty-strings t)
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-keep-empty-strings kes)))

(defun hmtl2texi-to-plain-text (xml-expr &rest flags)
  (let (ret anchor)
    (dolist (xml-expr (cddr xml-expr))
      (cond
       ((stringp xml-expr)
	(push xml-expr ret))
       ((consp xml-expr)
	(push xml-expr html2texi-xml-stack)
	(cond
	 ((and (eq (car xml-expr) 'a)
	       (setq anchor (assq 'name (nth 1 xml-expr))))
	  (push (html2texi-make-anchor (concat "#" (cdr anchor)))
		html2texi-flushable-anchors) ))
	(let ((str  (hmtl2texi-to-plain-text xml-expr)))
	  (and (null (string= str ""))
	       (push str ret)))
	(pop html2texi-xml-stack))
       (t (html2texi-fatal-error "Expression XML inattendue." xml-expr))))
    (setq  ret (mapconcat 'identity (nreverse ret) " "))
    (if (memq :one-line flags)
	(mapconcat 'identity (split-string ret "\n") " ")
      ret)))


(defun html2texi-tag-handler-title (xml-expr)
  (unless (and  (nth 1 html2texi-xml-stack)
		(eq  (caadr html2texi-xml-stack) 'head))
    (html2texi-fatal-error "<title> inattendu." xml-expr))
  (setq xml-expr (cddr xml-expr))
  (let ((str  (hmtl2texi-to-plain-text xml-expr)))
    (setq str (split-string str "\n")
	  str (mapconcat 'identity str " "))
    (unless (string= str "")
      (html2texi-set-doc-info 'title str))))

(defun html2texi-string-escape (str &optional flatten)
  (cond
   ((stringp str)
    (with-temp-buffer
      (insert str)
      (goto-char (point-min))
      (while (re-search-forward "[,@{}]" nil t)
	(cond
	 ((string= (match-string-no-properties 0) ",")
	  (replace-match "@comma{}"))
	 ((member (match-string-no-properties 0) '("@" "{" "}"))
	  (replace-match (concat "@" (match-string-no-properties 0))))))
      (when flatten
	(goto-char (point-min))
	(while (re-search-forward "\n\\(\\s-*\\)" nil t)
	  (replace-match (if (> 0 (length (match-string 1))) " " "") t t)))
      (buffer-substring (point-min) (point-max))))
   ((and (consp str) (car-safe str))
    (cond
     ((eq (car str) 'span)
      (with-temp-buffer
	(insert "@c span: (<span #1>#2</span> => string-escape of #2.")
	(html2texi-default-handling str "span: ")
	(insert (html2texi-string-escape  (nth 2 str) flatten))
	(insert "@c span: )\n")
	(buffer-substring (point-min) (point-max))))
     (t (html2texi-fatal-error "Une chaîne était attendue" :html2texi-generic-error str))))
   (t  (html2texi-fatal-error "Une chaîne était attendue" :html2texi-generic-error str))))

(defun html2texi-tag-handler-img (xml-expr)
  (let (filename width height alttext extension)
    (dolist (x (cadr xml-expr))
      (cond
       ((eq (car x) 'src)
	(setq filename (cdr x)))
       ((eq (car x) 'alt)
	(setq alttext (cdr x)))))
    (unless filename
      (html2texi-fatal-error "src=... était attendu" xml-expr))
    (setq filename (html2texi-decode-url filename))
    (setq extension (file-name-extension filename)
	  filename (file-name-sans-extension filename))
    (when (member extension '("png" "jpg" "jpeg" "eps" "txt"))
      (setq extension nil))
    (insert "@image{" (html2texi-make-anchor filename (symbol-function 'identity)))
    (let ((remainder (list width height alttext extension)))
	(while remainder
	  (if (let (non-empty)
		(mapc (lambda (x) (setq non-empty (or non-empty (stringp x))))
		      remainder)
		non-empty)
	      (insert "," (or (pop remainder) "") )
	    (setq remainder nil); rompt la boucle (while remainder...)
	    ))
	(insert "}"))))

(defun html2texi-set-doc-info (tag val)
  "Configure pour l'étiquette TAG la valeur VAL concernant les
informations globales au documents. Ces informations concernent
notamment la langue et l'encodage du document."
  (let ((info (assq tag html2texi-document-information)))
    (if info
	(setcdr info val)
      (push (cons tag val) html2texi-document-information))))

(defun html2texi-tag-handler-head (xml-expr)
  (unless html2texi-ignore-head
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-ignore-head t)))

(defun html2texi-tag-handler-noframes (xml-expr)
  )

(if (boundp 'html2texi-handler-hash-table)
    (makunbound 'html2texi-handler-hash-table))

(defconst html2texi-handler-hash-table
  (let ((ht (make-hash-table)))
    (dolist (v '(a b body center code dfn dl dt dd em i kbd li p
    hr div ol ul pre head meta title frameset frame noframes span
    strong table tbody thead tfoot th tr td h1 h2 h3 h4 h5 h5
    html link br img samp style sup sub tt))
      (puthash v (symbol-function (intern (concat "html2texi-tag-handler-" (symbol-name v))))
	       ht))
    ht)
  "Table de hashage des traitement associé à chaque balise HTML"
  )

(defun html2texi-remove-empty-strings (xml-expr)
  (setq xml-expr (cdr xml-expr))
  (save-match-data
  (while (cdr xml-expr)
    (if (and (stringp (cadr xml-expr))
	     (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'" (cadr xml-expr)))
	(setcdr xml-expr (cddr xml-expr))
      (setq xml-expr (cdr xml-expr))))))

(defun html2texi-process-xml-expr (xml-expr)
  (push xml-expr html2texi-xml-stack)
  (dolist (xml-expr (cddr xml-expr))
    (cond
     ((consp xml-expr)
      (push xml-expr html2texi-xml-stack)
      (let ((handler (gethash (intern (downcase (symbol-name (car xml-expr))))
			      html2texi-handler-hash-table)))
	(if handler
	    (funcall handler  xml-expr)
	  (html2texi-default-handling xml-expr)))
      (pop html2texi-xml-stack))
     ((stringp xml-expr)
      (and (or html2texi-keep-empty-strings
	       (null (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'"  xml-expr)))
	   (insert (html2texi-handle-string xml-expr))))
     (t (html2texi-fatal-error "Expression XML inattendue %S" xml-expr))))
  (pop html2texi-xml-stack))

(defun html2texi-default-handling (xml-expr &optional prompt)
  (let ((str (split-string (prin1-to-string xml-expr) "\n")))
    (dolist (str-line str)
      (insert "\n@c " (or prompt "") str-line)))
    (insert "\n"))

(defun html2texi-process-region (beg end)
  (goto-char end)
  (let ((end (point-marker))
	is-xhtml
	re-do
	xml-expr)

    ;; Suppression de tout ce qui est en dehors des balise <html> ... </html>
    (goto-char beg)
    (setq html2texi-line-delta (line-number-at-pos))
    (setq is-xhtml
	  (looking-at "[ \t\n\r]*<!DOCTYPE[ \t\n\r]+html[ \t\n\r]+PUBLIC[ \t\n\r]+\"-//W3C//DTD XHTML"))
    (unless (re-search-forward "<html" end t)
      (html2texi-fatal-error "Balise <html> non trouvée" xml-expr))
    (setq html2texi-line-delta (- (line-number-at-pos) (* 2 html2texi-line-delta)))
    (delete-region beg (match-beginning 0))
    (unless (re-search-forward ">" end t)
      (html2texi-fatal-error "Clôture de la balise <html> trouvée" xml-expr))
    (unless  (re-search-forward "</html" end t)
      (html2texi-fatal-error "Balise </html> non trouvée trouvée" xml-expr))
    (unless (re-search-forward ">" end t)
      (html2texi-fatal-error "Clôture de la balise </html> trouvée" xml-expr))
    (delete-region (match-end 0) end)

    (or is-xhtml
	(html2texi-make-html-clean-xml beg end))

    (setq xml-expr
	  (condition-case
	      sig
	      (xml-parse-region beg end)
	    (error
	     (if (consp sig)
		 (html2texi-warning "File is XHTML but xml-parser reported error `%S'"
				 :html2texi-generic-error
				 (cdr sig))
	       (html2texi-warning "File is XHTML but xml-parser reported errors"
				  :html2texi-generic-error))
		  (if is-xhtml :html2texi-redo nil)))
	  xml-expr
	  (if (eq xml-expr :html2texi-redo)
	       (progn
		 (html2texi-make-html-clean-xml beg end)
		 (xml-parse-region beg end))
	     xml-expr))

    (delete-region beg end)
    (set-marker end nil)
    xml-expr))

(if t
;; plus partique pour déboguer qu'un vrai tampon temporaire
    (defmacro html2texi-with-temp-buffer (&rest body)
      (let ((cur-buff (make-symbol "cur-buff")))
	`(with-current-buffer
	       (let (( ,cur-buff (get-buffer "*HTML2TEXI Temp*")))
		 (and ,cur-buff (kill-buffer ,cur-buff))
		 (get-buffer-create "*HTML2TEXI Temp*"))
       (erase-buffer)
       ,@body)))
  ;;
  (defmacro html2texi-with-temp-buffer (&rest body)
    `(with-temp-buffer ,@body)))



(defun html2texi-make-texi-buffer (&optional buffer )
  (let* ((start-buffer (or buffer (current-buffer)))
	 xml-expr
	 (start-filename  (or (buffer-file-name start-buffer) (buffer-name)))
	 (start-filename-ext (file-name-extension start-filename))
	 done-links-list
	 texi-buffer)
    (setq html2texi-texi-buffer-name
     (concat (concat  (file-name-sans-extension   (file-name-nondirectory start-filename))
		      ".texi")))

    (unless (or (member start-filename-ext '("html" "htm"))
		(y-or-n-p (format "le tampon %s n'a pas une extension html, continuer?"
				  start-filename)))
      (html2texi-fatal-error "Fichier `%s' sans extension html" :html2texi-generic-error start-filename))
    (setq texi-buffer (get-buffer-create html2texi-texi-buffer-name))
    (set-buffer texi-buffer)
    (erase-buffer)
    (dolist (v html2texi-texi-buffer-local-variables)
      (set (make-local-variable v) nil))
    (push (cons default-directory "./") html2texi-directory-stack)
    (setq html2texi-directory-ref default-directory)
    (html2texi-add-file-to-do html2texi-files-to-do start-filename)
    (while (html2texi-files-has-to-do html2texi-files-to-do)
      (setq file-name (html2texi-get-next-file-next-to-do html2texi-files-to-do))
      (if (file-exists-p file-name)
	  (progn
	    (let* ((dir (file-name-as-directory
			 (file-name-directory file-name)))
		   (rel-file-name (file-relative-name file-name html2texi-directory-ref))
		   (rel-dir   (let ((d (file-name-directory rel-file-name )))
				(if d (file-name-as-directory d)
				  "./"))))
	      (push (cons dir rel-dir) html2texi-directory-stack)
	      (if (= (oref html2texi-files-to-do :added-file-count) 1)
		  (insert "@anchor{"  (html2texi-make-anchor rel-file-name) "}\n")
		(insert "\n@node " (html2texi-make-anchor rel-file-name) "\n"))
	      (html2texi-with-temp-buffer
	       (insert-file-contents file-name)
	       (accents-de-html)
	       (html2texi-make-html-clean-xml (point-min) (point-max))
	       (setq xml-expr (html2texi-process-region (point-min) (point-max))))
	      (unless (eq 'html (caar xml-expr))
		(html2texi-fatal-error "Résultat d'analyse XML inattendu" xml-expr))
	      (setq xml-expr (car xml-expr))
	      (html2texi-process-xml-expr xml-expr)
	      (pop html2texi-directory-stack)	))
	(html2texi-warning "Le fichier `%s' n'existe pas!" :html2texi-generic-error file-name)))))

(defun html2texi-insert-doc-info ()
  (let ((author
	 (html2texi-string-escape
	  (or (cdr-safe (assq 'author html2texi-document-information)) "AUTHOR")))
	(title 	 (html2texi-string-escape
		  (or (cdr-safe (assq 'title html2texi-document-information)) "TITLE")))
	(language 	 (let ((language  (cdr-safe (assq 'language html2texi-document-information))))
			   (if language (cons "" (html2texi-string-escape language))
			     (cons "@c " "LANGUAGE"))))
	(encoding  (html2texi-string-escape
			  (or (cdr-safe (assq 'content-type-charset html2texi-document-information))
			      "iso-8859-1"))))

    (goto-char (point-min))
    (insert "\\input texinfo   @c -*-mode:texinfo; coding:" (downcase encoding) "-*-
@setfilename " (file-name-sans-extension (buffer-name)) ".info
" (car language) "@documentlanguage " (cdr language) "
@documentencoding "  (if (let ((case-fold-search t))
			   (string-match "\\`\\(us\\|utf\\|iso\\)" encoding))
			 (upcase encoding) encoding) "
@copying
This manual is for PROGRAM, version VERSION.

Copyright @copyright{} YEARS COPYRIGHT-OWNER.

@quotation
Permission is granted to ...
@end quotation
@end copying

@titlepage
@title " title "@c NAME-OF-MANUAL-WHEN-PRINTED
@c @subtitle SUBTITLE-IF-ANY
@c @subtitle SECOND-SUBTITLE
@author " author "

@c  The following two commands
@c  start the copyright page.
@page
@vskip 0pt plus 1filll
@insertcopying

Published by ...
@end titlepage

@c So the toc is printed at the start.
@contents

@ifnottex
@node Top
@top TITLE

This manual is for PROGRAM, version VERSION.
@end ifnottex
")
    (goto-char (point-max))
    (insert "
@bye") ))

(defun html2texi-beautify-locator (locator)
  (with-temp-buffer
    (insert locator)
    (goto-char (point-min))
    (when (re-search-forward "-002ehtml?\\(-0023\\)?" nil t)
      (if
	  (match-string 1)
	  (replace-match "_" t t)
	(replace-match "" t t)))
    (goto-char (point-min))
    (while (re-search-forward "-[[:xdigit:]]\\{4\\}" nil t)
      (replace-match "-" t t))
    (buffer-substring (point-min) (point-max))))

(defun html2texi-post-process ()
  "Embellit les identificateur de localisation selon
`html2texi-beautify-locators'. Puis pemplace les double lignes
vides en ligne vides simples."
  ;; embellissement des indentificateurs de localisateur
  (let ((dummy-head (doli2-locator-info "Factice")))
    (when html2texi-beautify-locators
      (doli2-add-first html2texi-anchor-list dummy-head)
      (maphash
       #'(lambda (key val)
	   (let* ((beautiful-key (html2texi-beautify-locator key))
		  delta-pos-inc delta-pos locator-list
		  (key-length (length key))
		  cur next)
	     (unless (string= beautiful-key key)
	       (setq delta-pos-inc (- (length beautiful-key) key-length)
		     delta-pos 0
		     val (nreverse (cons dummy-head val))
		     locator-list val
		     next (car val))
	       (save-excursion
		 (while (cdr locator-list)
		   (setq cur next
			 locator-list (cdr locator-list)
			 next (car locator-list))
		   (goto-char (+ (oref cur :position) delta-pos))
		   (delete-region (point) (+ (point) key-length))
		   (insert beautiful-key)
		   (setq delta-pos (+ delta-pos delta-pos-inc))
		   (doli2-.>x-dolist
		    (cur next)
		    (oset cur :position (+ (oref cur :position) delta-pos))))))
	   (dolist (locator-info (cdr val))
	     (doli2-remove html2texi-anchor-list locator-info))
	   (puthash key nil (oref html2texi-anchor-list :hash-table)))
       (oref html2texi-anchor-list :hash-table)))
      (doli2-remove-first  html2texi-anchor-list)))

  ;; suppression des doubles lignes en trop
  (goto-char (point-min))
  (while (re-search-forward "\\(^[ \t]*\n\\)\\{2,\\}" nil t)
    (replace-match "\n"))
  (normal-mode))

(defun html2texi-save-texi-buffer-maybe ()
  "Sauvegarde le tampon avec le fichier Texinfo."
  (if
      (buffer-file-name) ; le tampon visite déjà un fichier
      (basic-save-buffer)
   (write-file (buffer-name) html2texi-save-texi-buffer-confirm-p)))

;;;###autoload
(defun html2texi ()
  (interactive)
  (let (html2texi-keep-empty-strings
	html2texi-xml-stack
	html2texi-texi-buffer-name
	(html2texi-line-delta 0)
	html2texi-ignore-head
	html2texi-directory-stack
	html2texi-flushable-anchors
	html2texi-directory-ref
	(html2texi-anchor-list (html2texi-locator-listing "À embellir"))
	(html2texi-files-to-do (html2texi-files-to-do-listing "À traiter"))
	(html2texi-log-buffer (and html2texi-reuse-log-buffer html2texi-log-buffer)))
  (html2texi-make-texi-buffer)
  (html2texi-insert-doc-info)
  (html2texi-post-process)
  (html2texi-info "Fin de la conversion en HTML !" :html2texi-generic-error )
  (html2texi-save-texi-buffer-maybe)))

;; Log compilation mode stuff
(defun html2texi-define-error-regexps ()
  (dolist (v `(
	       (html-to-texinfo-error
		.
		(
		 ,(concat "^" (regexp-opt (list (aref html2texi-log-error-names 0)
						(aref html2texi-log-error-names 1)))
			  ":\\(" html2texi-filepath-re
			  "\\):\\(?:\\([0-9]+\\):\\)?.*$")
		 1; File
		 2; Line
		 0; Error
		 ))
	       (html-to-texinfo-warning
		.
		(
		 ,(concat "^" (aref html2texi-log-error-names 2)
			  ":\\(" html2texi-filepath-re
			  "\\):\\(?:\\([0-9]+\\):\\)?.*$")
		 1; File
		 2; Line
		 1; Warning
		 ))
	       (html-to-texinfo-info
		.
		(
		 ,(concat "^" (aref html2texi-log-error-names 3)
			  ":")
		 nil; File
		 nil; Line
		 2; Warning
		 ))))
    (add-to-list 'compilation-error-regexp-alist (car v))
    (let ((cell (or (assq (car v) compilation-error-regexp-alist-alist)
		    (car (push (cons  (car v) nil) compilation-error-regexp-alist-alist)))))
      (setcdr cell (cdr v))  )))
(html2texi-define-error-regexps)

;;; html-to-texinfo.el ends here

Revision-number: 23
Prop-content-length: 120
Content-length: 120

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2012-02-22T18:37:20.000000Z
K 7
svn:log
V 18
Ajout de Texinfo.

PROPS-END

Node-path: trunk/lisp/accents-ascii.el
Node-kind: file
Node-action: change
Text-content-length: 25291
Text-content-md5: ec0109e26d46eedc92134e1afbe2b32f
Content-length: 25291

;; -*- coding: utf-8 -*-
;; Copyright 2008/2012 Vincent Belaïche

;; Author: Vincent Belaïche <vincent.b.1@hotmail.fr>
;; Version: $Id: accents-ascii.el,v 1.3 2012-02-22 18:37:20 Vincent Exp $
;; Keywords: 
;; X-URL: not distributed yet

;; 
;; This software is governed by the CeCILL license under French law and
;; abiding by the rules of distribution of free software.  You can  use, 
;; modify and/ or redistribute the software under the terms of the CeCILL
;; license as circulated by CEA, CNRS and INRIA at the following URL
;; "http://www.cecill.info". 
;; 
;; As a counterpart to the access to the source code and  rights to copy,
;; modify and redistribute granted by the license, users are provided only
;; with a limited warranty  and the software's author,  the holder of the
;; economic rights,  and the successive licensors  have only  limited
;; liability. 
;; 
;; In this respect, the user's attention is drawn to the risks associated
;; with loading,  using,  modifying and/or developing or reproducing the
;; software by the user in light of its specific status of free software,
;; that may mean  that it is complicated to manipulate,  and  that  also
;; therefore means  that it is reserved for developers  and  experienced
;; professionals having in-depth computer knowledge. Users are therefore
;; encouraged to load and test the software's suitability as regards their
;; requirements in conditions enabling the security of their systems and/or 
;; data to be ensured and,  more generally, to use and operate it in the 
;; same conditions as regards security. 
;; 
;; The fact that you are presently reading this means that you have had
;; knowledge of the CeCILL license and that you accept its terms.
;; 
;;; Commentary:

;; accents-tex : change les caractères accentués en accents tex
;; conserve les majuscules, sans demander confirmation.
;;
;; accents-de-tex : change les accents tex en caracteres accentués sans
;; demander confirmation.  les majuscules sont respectees.
;;

(require 'eieio)

(dolist (v '(accents-convertisseur-cache
	     accents-convertisseur-le-cache
	     accents-convertisseur-base
	     accents-convertisseur-simple
	     accents-convertisseur-inverse
	     accents-convertisseur-html
	     accents-convertisseur-de-html))
  (makunbound v))

(defclass accents-convertisseur-cache ()
  ((table-de-hashage
    :initarg :table-de-hashage)
   (expression-rationnelle
    :initarg :expression-rationnelle
    :documentation "Expression rationnelle s'accordant aux
    lettres accentuées à remplacer.")
   (id-convertisseur
    :initarg :id-convertisseur
    :initform nil
    :type symbol)
   (lecteur-clef
    :initarg :lecteur-clef
    :initform nil))
  "C'est la classe qui fait le boulot effectif de remplacement.")

(defvar accents-convertisseur-le-cache
  (make-instance 'accents-convertisseur-cache
		 :table-de-hashage (make-hash-table :test 'equal)))

(defmethod accents-conversion 
  ((this accents-convertisseur-cache) &optional beg end)
  (let (cleanup)
    (save-excursion
      (goto-char (or beg (point-min)))
      (setq end (if (integerp end) 
		    (let ((m (make-marker))) 
		      (setq cleanup t)
		      (set-marker m end)
		      m)
		  end))
      (save-match-data
	(let ((case-fold-search nil)
	      (table-de-hashage (oref this :table-de-hashage))
	      (expression-rationnelle (oref this :expression-rationnelle))
	      (lecteur-clef (or (oref this :lecteur-clef) 
				(function (lambda () (match-string-no-properties 0))))))

	  (while (re-search-forward expression-rationnelle end t)
	    (let ((replacement  
		   (gethash  (funcall lecteur-clef)
			     table-de-hashage)))
	      (and replacement
		   (replace-match replacement t t)))))))
    (when cleanup
      (set-marker end nil))))

(defclass accents-convertisseur-base ()
  ((cache
    :allocation :class
    :documentation "État en cache du convertisseur"))
  "Classe de base pour un convertisseur"  )
(oset-default accents-convertisseur-base cache 
	      accents-convertisseur-le-cache)

(defclass accents-convertisseur-simple 
  (accents-convertisseur-base)
  ((id
    :initarg :id
    :documentation "Symbole d'itentification unique pour le
    cache.")
   (liste-de-remplacement
    :initarg :liste-de-remplacement
    :documentation "Liste d'association") )
  "")

(defmacro accents-definir-conversion
  (CLASS CAR CDR &optional LECTEUR-CLEF)
  `(defmethod accents-conversion 
     ((this ,CLASS) &optional beg end)

     (let ((cache (oref this cache))
	   (id (oref this :id)))
       (unless (eq (oref cache :id-convertisseur)
		   id)
	 (oset cache :id-convertisseur ,LECTEUR-CLEF)
	 (oset cache :lecteur-clef nil)
	 (let ((table-de-hashage (oref cache :table-de-hashage))
	       (liste-de-remplacement (oref this :liste-de-remplacement)))
	   (clrhash table-de-hashage)
	   (dolist (k liste-de-remplacement)
	     (puthash (,CAR k) (,CDR k) table-de-hashage))
	   (oset cache :expression-rationnelle
		 (regexp-opt (mapcar (quote ,CAR) liste-de-remplacement)))))
       (accents-conversion cache beg end))))

(accents-definir-conversion accents-convertisseur-simple car cdr)

(defclass accents-convertisseur-inverse
  (accents-convertisseur-simple)
  ()
  "Convertisseur pour effectuer la conversion inverse vis-à-vis
  de la liste de remplacement.")

(accents-definir-conversion accents-convertisseur-inverse cdr car)

(defun accents-moteur (liste-des-remplacements &optional convert-to-re)
  (save-excursion
	(save-match-data
	  (let ((case-fold-search nil)
		(re (if convert-to-re 
			(mapconcat 'identity 
				   (mapcar 'car liste-des-remplacements)
				   "\\|")
		      (regexp-opt  (mapcar 'car liste-des-remplacements)))))
	    (goto-char (point-min))
	    (while (re-search-forward re nil t)
	      (replace-match
	       (if convert-to-re
		   (save-match-data 
		     (assoc-default (match-string 0) 
				    liste-des-remplacements 'string-match))
		 (cdr (assoc-string (match-string 0) liste-des-remplacements)))
	       t; fixed case
	       t; literal
	       ))))))

(defconst accents-converstisseur-tex
  (make-instance 
   'accents-convertisseur-simple
   :id 'accents-converstisseur-tex
   :liste-de-remplacement 
   '(("\�" . "\\'A")
     ("\À" . "\\`A")
     ("\Â" . "\\^A")
     ("\Ä" .  "\\\"A")
     ("\É" . "\\'E")
     ("\È" . "\\`E")
     ("\Ê" . "\\^E")
     ("\Ë" .  "\\\"E")
     ("\�" . "\\'I")
     ("\Ì" . "\\`I")
     ("\ÃŽ" . "\\^I")
     ("\�" .  "\\\"I")
     ("\0" . "\\'O")
     ("\Ã’" . "\\`O")
     ("\Ô" . "\\^O")
     ("\Ö" .  "\\\"O")
     ("\Ú" . "\\'U")
     ("\Ù" . "\\`U")
     ("\Û" . "\\^U")
     ("\Ü" .  "\\\"U")
     ("\Ç" . "\\c{C}")
     ("\á" . "\\'a")
     ("\à" . "\\`a")
     ("\â" . "\\^a")
     ("\ä"  .  "\\\"a")
     ("\é" . "\\'e")
     ("\è" . "\\`e")
     ("\ê" . "\\^e")
     ("\ë" .  "\\\"e")
     ("\í" .  "\\'\\i")
     ("\ì" .  "\\`\\i")
     ("\î" .  "\\^\\i")
     ("\ï" .  "\\\"\\i")
     ("\ó" . "\\'o")
     ("\ò" . "\\`o")
     ("\ô" . "\\^o")
     ("\ö" .  "\\\"o")
     ("\ú" . "\\'u")
     ("\ù" . "\\`u")
     ("\û" . "\\^u")
     ("\ü" .  "\\\"u")
     ("\ç" . "\\c{c}")
     ("\×" . "\\times{}")
)
   
   )
  "Convertisseur de lettres accentuées en séquence TeX
  équivalentes.")

(defun accents-tex ()
  (interactive)
  "change les caracteres accentues en accents tex"
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-conversion accents-convertisseur-tex beg end)
    ))

(defun accents-de-tex ()
  (interactive)
  "change les caracteres accentues en accents tex"
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-moteur
     '(( "\\\\'[ \n\t]*A" . "\�")
       ( "\\\\`[ \n\t]*A" . "\À")
       ( "\\\\^[ \n\t]*A" . "\Â")
       ( "\\\\\"[ \n\t]*A" . "\Ä")
       ( "\\\\'[ \n\t]*E" . "\É")
       ( "\\\\`[ \n\t]*E" . "\È")
       ( "\\\\^[ \n\t]*E" . "\Ê" )
       ( "\\\\\"[ \n\t]*E" . "\Ë")
       ( "\\\\'[ \n\t]*I" . "\�")
       ( "\\\\`[ \n\t]*I" . "\Ì")
       ( "\\\\^[ \n\t]*I" . "\ÃŽ")
       ( "\\\\\"[ \n\t]*I" . "\�")
       ( "\\\\'[ \n\t]*O" . "\0")
       ( "\\\\`[ \n\t]*O" . "\Ã’")
       ( "\\\\^[ \n\t]*O" . "\Ô")
       ( "\\\\\"[ \n\t]*O" . "\Ö")
       ( "\\\\'[ \n\t]*U" . "\Ú")
       ( "\\\\`[ \n\t]*U" . "\Ù")
       ( "\\\\^[ \n\t]*U" . "\Û")
       ( "\\\\\"[ \n\t]*U" . "\Ü")
       ( "\\\\c[ \n\t]*{C}" . "\Ç")
       ( "\\\\'[ \n\t]*{A}" . "\�")
       ( "\\\\`[ \n\t]*{A}" . "\À")
       ( "\\\\^[ \n\t]*{A}" . "\Â")
       ( "\\\\\"[ \n\t]*{A}" . "\Ä")
       ( "\\\\'[ \n\t]*{E}" . "\É")
       ( "\\\\`[ \n\t]*{E}" . "\È")
       ( "\\\\^[ \n\t]*{E}" . "\Ê" )
       ( "\\\\\"[ \n\t]*{E}" . "\Ë")
       ( "\\\\'[ \n\t]*{I}" . "\�")
       ( "\\\\`[ \n\t]*{I}" . "\Ì")
       ( "\\\\^[ \n\t]*{I}" . "\ÃŽ")
       ( "\\\\\"[ \n\t]*{I}" . "\�")
       ( "\\\\'[ \n\t]*{O}" . "\0")
       ( "\\\\`[ \n\t]*{O}" . "\Ã’")
       ( "\\\\^[ \n\t]*{O}" . "\Ô")
       ( "\\\\\"[ \n\t]*{O}" . "\Ö")
       ( "\\\\'[ \n\t]*{U}" . "\Ú")
       ( "\\\\`[ \n\t]*{U}" . "\Ù")
       ( "\\\\^[ \n\t]*{U}" . "\Û")
       ( "\\\\'[ \n\t]*a" . "\á" )
       ( "\\\\`[ \n\t]*a" . "\à" )
       ( "\\\\^[ \n\t]*a" . "\â" )
       ( "\\\\\"[ \n\t]*a" . "\ä" )
       ( "\\\\'[ \n\t]*e" . "\é" )
       ( "\\\\`[ \n\t]*e" . "\è")
       ( "\\\\^[ \n\t]*e" . "\ê")
       ( "\\\\\"[ \n\t]*e" . "\ë")
       ( "\\\\'{\\\\i}" . "\í")
       ( "\\\\`{\\\\i}" . "\ì")
       ( "\\\\^{\\\\i}" . "\î")
       ( "\\\\\"{\\\\i}" . "\ï")
       ( "\\\\'\\\\[ \n\t]*i" . "\í")
       ( "\\\\`\\\\[ \n\t]*i" . "\ì")
       ( "\\\\^\\\\[ \n\t]*i" . "\î")
       ( "\\\\\"\\\\[ \n\t]*i" . "\ï")
       ( "\\\\'[ \n\t]*o" . "\ó")
       ( "\\\\`[ \n\t]*o" . "\ò")
       ( "\\\\^[ \n\t]*o" . "\ô")
       ( "\\\\\"[ \n\t]*o" . "\ö")
       (  "\\\\'[ \n\t]*u" . "\ú")
       ( "\\\\`[ \n\t]*u" . "\ù")
       ( "\\\\^[ \n\t]*u" . "\û")
       ( "\\\\\"[ \n\t]*u" . "\ü")
       ( "\\\\c[ \n\t]*{c}" . "\ç")
       ( "\\\\\"[ \n\t]*{u}" . "\ü")
       ( "\\\\'[ \n\t]*{a}" . "\á" )
       ( "\\\\`[ \n\t]*{a}" . "\à" )
       ( "\\\\^[ \n\t]*{a}" . "\â" )
       ( "\\\\\"[ \n\t]*{a}" . "\ä" )
       ( "\\\\'[ \n\t]*{e}" . "\é" )
       ( "\\\\`[ \n\t]*{e}" . "\è")
       ( "\\\\^[ \n\t]*{e}" . "\ê")
       ( "\\\\\"[ \n\t]*{e}" . "\ë")
       ( "\\\\'[ \n\t]*{o}" . "\ó")
       ( "\\\\`[ \n\t]*{o}" . "\ò")
       ( "\\\\^[ \n\t]*{o}" . "\ô")
       ( "\\\\\"[ \n\t]*{o}" . "\ö")
       (  "\\\\'[ \n\t]*{u}" . "\ú")
       ( "\\\\`[ \n\t]*{u}" . "\ù")
       ( "\\\\^[ \n\t]*{u}" . "\û")
       ( "\\\\\"[ \n\t]*{u}" . "\ü")
       )
     t ;; utilisation de d'expression régulière
     )
    ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; accents-texinfo : change les caractères accentués en accents texinfo sans
;; demander confirmation les majuscules sont respectées
;;
;; texinfo-accents : change les accents Texinfo en caractères accentués sans
;; demander confirmation les majuscules sont respectées

(defconst accents-convertisseur-texinfo
  (make-instance 
   'accents-convertisseur-simple
   :id 'accents-convertisseur-texinfo
   :liste-de-remplacement 
   '(("\�" . "@'A")
     ("\À" . "@`A")
     ("\Â" . "@^A")
     ("\Ä" .  "@\"A")
     ("\É" . "@'E")
     ("\È" . "@`E")
     ("\Ê" . "@^E")
     ("\Ë" .  "@\"E")
     ("\�" . "@'I")
     ("\Ì" . "@`I")
     ("\ÃŽ" . "@^I")
     ("\�" .  "@\"I")
     ( "\Å’" . "@OE{}")
     ("\0" . "@'O")
     ("\Ç" . "@,{C}")
     ("\Ã’" . "@`O")
     ("\Ô" . "@^O")
     ("\Ö" .  "@\"O")
     ("\Ø" . "@O{}")
     ("\¿" . "@questiondown{}")
     ("\¡" . "@exclamdown{}")
     ("\Ù" . "@`U")
     ("\Ú" . "@'U")
     ("\Û" . "@^U")
     ("\Ü" .  "@\"U")
     ("\ß" . "@ss{}")
     ("\æ" . "@ae{}")
     ( "\–" . " -- ")
     ( "\—" . " --- ")
     ("\á" . "@'a")
     ("\à" . "@`a")
     ("\â" . "@^a")
     ("\ä"  .  "@\"a")
     ("\é" . "@'e")
     ("\è" . "@`e")
     ("\ê" . "@^e")
     ("\ë" .  "@\"e")
     ("\í" .  "@'{@dotless{i}}")
     ("\ì" .  "@`{@dotless{i}}")
     ("\î" .  "@^{@dotless{i}}")
     ("\ï" .  "@\"{@dotless{i}}")
     ("\ó" . "@'o")
     ("\ò" . "@`o")
     ("\ø" . "@o{}")
     ( "\Å“" . "@oe{}")
     ("\ô" . "@^o")
     ("\ö" .  "@\"o")
     ("\ú" . "@'u")
     ("\ù" . "@`u")
     ("\û" . "@^u")
     ("\ü" .  "@\"u")
     ("\ç" . "@,{c}"))
   
   )
  "Convertisseur de lettres accentuées en séquence Texinfo
  équivalentes.")

(defconst accents-convertisseur-de-texinfo
  (make-instance
   'accents-convertisseur-inverse
   :id 'accents-convertisseur-de-texinfo
   :liste-de-remplacement (oref accents-convertisseur-texinfo
				:liste-de-remplacement))
  "Converstisseur d'entités Texinfo en lettres accentuées équivalentes" )

(defun accents-texinfo ()
  (interactive)
  "change les caractères accentués en entités Texinfo équivalentes."
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-conversion accents-convertisseur-texinfo beg end)))


(defun accents-de-texinfo ()
  (interactive)
  "change les entités TEXINFO en caractères accentués équivalents."
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-conversion accents-convertisseur-de-texinfo beg end)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; accents-html : change les caractères accentués en accents HTML sans demander
;; confirmation les majuscules sont respectées
;;
;; html-accents : change les accents HTML en caractères accentués sans demander
;; confirmation les majuscules sont respectées

(defconst accents-convertisseur-html
  (make-instance 'accents-convertisseur-simple 
		 :id 'accents-convertisseur-html
		 :liste-de-remplacement
   '(
     ( "\∀" . "&forall;")
     ( "\∂" . "&part;")
     ( "\∃" . "&exist;")
     ( "\∅" . "&empty;")
     ( "\∇" . "&nabla;")
     ( "\∈" . "&isin;")
     ( "\∉" . "&notin;")
     ( "\∋" . "&ni;")
     ( "\�" . "&prod;")
     ( "\∑" . "&sum;")
     ( "\−" . "&minus;")
     ( "\∗" . "&lowast;")
     ( "\√" . "&radic;")
     ( "\�" . "&prop;")
     ( "\∞" . "&infin;")
     ( "\∠" . "&ang;")
     ( "\∧" . "&and;")
     ( "\∨" . "&or;")
     ( "\∩" . "&cap;")
     ( "\∪" . "&cup;")
     ( "\∫" . "&int;")
     ( "\∴" . "&there4;")
     ( "\∼" . "&sim;")
     ( "\≅" . "&cong;")
     ( "\≈" . "&asymp;")
     ( "\≠" . "&ne;")
     ( "\≡" . "&equiv;")
     ( "\≤" . "&le;")
     ( "\≥" . "&ge;")
     ( "\⊂" . "&sub;")
     ( "\⊃" . "&sup;")
     ( "\⊄" . "&nsub;")
     ( "\⊆" . "&sube;")
     ( "\⊇" . "&supe;")
     ( "\⊕" . "&oplus;")
     ( "\⊗" . "&otimes;")
     ( "\⊥" . "&perp;")
     ( "\â‹…" . "&sdot;")
     ( "\Α" . "&Alpha;")
     ( "\Î’" . "&Beta;")
     ( "\Γ" . "&Gamma;")
     ( "\Δ" . "&Delta;")
     ( "\Ε" . "&Epsilon;")
     ( "\Ζ" . "&Zeta;")
     ( "\Η" . "&Eta;")
     ( "\Θ" . "&Theta;")
     ( "\Ι" . "&Iota;")
     ( "\Κ" . "&Kappa;")
     ( "\Λ" . "&Lambda;")
     ( "\Μ" . "&Mu;")
     ( "\�" . "&Nu;")
     ( "\Ξ" . "&Xi;")
     ( "\Ο" . "&Omicron;")
     ( "\Π" . "&Pi;")
     ( "\Ρ" . "&Rho;")
     ( "\Σ" . "&Sigma;")
     ( "\Τ" . "&Tau;")
     ( "\Î¥" . "&Upsilon;")
     ( "\Φ" . "&Phi;")
     ( "\Χ" . "&Chi;")
     ( "\Ψ" . "&Psi;")
     ( "\Ω" . "&Omega;")
     ( "\α" . "&alpha;")
     ( "\β" . "&beta;")
     ( "\γ" . "&gamma;")
     ( "\δ" . "&delta;")
     ( "\ε" . "&epsilon;")
     ( "\ζ" . "&zeta;")
     ( "\η" . "&eta;")
     ( "\θ" . "&theta;")
     ( "\ι" . "&iota;")
     ( "\κ" . "&kappa;")
     ( "\λ" . "&lambda;")
     ( "\μ" . "&mu;")
     ( "\ν" . "&nu;")
     ( "\ξ" . "&xi;")
     ( "\ο" . "&omicron;")
     ( "\Ï€" . "&pi;")
     ( "\�" . "&rho;")
     ( "\Ï‚" . "&sigmaf;")
     ( "\σ" . "&sigma;")
     ( "\Ï„" . "&tau;")
     ( "\Ï…" . "&upsilon;")
     ( "\φ" . "&phi;")
     ( "\χ" . "&chi;")
     ( "\ψ" . "&psi;")
     ( "\ω" . "&omega;")
     ( "\Ï‘" . "&thetasym;")
     ( "\Ï’" . "&upsih;")
     ( "\Ï–" . "&piv;")
     ( "\Å’" . "&OElig;")
     ( "\Å“" . "&oelig;")
     ( "\Å " . "&Scaron;")
     ( "\Å¡" . "&scaron;")
     ( "\Ÿ" . "&Yuml;")
     ( "\Æ’" . "&fnof;")
     ( "\ˆ" . "&circ;")
     ( "\˜" . "&tilde;")
     ( "\ " . "&ensp;")
     ( "\ " . "&emsp;")
     ( "\ " . "&thinsp;")
     ( "\‌" . "&zwnj;")
     ( "\�" . "&zwj;")
     ( "\‎" . "&lrm;")
     ( "\�" . "&rlm;")
     ( "\–" . "&ndash;")
     ( "\—" . "&mdash;")
     ( "\‘" . "&lsquo;")
     ( "\’" . "&rsquo;")
     ( "\‚" . "&sbquo;")
     ( "\“" . "&ldquo;")
     ( "\�" . "&rdquo;")
     ( "\„" . "&bdquo;")
     ( "\†" . "&dagger;")
     ( "\‡" . "&Dagger;")
     ( "\•" . "&bull;")
     ( "\…" . "&hellip;")
     ( "\‰" . "&permil;")
     ( "\′" . "&prime;")
     ( "\″" . "&Prime;")
     ( "\‹" . "&lsaquo;")
     ( "\›" . "&rsaquo;")
     ( "\‾" . "&oline;")
     ( "\¢" . "&cent;")
     ( "\€" . "&euro;")
     ( "\£" . "&pound;")
     ( "\Â¥" . "&yen;")
     ( "\§" . "&sect;")
     ( "\©" . "&copy;")
     ( "\®" . "&reg;")
     ( "\â„¢" . "&trade;")
     ( "\ℵ" . "&alefsym;")
     ( "\�" . "&larr;")
     ( "\↑" . "&uarr;")
     ( "\→" . "&rarr;")
     ( "\↓" . "&darr;")
     ( "\↔" . "&harr;")
     ( "\↵" . "&crarr;")
     ( "\�" . "&lArr;")
     ( "\⇒" . "&rArr;")
     ( "\⇔" . "&hArr;")
     ( "\⇓" . "&dArr;")
     ( "\⇑" . "&uArr;")
     ( "\↨"  . "&#8616;")
     ( "\⌈" . "&lceil;")
     ( "\⌉" . "&rceil;")
     ( "\⌊" . "&lfloor;")
     ( "\⌋" . "&rfloor;")
     ( "\â—Š" . "&loz;")
     ( "\â™ " . "&spades;")
     ( "\♣" . "&clubs;")
     ( "\♥" . "&hearts;")
     ( "\♦" . "&diams;")
     ( "\�" . "&Aacute;")
     ( "\À" . "&Agrave;")
     ( "\Â" . "&Acirc;")
     ( "\Ä" . "&Auml;")
     ( "\É" . "&Eacute;")
     ( "È" . "&Egrave;")
     ( "\Ê" . "&Ecirc;")
     ( "\Ë" . "&Euml;")
     ( "\�" . "&Iacute;")
     ( "\Ì" . "&Igrave;")
     ( "\ÃŽ" . "&Icirc;")
     ( "\�" . "&Iuml;")
     ( "\Ó" . "&Oacute;")
     ( "\Ã’" . "&Ograve;")
     ( "\Ô" . "&Ocirc;")
     ( "\Ö" . "&Ouml;")
     ( "\Ú" . "&Uacute")
     ( "\Ù" . "&Ugrave;")
     ( "\Û" . "&Ucirc;")
     ( "\Ü" . "&Uuml;")
     ( "\Ç" . "&Ccedil;")
     ( "\á" . "&aacute;")
     ( "\à" . "&agrave;")
     ( "\â" . "&acirc;")
     ( "\ä" . "&auml;")
     ( "\é" . "&eacute;")
     ( "\è" . "&egrave;")
     ( "\ê" . "&ecirc;")
     ( "\ë" . "&euml;")
     ( "\…" . "&hellip;")
     ( "\í" . "&iacute;")
     ( "\ì" . "&igrave;")
     ( "\î" . "&icirc;")
     ( "\ "  . "&nbsp;")
     ( "\ï" . "&iuml;")
     ( "\ó" . "&oacute;")
     ( "\ò" . "&ograve;")
     ( "\Å“" . "&oelig;")
     ( "\ô" . "&ocirc;")
     ( "\ö" . "&ouml;")
     ( "\ú" . "&uacute")
     ( "\ù" . "&ugrave;")
     ( "\û" . "&ucirc;")
     ( "\ü" . "&uuml;")
     ( "\ç" . "&ccedil;")
     ("\«"  . "&laquo;")
     ("\»"  . "&raquo;")
     ("\ß" . "&szlig;")
     ("\Þ" . "&THORN;")
     ("�" . "&#357;")
     ("\ž" . "&#382;")
     ("\¡" . "&iexcl;")
     ("\¤" . "&curren;")
     ("\¦" . "&brvbar;")
     ("\¨" . "&uml;")
     ("\ª" . "&ordf;")
     ("\¬" . "&not;")
     ("\­" . "&shy;")
     ("\¯" . "&macr;")
     ("\°" . "&deg;")
     ("\±" . "&plusmn;")
     ("\²" . "&sup2;")
     ("\³" . "&sup3;")
     ("\´" . "&acute;")
     ("\µ" . "&micro;")
     ("\¶" . "&para'")
     ("\·" . "&middot;")
     ("\¸" . "&cedil;")
     ("\¹" . "&sup1;")
     ("\º" . "&ordm;")
     ("\¼" . "&frac14;")
     ("\½" . "&frac12;")
     ("\¾" . "&frac34;")
     ("\¿" . "&iquest;")
     ("\Ã" . "&Atilde;")
     ("\Ã…" . "&Aring;")
     ("\Æ" . "&AElig;")
     ("\�" . "&ETH;")
     ("\Ñ" . "&Ntilde;")
     ("\×" . "&times;")
     ("\Ø" . "&Oslash;")
     ("\�" . "&Yacute;")
     ("\ã" . "&atilde;")
     ("\Ã¥" . "&aring;")
     ("\æ" . "&aelig;")
     ("\ð" . "&eth;")
     ("\ñ" . "&ntilde;")
     ("\õ" . "&otilde;")
     ("\÷" . "&divide;")
     ("\ø" . "&oslash;")
     ("\ý" . "&yacute;")
     ("\þ" . "&thorn;")
     ("\ÿ" . "&yuml;")
     ) )
  "Converstisseur de lettres accentuées en entités HTML équivalentes. 
Cf http://www.webdesigneuse.net/Trouver-une-entite-HTML.html")

(defconst accents-convertisseur-de-html
  (make-instance
   'accents-convertisseur-inverse
   :id 'accents-convertisseur-de-html
   :liste-de-remplacement (oref accents-convertisseur-html
				:liste-de-remplacement))
  "Converstisseur d'entités HTML en lettres accentuées équivalentes" )

(defun accents-html ()
  (interactive)
  "change les caractères accentués en entités HTML équivalentes."
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-conversion accents-convertisseur-html beg end)))


(defun accents-de-html ()
  (interactive)
  "change les entités HTML en caractères accentués équivalents."
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end (let ((m make-marker)) (set-marker m (region-end)) m)))
    (accents-conversion accents-convertisseur-de-html beg end)
    (save-excursion
      (save-match-data 
	(goto-char (or beg (point-min)))
	(while (re-search-forward "&#\\([0-9]+\\);" end t)
	  (replace-match (string (string-to-number (match-string 1))) t t))))
    (when end (set-marker end nil))))

;;---------------------------------------------------------------------------

(defconst accents-convertisseur-quote-html
  (make-instance 'accents-convertisseur-simple 
		 :id 'accents-convertisseur-quote-html
		 :liste-de-remplacement
		 '( ( "<" . "&lt;")
		    ( ">" . "&gt;")
		    ( "\"" . "&quot;")))
  "Convertisseur des caractères `\"', `<', et `>' en entités HTML
  &quot; &lt; et &gt correspondantes.")

(defconst accents-convertisseur-de-quote-html
  (make-instance
   'accents-convertisseur-inverse
   :id 'accents-convertisseur-de-quote-html
   :liste-de-remplacement (oref accents-convertisseur-quote-html
				:liste-de-remplacement))
  "Convertisseur des entités HTML &quot; &lt; et &gt, en caractères correspondants." )

(defun accents-quote-html ()
  (interactive)
  "Convertisseur des caractères `\"', `<', et `>' en entités HTML
  &quot; &lt; et &gt correspondantes."
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-conversion accents-convertisseur-quote-html beg end)))

;;---------------------------------------------------------------------------
(defconst accents-convertisseur-de-utf-8
  (make-instance 
   'accents-convertisseur-simple
   :id 'accents-convertisseur-de-utf-8
   :liste-de-remplacement 
   '(("ï" . "ï")
     ("é" . "é")
     ("â" . "â")
     ("û" . "û")
     ("è" . "è")
     ("ä" . "ä")
     ("ù" . "ù")
     ( "ç" . "ç")
     ("ê" . "ê")
     ("à" . "à")
     ("ô" . "ô")
     ))
  "Conversion de codage UTF-8 non reconue en caractères équivalents")

(defconst accents-convertisseur-de-utf-8
  (make-instance 
   'accents-convertisseur-simple
   :id 'accents-convertisseur-de-utf-8
   :liste-de-remplacement 
   '(
     ("ƒ‹" . "ы")
     ("ƒÃ" . "�")
     ("‘�" . "�")
     ("à" . "à")
     ("â" . "â")
     ("ä" . "ä")
     ("ç" . "ç")
     ("è" . "è")
     ("é" . "é")
     ("ê" . "ê")
     ("ï" . "ï")
     ("ô" . "ô")     
     ("î" . "î")
     ("ù" . "ù")
     ("û" . "û")
     ("��" . "�")
     ("�Ÿ" . "П")
     ("�°" . "а")
     ("�²" . "в")     
     ("�´" . "д")
     ("�µ" . "е")     
     ("�¶" . "ж")
     ("�·" . "з")
     ("�¸" . "и")     
     ("�º" . "к")
     ("�»" . "л")
     ("�¾" . "о")
     ("р" . "р")
     ("р" . "р")
     ("т" . "т")
     ("у" . "у")
     ("ÑÅ" . "т")
     ("�±" . "б")
     ("т´" . "�")
     ("µÑ" . "е")
     ("ˆÑ" . "е")
     ("�£" . "У")
     ("�½" . "н")
     ("�¯" . "Я")
     ("�³" . "г")
     ("ÑÄ" . "т")
     ("�¾" . "о")
     ("ÑÃ" . "у")
     ("‘Ž" . "ю")
     ("�" . "�")
     ("�°" . "а")
     ("�½" . "н")
     ("ш" . "ш")
     ("�¸" . "и")
     ("ю" . "ю")
     
))
  "Conversion de codage UTF-8 non reconue en caractères équivalents")

(defun doit ()
  (interactive)
  (insert (logand (aref (buffer-substring-no-properties (point) (1+ (point))) 0) 255))
  (delete-region (point) (1+ (point))))

(defconst accents-convertisseur-utf-8
  (make-instance 
   'accents-convertisseur-inverse
   :id 'accents-convertisseur-utf-8
   :liste-de-remplacement (oref accents-convertisseur-de-utf-8
				:liste-de-remplacement))
  "Conversion de codage UTF-8 non reconue en caractères équivalents")

(defun accents-de-utf-8 ()
  (interactive)
  "change les séquence UTF-8 en caractères accentués équivalents."
  (accents-conversion accents-convertisseur-de-utf-8))

(defun accents-utf-8 ()
  (interactive)
  "change les caractères accentués en séquences UTF-8  équivalentes."
  (accents-conversion accents-convertisseur-utf-8))

(provide 'accents-ascii)

Revision-number: 24
Prop-content-length: 226
Content-length: 226

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2012-02-22T18:42:07.000000Z
K 7
svn:log
V 123
- Correction problème de localisateur avec identifiant unique
- Correction re-utilisation du tampon de sortie d'erreur.

PROPS-END

Node-path: trunk/lisp/html-to-texinfo.el
Node-kind: file
Node-action: change
Text-content-length: 67293
Text-content-md5: 31b8fff5bfba8d0b4f5a313a40a355be
Content-length: 67293

;;; html-to-texinfo.el --- -*- coding: iso-8859-1 -*-
;; Copyright 2010/2012 Vincent Belaïche
;;
;; Author: Vincent Belaïche <vincent.b.1@hotmail.fr>
;; Version: $Id: html-to-texinfo.el,v 1.13 2012-02-22 18:42:07 Vincent Exp $
;; Keywords: Texinfo, HTML, conversion
;; X-URL: not distributed yet
;;
;; This software is governed by the CeCILL license under French law and
;; abiding by the rules of distribution of free software.  You can  use,
;; modify and/ or redistribute the software under the terms of the CeCILL
;; license as circulated by CEA, CNRS and INRIA at the following URL
;; "http://www.cecill.info".
;;
;; As a counterpart to the access to the source code and  rights to copy,
;; modify and redistribute granted by the license, users are provided only
;; with a limited warranty  and the software's author,  the holder of the
;; economic rights,  and the successive licensors  have only  limited
;; liability.
;;
;; In this respect, the user's attention is drawn to the risks associated
;; with loading,  using,  modifying and/or developing or reproducing the
;; software by the user in light of its specific status of free software,
;; that may mean  that it is complicated to manipulate,  and  that  also
;; therefore means  that it is reserved for developers  and  experienced
;; professionals having in-depth computer knowledge. Users are therefore
;; encouraged to load and test the software's suitability as regards their
;; requirements in conditions enabling the security of their systems and/or
;; data to be ensured and,  more generally, to use and operate it in the
;; same conditions as regards security.
;;
;; The fact that you are presently reading this means that you have had
;; knowledge of the CeCILL license and that you accept its terms.
;;
;;; Commentary:

;;

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'html-to-texinfo)

;;; Code:

(provide 'html-to-texinfo)
(eval-when-compile
  (require 'cl))
(require 'eieio)
(require 'calc-ext)
(require 'accents-ascii)
(require 'doubly-linked-list)
(require 'compile)

;;;;##########################################################################
;;;;  User Options, Variables
;;;;##########################################################################

(defconst html2texi-suspicious-html-tags
  '("meta" "br" "hr" "link" "img" "frame")
"Liste des balises pour lesquelles le HTML ne suit pas une
syntaxe strictement XML. Par exemple `<br>' est utilisé au lieu
de `<br/>'."  )

(defconst html2texi-suspicious-html-tags-re
  (regexp-opt html2texi-suspicious-html-tags))

(defconst html2texi-non-recursive-tags
  '("p" "li"))

(defconst html2texi-hierarchy-list
  '(
    (li (ul ol))
    (tr (table))
    (th (tr))
    (td (tr))
    (dd (dl))
    (dt (dl))  ))

(defconst html2texi-non-recursive-tags-re
  (regexp-opt html2texi-non-recursive-tags))

(defconst html2texi-filepath-re
  "\\(?:[A-Za-z]:\\)?[- ~+A-Za-z_0-9./\\]+")

(defconst html2texi-texi-buffer-local-variables
  '(html2texi-document-information)
    "Liste des variables déclarées localement au tampon Texinfo.")

(defconst html2texi-allowed-markup-in-@center
  '(img b i em tt strong dfn code)
  "Liste des balises autorisées pour @center.")

(defconst html2texi-@center-max-size 1000)

(defclass html2texi-simple-markup ()
  ((class-dependant
    :initarg :class-dependant
    :initform nil
    :custom '(repeat
	  (list
	   (regexp :tag "clef")
	   (string :tag "prologue")
	   (string :tag "épilogue")
	   (boolean :tag "conserver les espaces et retours chariot")
	   ))
    :documentation "\
Liste d'association dont les éléments sont de la forme
 (CLEF PROLOGUE ÉPILOGUE)

Supposons que l'objet décrit le traitement de la balise TAG,
alors lorsque le code HTML `<TAG class=\"CLEF\">CONTENU</TAG>'
est rencontré, alors il est convertie en le code Texinfo
`PROLOGUE TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU.")
   (preamble
    :initarg :preamble
    :type string
    :documentation "\
Prologue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (postamble
    :initarg :postamble
    :type string
    :documentation "\
Épilogue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (space-verb
    :initarg :space-verb
    :initform nil
    :type boolean
    :documentation "\
Vrai lorsque les espaces et retours chariot sont à conserver tels quels."
    ))
  :documentation "\
Un object de type `html2texi-simple-markup'
décrit le traitement d'une balise simple comme par exemple
<code>.")

(defclass html2texi-locator-info (doli2-element)
 ((id
   :initarg :id
   :type string
   :documentation "Identifiant d'ancre.")
  (type
   :initarg :type
   :type symbol
   :documentation "Soit `:html2texi-@anchor', `:html2texi-@ref',
   ou `:html2texi-@node'."  )
  (position
   :initarg :position
   :type integer
   :documention "Point dans le tampon Texinfo où l'ancre est utilisée."))
:documentation "Détient l'information concernant une ancre
utilisée soit par un `@anchor', soit un `@node', soit un
`@ref'.")

(defclass html2texi-locator-listing (doli2-list)
  ((hash-table
    :initarg :hash-table))
  :documentation "Liste de `html2texi-locator-info', c'est à dire
    de pointeurs sur des `@node', `@ref' ou `@anchor', de sorte à
    embellir les nom d'ancre a postériori."  )

(defmethod initialize-instance ((this html2texi-locator-listing) &rest fields)
  (call-next-method)
  (oset this :hash-table (make-hash-table)))

(defmethod html2texi-add-locator ((this html2texi-locator-listing) locator-info)
  (let* ((locator-id (oref locator-info :id))
	 (table (oref this :hash-table))
	 (previous  (oref this :locator-info-list)))
    (oset locator-info :previous previous)
    (oset this :locator-info-list (cons locator-info previous))
    (puthash
     locator-id
     (cons locator-info (gethash locator-id table))
     table)))

(defclass html2texi-files-to-do-listing ()
  ((already-to-do
   :initarg :already-to-do
   :initform nil
   :documentation "Liste des fichiers qui ont été trouvés comme
   étant à traiter lors du traitement d'un fichier qui a déjà été
   complètement traité.")
   (doing-or-done
    :initarg :doing-or-done
    :initform nil
    :documentation "Liste des fichiers qui ont déjà été traités, le
    premier de la liste est le fichier en cours de traitement."
    )
   (added-file-count
    :initarg :added-file-count
    :initform 0
    :documentation "Nombre de fichier qui est été ajouté à la
  liste des fichiers à traiter.")
   (soon-to-do
   :initarg :soon-to-do
   :initform nil
   :documentation "Liste des fichiers qui sont trouvés comme
   étant à traiter lors du traitement du fichier en cours de
   traitement."))
  :documentation "Objet servant à lister les fichiers à
  traiter. Il comprend deux listes: `already-to-do' et
  `soon-to-do' parce que lors du traitement d'un fichier TOTO les
  nouveaux fichiers à traiter sont mis dans `soon-to-do' dans
  l'ordre où ils sont rencontrés, du coup une fois que le fichier
  TOTO a complètement été traité, on inverse cet ordre en
  transvasant le contenu de `soon-to-do' dans `already-to-do'.")

(defclass html2texi-table-fmt-ctxt ()
  ((col-number
    :initarg :col-number
    :initform 0
    :type integer)
   (row-number
    :initarg :row-number
    :initform 0
    :type integer)
   (head-on-row-0
    :initarg :head-on-row-0
    :initform nil
    :type boolean)
   (force-head
    :initarg :force-head
    :initform nil
    :type boolean)
   (col-count
    :initarg :col-count
    :initform 0
    :type integer
    :documentation
    "Nombre de colonnes dans le tableau.")
   (col-info
    :initarg :col-info
    :documentation
    "Liste d'information sur chaque colonne. Le premier élément
    est factice est ne correspond à aucune colonne.")
   (col-info-last
    :initarg :col-info-last
    :documentation
    "Pointe sur la dernière cons-cell de l'attribut `:col-info'.")
   (col-info-length
    :initarg :col-info-length
    :initform 0
    :type integer))
  :documentation "Contexte de formattage d'une table.")

(defmethod initialize-instance ((this html2texi-table-fmt-ctxt) &rest fields)
  (call-next-method)
  (let ((ci (list 0)))
    ;; le premier élément ne correspond pas à une colonne mais servira à
    ;; reduire le vecteur des informations sur chaque colonne
    (oset this :col-info ci)
    (oset this :col-info-last ci)))


(defmethod html2texi-files-has-to-do ((this html2texi-files-to-do-listing))
  (or (oref this :already-to-do)
      (oref this :soon-to-do))  )

(defmethod html2texi-current-file ((this html2texi-files-to-do-listing))
  (car (oref this :doing-or-done)))

(defmethod html2texi-get-next-file-next-to-do  ((this html2texi-files-to-do-listing))
  "Récupère le prochain fichier à traiter. L'appel de cette
méthode si aucun fichier n'est à traiter génère une erreur."
  (let ((soon-to-do (oref this :soon-to-do))
	(already-to-do (oref this :already-to-do)))
    (when soon-to-do
      (while soon-to-do (push (pop soon-to-do) already-to-do))
      (oset this :soon-to-do nil))
    (let ((next (pop already-to-do)))
      (oset this :already-to-do already-to-do)
      (oset this :doing-or-done (cons next (oref this :doing-or-done)))
      next)))

(defmethod html2texi-add-file-to-do   ((this html2texi-files-to-do-listing) next)
  "Ajoute le fichier dont le nom absolu est NEXT à la liste des
fichier à traiter. Renvoie `nil' si le fichier était déjà
connu, non-`nil' sinon."
  (unless (or (member next (oref this :already-to-do))
	      (member next (oref this :doing-or-done))
	      (member next (oref this :soon-to-do)))
    (oset this :soon-to-do (cons next (oref this :soon-to-do)))
    (oset this :added-file-count (1+ (oref this :added-file-count)))))

(defun html2texi-texinfo-inside-comment-p ()
  "Renvoie non nil lorsque le point est dans un commentaire Texinfo."
  (save-match-data
    (save-excursion
      (let ((cur (point))
	    (end (progn (end-of-line) (point))))
	(beginning-of-line)
	(and (re-search-forward "\\(^\\|[^@]\\)@c\\(omment\\)\\_>" end t)
	     (<= (match-beginning 0) cur))))))

(defmethod html2texi-handle-simple-markup
  ((this html2texi-simple-markup) xml-expr)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe
			(and class-attribute
			     (assoc-string (cdr class-attribute)
					   (oref this :class-dependant))))
		      (list (oref this :preamble)
			    (oref this :postamble)))))
    (insert (car pre-post))
    (let ((beg (point))
	  end)
      (html2texi-process-xml-expr xml-expr)
      (unless (oref this :space-verb)
	(setq end (point-marker))
	(goto-char beg)
	(while (re-search-forward "[\n\r]\\s-*" nil end)
	  (let ((replace-str " "))
	    (save-match-data
	      (cond
	       ((html2texi-texinfo-inside-comment-p)
		(setq replace-str nil))))
	      (and replace-str (replace-match replace-str t t)))))
	(goto-char end)
	(set-marker end nil))
    (insert (cadr pre-post))))


(defcustom html2texi-save-texi-buffer-confirm-p
  t
  "`nil' pour sauvegarder sans confirmation le tampon Texinfo
après la conversion, `t' sinon."
  :type '(radio
	  (const :tag "Sans confirmation" nil)
	  (const :tag "Demander confirmation" t))
  :group 'html2texi)

(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-reuse-log-buffer t
  "Mettre à `nil' pour que le tampon de sortie des erreurs &
avertissement soit re-généré avec un nom unique à chaque
traitement."
  :type  '(radio
	  (const :tag "Créer un nouveau tampon d'erreurs à chaque conversion." nil)
	  (const :tag "Réutiliser le tampon d'erreurs s'il existe déjà." t))
  :group 'html2texi)

(defcustom html2texi-url-encoding
  :html2texi-utf-8
  "Sélectionne le codage des URL."
  :type '(radio
	  (symbol :tag "UTF-8" :html2texi-utf-8)
	  (symbol :tag "ISO-8859-1" :html2texi-latin-1))
  :group 'html2texi)

(defcustom html2texi-i-simple-markup
  (html2texi-simple-markup "html2texi-i-simple-markup"
   :preamble "@i{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-b-simple-markup
  (html2texi-simple-markup "html2texi-b-simple-markup"
   :preamble "@b{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-kbd-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :preamble "@kbd{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-dfn-simple-markup
  (html2texi-simple-markup "html2texi-dfn-simple-markup"
   :preamble "@dfn{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-em-simple-markup
  (html2texi-simple-markup "html2texi-em-simple-markup"
   :preamble "@emph{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-sub-simple-markup
  (html2texi-simple-markup "html2texi-sub-simple-markup"
   :preamble ""
   :postamble "")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<sub class=\"CLEF\">CONTENU</sub>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-sup-simple-markup
  (html2texi-simple-markup "html2texi-sup-simple-markup"
   :preamble ""
   :postamble "")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<sup class=\"CLEF\">CONTENU</sup>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-samp-simple-markup
  (html2texi-simple-markup "html2texi-samp-simple-markup"
   :preamble "@samp{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<samp class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-strong-simple-markup
  (html2texi-simple-markup "html2texi-strong-simple-markup"
   :preamble "@strong{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-tt-simple-markup
  (html2texi-simple-markup "html2texi-tt-simple-markup"
   :preamble "@t{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<tt class=\"CLEF\">CONTENU</tt>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-handle-two-columns-table-as-@table
  t
 "Si `nil' alors une table `<table>...</table>'
avec deux colonne sera gérée en texinfo par une `@table', si non
`nil', alors elle sera gérée par une `@multitable'."
  :type
  '(choice
    (const :tag "t pour @table" t)
    (const :tag "nil pour @multitable" nil))
  :group 'html2texi)

(defcustom html2texi-log-error-names
   ["Erreur fatale" "Erreur" "Avertissement" "Info"]
   "Liste des types d'erreur préfixant les messages d'erreur dans
le tampon de sortie des erreurs & avertissement de traitement."
   :type
   '(vector
     (string :tag "Erreur fatale")
     (string :tag "Erreur")
     (string :tag "Avertissement")
     (string :tag "Info"))
   :group 'html2texi  )

(defcustom html2texi-log-buffer-name
  "*HTML2TEXI*"
  "Nom du tampon de sortie des erreurs et avertissements de traitement."
  :type 'string
  :group 'html2texi)

(defcustom html2texi-beautify-locators
  t
  "Embellit les identificateur de localisateur après génération
  du Texinfo."
  :type '(radio
	  (const :tag "Ne pas embellir les identificateurs de localisateur." nil)
	  (const :tag "Embellir les identificateurs de localisateur." t))
  :group 'html2texi )

(defvar html2texi-document-information nil
  "Liste d'association pour mémoriser les informations (titre,
  auteurs, etc...) propres à un document.")

(defvar html2texi-line-delta 0
  "Décalage entre le numéro de ligne du code XML au sein le
  tampon Texinfo en cours de traitement, et son numéro de ligne
  dans le fichier HTML source.")

(defvar html2texi-xml-stack nil
  "Pile des expressions XML")

(defvar html2texi-keep-empty-strings nil
  "Non nil si les chaînes vides sont à conserver.")

(defvar html2texi-ignore-head nil
  "Non nil si on ignore le <head> (dans un fichier HTML lié).")

(defvar html2texi-directory-stack nil
  "Pile des chemins de répertoire.")

(defvar html2texi-files-to-do nil
  "Base des fichiers non encore traités, instanciée localement
  comme un objet de class `html2texi-files-to-do-listing'.")

(defvar html2texi-flushable-anchors nil
  "Liste de nom d'ancrage de lien dont l'insertion a été remise à
  plus tard." )

(defvar html2texi-postpone-output nil
  "Non `nil' lorsque l'insertion du code est remise à plus tard.")

(defvar html2texi-directory-ref nil
  "Répertoire de référence")

(defvar html2texi-log-buffer nil
  "Tampon de sortie des erreurs et avertissements de traitement.")

(defvar html2texi-reusable-log-buffer nil
  "Quand `html2texi-reuse-log-buffer' vaut est non `nil', tampon
  qu'on essaie de reutiliser pour la sortie des erreurs..")

(defvar html2texi-texi-buffer-name nil
  "Nom du tampon Texinfo généré.")

(defvar html2texi-locator-list nil
  "Liste des ancres, pour post-traitement d'embellissement des
  identificateur d'ancre.")

(defmacro html2texi-make-simple-markup-handler (tag)
  `(defun ,(intern (concat "html2texi-tag-handler-" (symbol-name tag)))
     (xml-expr)
     (html2texi-handle-simple-markup
      ,(intern (concat "html2texi-"  (symbol-name tag) "-simple-markup"))
      xml-expr) ))

(defun html2texi-make-html-clean-xml (beg end)
  (let  ((end-arg end)
	 end)
    ;; initialisation de end comme un marque
    (if (markerp end-arg)
	(setq end end-arg)
      (goto-char end-arg)
      (setq end (point-marker)))

    ;; rend les balise implicitement auto-closante vraiment auto-closante
    (goto-char beg)
    (while (re-search-forward (concat "<\\(" html2texi-suspicious-html-tags-re "\\)\\>")
			      end t)
      (let ((tag (match-string-no-properties 1)))
	(unless (re-search-forward ">" nil t)
	  (html2texi-fatal-error "Clôture non trouvé pour la balise %s" nil
				 tag))
	(when (null (looking-back "/>"))
	  (backward-char)
	  (insert "/")
	  (forward-char))))

    ;; marque de paragraphe et de ligne
    (goto-char beg)
    (let (tag-stack pos-< pos->
		    tag is-closure self-closing)
      (while (re-search-forward "<\\(/\\)?\\([a-zA-Z]+\\)\\>" end t)
	(setq pos-< (match-beginning 0)
	      tag (match-string-no-properties 2)
	      is-closure (match-string-no-properties 1))
	(unless (string= tag (downcase tag))
	  (replace-match (setq tag (downcase tag)) 2))
	(unless (re-search-forward ">" end t)
	  (html2texi-fatal-error "Soufflet de clôture non trouvé pour la balise %s" nil
		 tag))

	(setq pos-> (point)
	      self-closing (looking-back "/>"))
	(cond
	 ((and self-closing  is-closure)
	  (html2texi-fatal-error "balise %s à la fois de clôture et auto-closante" nil
		 tag))

	 (self-closing
	  ;; do nothing
	  )

	 ((null is-closure)
	  (when (and
		 (string-match (concat "\\`" html2texi-non-recursive-tags-re "\\'") tag)
		 tag-stack
		 (string= tag (caar tag-stack)))
	    ;; clôture
	    (save-excursion
	      (goto-char pos-<)
	      (insert "</" tag "><!-- HTML2TEXI: repaired (1) -->")
	      (html2texi-warning "Ajout clôture `</%s>'" nil tag))
	    (pop tag-stack))
	  (push (list tag) tag-stack))

	 (is-closure
	  (if (and tag-stack
		   (string= (caar tag-stack) tag))
	      (pop tag-stack)
	    (let ((first (assoc-string tag tag-stack)) rev)
	      (if first
		  (progn
		    (while (and tag-stack (null (eq (car tag-stack) first)))
		      (push (pop tag-stack) rev))
		    (pop tag-stack)
		    (save-excursion
		      (goto-char pos-<)
		      (dolist (c rev)
			(insert  "</" (car c) "><!-- HTML2TEXI: repaired (2) -->" )
			(html2texi-warning "Ajout clôture `</%s>'" nil tag))))

		(save-excursion
		  (goto-char pos->)
		  (insert "-->")
		  (goto-char pos-<)
		  (insert "<!-- HTML2TEXI: repaired (3). "))
		(html2texi-warning "Clôture de %s ne correspondant à aucune ouverture" nil tag)))))))


      (let (p-pos li-pos markup poss pos)
	(while (re-search-forward "<\\(/\\)?\\(p\\|li\\)\\>[^>]*>" end t)
	  (setq markup (match-string-no-properties 2)
		poss (intern (concat markup "-pos"))
		pos (symbol-value poss))
	  (if (match-string-no-properties 1)
	      (if  pos
		  (if (= pos (match-beginning 0))
		      (set poss nil)
		    (html2texi-fatal-error "Clôture de balise %s ne correspondant à aucune ouverture" nil
					   (match-string-no-properties 0)))
		(save-excursion
		  (save-match-data
		    (unless  (re-search-forward
			      (format "<\\(/\\)?\\(%s\\)\\>[^>]+>" markup)
			      end t)
		      (html2texi-fatal-error "Ouverture de balise <%s> sans clôture" nil
					     markup))
		    (set poss (match-beginning 0))
		    (unless (match-string-no-properties 1)
		      (goto-char (match-beginning 0))
		      (insert (format "</%s>" markup))
		      (dolist (symb '(p-pos li-pos))
			(unless (or (null (symbol-value symb))
				    (eq symb poss))
			  (set symb (+ (length markup) 3 (symbol-value symb)))))))))))
	))

    ;; mise entre guillemets anglais des attributs entier sans guillemets
    (goto-char beg)
    (let (p1 p2 added-dquote-attributes p-start p-end)
      ;; tant qu'on trouve potentiellement un attribut sans "..."
      (while (re-search-forward "\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([-+]?[0-9]+\\)"
				nil end)
	(setq p1 (match-beginning 1)
	      p2 (match-end 0))
	(if
	    ;; si la position est bien entre < et >
	    (and (re-search-backward "[<>]" beg t)
		 (looking-at "<\\sw+")
		 (progn
		   (goto-char (setq p-start (match-end 0)))
		   (re-search-forward "[<>]" end t)
		   (string= (match-string-no-properties 0) ">"))
		 (>= (setq p-end (match-beginning 0)) p1))
	    ;; alors on fait la réparation
	    (progn
	      (goto-char p-start)
	      (while
		  (progn
		    (while (looking-at "\\(?:\\s-\\|\n\\)*\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\"[^\"]*\"")
		      (goto-char (match-end 0)))
		    (cond
		     ((looking-at  "\\(?:\\s-\\|\n\\)*\\(\\sw+\\)\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([-+]?[0-9]+\\)")
		      (push (match-string-no-properties 1) added-dquote-attributes)
		      (goto-char (match-beginning 2))
		      (insert ?\")
		      (goto-char (1+ (match-end 2)))
		      (insert ?\")
		      (setq p-end (+ 2 p-end)))
		     ((looking-at "\\(?:\\s-\\|\n\\)*>")
		      (goto-char (match-end 0))
		      (insert "<!-- HTML2TEXI inserted double quotes around values for attibutes: "
			      (mapconcat (lambda (x) (concat "`" x "'"))
					 added-dquote-attributes
					 ", ")
			      " -->")
		      nil)
		     (t (html2texi-error "Attribut au format invalide: %s."
			       (buffer-substring (point) p-end)))))))
	  ;; sinon on continue à chercher un attribut potentiel dont la valeur
	  ;; n'est pas entre "..."
	  (goto-char p2))))

    ;; un peu de ménage...
    (unless (markerp end-arg)
      (set-marker end nil)) ))

;;;==========================================================================
;;; définition des gestionnaires de balise
;;;--------------------------------------------------------------------------

(defun html2texi-tag-handler-a (xml-expr)
  (let (name href text (xml-expr-length (length xml-expr)))
    (dolist (attrib (cadr xml-expr))
      (cond
       ((eq (car attrib) 'href)
	(setq href (cdr attrib)))
       ((eq (car attrib) 'name)
	(setq name (cdr attrib)))))
    (and (cddr xml-expr)
	 (setq text (caddr xml-expr)))
    (cond
     (href (html2texi-process-url href text))
     ((= xml-expr-length 3)
      (cond
       ((stringp text)
	(insert (html2texi-string-escape text t)))
       ((consp text) (html2texi-process-xml-expr text))
       (t (error "Le format du text de la balise <a> était inattendu"))))
     ((> xml-expr-length 3)
      (html2texi-process-xml-expr `(div nil ,@(cddr xml-expr)))))
    (and name
      (insert
       "\n@anchor{"
       (html2texi-make-anchor
	(concat
	  (file-relative-name 
	   (html2texi-current-file html2texi-files-to-do) 
	   html2texi-directory-ref)
	 "#" name))
       "}\n"))))

(html2texi-make-simple-markup-handler b)

(defun html2texi-flush-anchors ()
  (while html2texi-flushable-anchors
    (insert "@anchor{" (pop html2texi-flushable-anchors) "}\n")))


(defun html2texi-tag-handler-h1 (xml-expr)
  (insert "@chapter " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))


(defun html2texi-tag-handler-h2 (xml-expr)
  (insert "@section " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))

(defun html2texi-tag-handler-h3 (xml-expr)
  (insert "@subsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
    (html2texi-flush-anchors))

(defun html2texi-tag-handler-h4 (xml-expr)
  (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))

(defun html2texi-tag-handler-h5 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
     (html2texi-flush-anchors))

(defun html2texi-tag-handler-h6 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
   (html2texi-flush-anchors))

(html2texi-make-simple-markup-handler samp)


(defun html2texi-get-col-span (xml-expr)
  ;; xml-expr is <td> or <th>
  (let ((col-span (cdr-safe (assq 'colspan (nth 1 xml-expr)))))
    (setq col-span
	  (cond
	   ((integerp
	       (setq col-span
		     (if (stringp col-span)
			 (string-to-number col-span)
		       col-span)))
	      col-span)
	   ((null col-span) 1)
	   (t (error "colspan invalide"))))  ))

(html2texi-make-simple-markup-handler sub)
(html2texi-make-simple-markup-handler sup)

(html2texi-make-simple-markup-handler tt)

(defvar html2texi-table-fmt-current-ctxt nil)

(defun html2texi-tag-handler-table (xml-expr)
  (let* ((html2texi-table-fmt-current-ctxt (html2texi-table-fmt-ctxt "Table formatting context"))
	 (xml-table-info
	  (vector xml-expr;0: table items
		  nil;1: thead items
		  nil;2: tbody items
		  nil;3: tfoot items
		  0;4: bitmap champ trouvé:
					; 1 = plain table (found a tr item not a thead|tbody|tfoot)
					; 2 = thead found
					; 4 = tbody found
					; 8 = tfoot found
		  0;5: bitmap traité
		  1;6: en cours de traitement
		  ))
	 (xml-items (cddr xml-expr)))

    ;; tout d'abord on analyse la table pour trouver le nombre de colonne
    (while (or xml-items (/= (aref xml-table-info 4)  (aref xml-table-info 5)))
      (if xml-items
	  (let ((xml-expr (pop xml-items)))
	    (cond
	     ((and (consp xml-expr)
		   (eq (car xml-expr) 'tr))
	      (when (= (aref xml-table-info 6) 1)
		;; cas d'une table avec les lignes directement sous <table> ... </table>
		(and (/= (logand (aref xml-table-info 4)
				 14) 0)
		     (html2texi-error "Table avec à la fois des lignes directement sous <table> ... </table>\
 et des lignes sous une balise <X>...</X> avec X dans {thead, tbody, tfoot}" xml-expr))
		(aset xml-table-info 4 (logior (aref xml-table-info 4) 1)))
	      ;; plus besoin de chercher une ligne: on compte les colonnes sur la
	      ;; première ligne trouvée
	      (setq xml-items nil)
	      (dolist  (xml-expr (cddr xml-expr))
		(cond
		 ((consp xml-expr)
		  (if (memq  (car xml-expr) '(th td))
		      (progn
			(oset html2texi-table-fmt-current-ctxt :col-count
			      (+ (oref html2texi-table-fmt-current-ctxt :col-count)
				 (html2texi-get-col-span xml-expr)))
			(when (> (oref html2texi-table-fmt-current-ctxt :col-count)
				 (oref html2texi-table-fmt-current-ctxt :col-info-length))
			  (let ((l (make-list (- (oref html2texi-table-fmt-current-ctxt :col-count)
						 (oref html2texi-table-fmt-current-ctxt :col-info-length))
					      '(abs 1))))
			    (setcdr (oref html2texi-table-fmt-current-ctxt :col-info-last) l)
			    (oset html2texi-table-fmt-current-ctxt :col-info-last (last l))
			    (oset html2texi-table-fmt-current-ctxt :col-info-length
				  (oref html2texi-table-fmt-current-ctxt :col-count)))))
		    (html2texi-error "balise inattendu dans une table" xml-expr)))
		 ((stringp xml-expr)
		  (unless (string-match
			   "\\`\\s-*\\(\n\\s-*\\)*\\'"
			   xml-expr)
		    (html2texi-error "Chaîne inattendue" xml-expr)))
		 (t (html2texi-error "Élément inattendu" xml-expr)))))

	     ;; la table est organisé en thead/tbody/tfoot
	     ((and (consp xml-expr)
		   (memq (car xml-expr) '(thead tbody tfoot)))
	      (let* ((thead 1) (tbody 2) (tfoot 3) (index (symbol-value (car xml-expr))))
		(and (/= (logand (aref xml-table-info 4)
				 (lsh 1 index)) 0)
		     (html2texi-error "Balise `%s' en double dans la table"
				      (aref xml-table-info 0)
				      (symbol-name (car xml-expr))))
		(aset xml-table-info 4 (logior  (aref xml-table-info 4) (lsh 1 index)))
		(aset xml-table-info index xml-expr)))

	     ;; chaîne qui n'est pas un blanc au beau milieu de la table...
	     ((stringp xml-expr)
	      (unless (string-match
		       "\\`\\s-*\\(\n\\s-*\\)*\\'"
		       xml-expr)
		(html2texi-error "Chaîne inattendue" xml-expr)))
	     (t (html2texi-error "Élément inattendu" xml-expr))))
	;; xml-items est nil

	;; on marque le champ courant (c.-à-d. table | thead | tbody | tfoot)
	;; comme ayant été traité
	(aset xml-table-info 5 (logior
				(aref xml-table-info 5)
				(logand
				 (aref xml-table-info 4)
				 (aref xml-table-info 6))))
	;; maintenant on cherche s'il en est un champ restant à parcourir
	(let ((index 0)
	      (to-be-processed (logxor  (aref xml-table-info 4)
					(aref xml-table-info 5))))
	  (while (and (/= to-be-processed 0)
		      (= (logand to-be-processed 1) 0))
	    (setq index (1+ index)
		  to-be-processed (lsh to-be-processed -1)))
	  (when (/= to-be-processed 0)
	    (setq xml-items (cdr-safe (cdr-safe (aref xml-table-info index))))
	    (aset xml-table-info 6 (lsh 1 index))) )))


    ;; maintenant qu'on a fini d'analyser la table, on peut la traiter.
    (if (or (> (oref html2texi-table-fmt-current-ctxt :col-count) 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(progn
	  (insert "@multitable @columnfractions ")
	  ;(debug)
	  (let ((total-weight
		 (math-reduce-vec
		  (lambda (r x)
		    (+ r
		       (cond
			((eq (car x) 'abs) (cadr x))
			((eq (car x) 'rel)
			 (setcar x 'abs)
			 (setcar (cdr x)
				 (* (cadr x)
				    (oref html2texi-table-fmt-current-ctxt :col-info-length))) (cadr x)))))
		  (cons 'vec (oref html2texi-table-fmt-current-ctxt :col-info)))))
	    (insert
	     (mapconcat
	      (lambda (x)
		(number-to-string
		 (/ (float (cadr x)) (oref html2texi-table-fmt-current-ctxt :col-info-length))))
	      (cdr (oref html2texi-table-fmt-current-ctxt :col-info))
	      " ")))
	  (insert "\n"))
      (insert "@table\n"))

    (dotimes (i 4)
      (when (/= 0 (logand (aref xml-table-info 4) (lsh 1 i)))
	(if (/= i 2)
	    (html2texi-process-xml-expr  (aref xml-table-info i))
	  (oset html2texi-table-fmt-current-ctxt :force-head t)
	  (html2texi-process-xml-expr  (aref xml-table-info 2))
	  (oset html2texi-table-fmt-current-ctxt :force-head nil))))

    (if (or (> (oref html2texi-table-fmt-current-ctxt :col-count) 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(insert "@end multitable\n")
      (insert "@end table\n"))))


(defun html2texi-tag-handler-tr (xml-expr)
  (oset html2texi-table-fmt-current-ctxt :col-number 0)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n")
  (oset html2texi-table-fmt-current-ctxt :row-number
	(1+ (oref html2texi-table-fmt-current-ctxt :row-number))))

(defun html2texi-tag-handler-th (xml-expr)
  (if   (= 0 (oref html2texi-table-fmt-current-ctxt :col-number))
      (if (and (= 0 (oref html2texi-table-fmt-current-ctxt :row-number))
	       (null html2texi-handle-two-columns-table-as-@table))
	  (progn
	    (oset html2texi-table-fmt-current-ctxt :head-on-row-0 t)
	    (insert "@headitem ")
	    (html2texi-process-xml-expr xml-expr))
	(insert "@item ")
	(html2texi-process-xml-expr xml-expr))
    (when (or (> (oref html2texi-table-fmt-current-ctxt :col-count) 2)
	      (null html2texi-handle-two-columns-table-as-@table))
      (insert "@tab "))
    (html2texi-process-xml-expr xml-expr)
    (unless (and  (= 0 (oref html2texi-table-fmt-current-ctxt :row-number))
		  (oref html2texi-table-fmt-current-ctxt :head-on-row-0))
	(insert "\n")))
  (oset html2texi-table-fmt-current-ctxt :col-number
	(1+ (oref html2texi-table-fmt-current-ctxt :col-number))))

(defun html2texi-tag-handler-td (xml-expr)
  (if  (oref html2texi-table-fmt-current-ctxt :force-head)
      (html2texi-tag-handler-th xml-expr)
    (if (= 0 (oref html2texi-table-fmt-current-ctxt :col-number))
	(insert "@item ")
      (if (or (> (oref html2texi-table-fmt-current-ctxt :col-count) 2)
	      (null html2texi-handle-two-columns-table-as-@table))
	  (insert "@tab ")))
    (html2texi-process-xml-expr xml-expr)
    (insert "\n")
    (oset html2texi-table-fmt-current-ctxt :col-number
	  (1+ (oref html2texi-table-fmt-current-ctxt :col-number)))))

(defun html2texi-cur-dir ()
  "Détermine le répertoire courant relativement au répertoire du
HTML racine de départ. La valeur retournée se termine par une oblique `/'"
  (let ((cur-dir  (nreverse (split-string (cdar html2texi-directory-stack) "/")))
	(ref-dir  (nreverse (split-string html2texi-directory-ref "/"))))
    (unless (and (string= (car cur-dir) "")
		 (string= (car ref-dir) ""))
      (error "Format invalide de répertoire"))
    (setq cur-dir (nreverse (cdr cur-dir))
	  ref-dir (cdr ref-dir))
    (if (or (string= (car cur-dir) "")
	    (string-match "\\`[a-z]:" (car cur-dir)))
	;; cur-dir est un chemin absolu
	(progn
	  (setq ref-dir (nreverse ref-dir))
	  (while (and cur-dir ref-dir (string= (car cur-dir) (car ref-dir)))
	    (setq cur-dir (cdr cur-dir)
		  ref-dir (cdr ref-dir)))
	  (while ref-dir
	    (push ".." cur-dir)
	    (setq ref-dir (cdr ref-dir)))
	  (concat (mapconcat 'identity cur-dir "/") "/"))
      (while (and cur-dir
		  (cond
		   ((string= (car cur-dir) "..")
		    (unless ref-dir
		      (error "Chemin invalide"))
		    (setq ref-dir (cdr ref-dir)
			  cur-dir (cdr cur-dir)))
		   ((string= (car cur-dir) ".")
		    (setq cur-dir (cdr cur-dir)))
		   (t nil))))
      (dolist (e cur-dir)
	(push e ref-dir))
      (mapconcat 'identity  (nreverse (cons "" ref-dir)) "/") )))

(defun html2texi-anchor-escape (anchor)
  (let (ret)
    (setq anchor
	  (mapconcat
	   'identity
	   (split-string anchor "-") "--"))
    (mapc
     (lambda (x)
       (if
	(or (and (>= x ?a) (<= x ?z))
	     (and (>= x ?A) (<= x ?Z))
	     (and (>= x ?0) (<= x ?9))
	     (member x '(?_ ?- ?/)))
	   (push (string x) ret)
	 (push (format "-%04x" x) ret)))
     anchor)
    (apply 'concat (nreverse ret))))

(defun html2texi-make-anchor (name &optional escape-function)
  (let* ((anchor (expand-file-name (concat (html2texi-cur-dir) name)))
	 (l-a (length anchor))
	 (l-r (length html2texi-directory-ref))
	 (l (min l-a l-r))
	 (start 0)
	 (i -1))
    (while (and
	    (< (setq i (1+ i)) l)
	    (prog1
		(= (aref anchor i) (aref html2texi-directory-ref i))
	      (and (= (aref anchor i) ?/)
		   (setq start (1+ i))))))
    (setq anchor (list (substring anchor start)))
    (dotimes (i (length (split-string (substring html2texi-directory-ref start))))
      (push "../" anchor))
    (setq anchor (apply 'concat anchor))
    (html2texi-string-escape (funcall (or escape-function 'html2texi-anchor-escape) anchor))))

(defun html2texi-simple-markup-handle (xml-expr class-alist preamble postamble)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe
			(and class-attribute
			     (assoc-string (cdr class-attribute) class-alist)))
		      (list preamble postamble))))
    (insert (car pre-post))
   (html2texi-process-xml-expr xml-expr)
   (insert (cadr pre-post))))

(defun html2texi-tag-handler-body (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))


(html2texi-make-simple-markup-handler code)

(defun html2texi-tag-handler-br (xml-expr)
  (insert "@*\n"))

(defun html2texi-tag-handler-div (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(html2texi-make-simple-markup-handler dfn)

(defun html2texi-tag-handler-dl (xml-expr)
  (insert "@table @asis\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "@end table\n"))

(defun html2texi-tag-handler-dt (xml-expr)
  (insert "@item ")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(defun html2texi-tag-handler-dd (xml-expr)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(html2texi-make-simple-markup-handler em)

(defun html2texi-tag-handler-frameset (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-frame (xml-expr)
  (let (url text)
    (dolist (x (cadr xml-expr))
      (cond
       ((eq (car x) 'src)
	(setq url (cdr x)))
       ((eq (car x) 'name)
	(setq text (cdr x)))))
    (when url
      (html2texi-process-url url text))))

(defun html2texi-tag-handler-hr (xml-expr)
  (insert "@c <hr/>\n"))

(html2texi-make-simple-markup-handler kbd)

(defun html2texi-tag-handler-html (xml-expr)
  "\
Traitement de la balise html."
  (let* ((attributes (nth 1 xml-expr))
	 (lang (assq 'lang attributes)))
    (when lang
      	(html2texi-set-doc-info 'language (cdr lang))))
    (html2texi-process-xml-expr xml-expr))

(html2texi-make-simple-markup-handler strong)

(defun html2texi-handle-string (str)
  (let (ret (pos0 0) pos1 (len (length str)))
    (while (and
	    (< pos0 len)
	    (setq pos1 (string-match "[{}@]" str pos0)))
      (push (substring str pos0 pos1) ret)
      (push (concat "@" (match-string-no-properties 0 str)) ret)
      (setq pos0 (1+ pos1)))
    (when (< pos0 len)
      (push (substring str pos0 pos1) ret))
    (apply 'concat (nreverse ret))))

(defun html2texi-generate-or-reuse-log-buffer ()
  (if (buffer-live-p html2texi-reusable-log-buffer)
	(with-current-buffer html2texi-reusable-log-buffer 
	 (let ((inhibit-read-only t))
	   (erase-buffer)
	   html2texi-reusable-log-buffer))
    (setq html2texi-reusable-log-buffer 
	  (let* ((compilation-error-regexp-alist
		  '(html-to-texinfo-error
		    html-to-texinfo-warning
		    html-to-texinfo-info))
		 (b (generate-new-buffer html2texi-log-buffer-name)))
	    (with-current-buffer b
	      (compilation-mode)
	      b)))))

(defun html2texi-fatal-error (format-str xml-expr &rest args)
  (html2texi-with-log
   (insert (aref html2texi-log-error-names 0) ":"
	   (html2texi-current-file html2texi-files-to-do) ":"
	   (if (eq xml-expr :html2texi-generic-error)
	       ""
	     (format "%d:" (+ line-number html2texi-line-delta)))
	   (apply
	    'format
	    (concat format-str
		    "\n"
		    (aref html2texi-log-error-names 3)
		    ": <<<-----------\n"
		    (aref html2texi-log-error-names 3)
		    ": xml-expr=%S\n"
		    (aref html2texi-log-error-names 3)
		    ": xml-stack=%S\nInfo: ----------->>>\n")
	    `( ,@args ,xml-expr ,html2texi-xml-stack)) ?\n))
  (apply 'error format-str args))

(defmacro html2texi-with-log (&rest body)
  `(progn
     (setq html2texi-log-buffer (html2texi-generate-or-reuse-log-buffer))
     (display-buffer html2texi-log-buffer)
     (let ((line-number (line-number-at-pos)))
       (with-current-buffer html2texi-log-buffer
	 (let ((inhibit-read-only t))
	   ,@body)))))


(defun html2texi-error (format-str xml-expr &rest args)
  (html2texi-with-log
   (insert (aref html2texi-log-error-names 1) ":"
	   (html2texi-current-file html2texi-files-to-do) ":"
	   (if (eq xml-expr :html2texi-generic-error)
	       ""
	     (format "%d:" (+ line-number html2texi-line-delta)))
	   " "
	   (apply 'format format-str args) ?\n)))

(defun html2texi-warning (format-str xml-expr &rest args)
  (html2texi-with-log
   (insert (aref html2texi-log-error-names 2) ":"
	   (html2texi-current-file html2texi-files-to-do)":"
	   (if (eq xml-expr :html2texi-generic-error)
	       ""
	     (format "%d:" (+  line-number html2texi-line-delta)))
	   (apply 'format format-str args) ?\n)))

(defun html2texi-info (format-str xml-expr &rest args)
  (html2texi-with-log
   (insert (aref html2texi-log-error-names 3) ":"
	   (html2texi-current-file html2texi-files-to-do)":"
	   (if (eq xml-expr :html2texi-generic-error)
	       ""
	     (format "%d:" (+  line-number html2texi-line-delta)))
	   (apply 'format format-str args) ?\n)))

(defun html2texi-decode-url (url)
  "Décode les `%20' et autres séquences hexadécimale"
  (with-temp-buffer
    (insert url)
    (goto-char (point-min))
    (while (re-search-forward "%\\([[:xdigit:]]\\{2\\}\\)" nil t)
      (replace-match (string (math-read-radix
			       (match-string-no-properties 1) 16)) t t))
    (when (eq html2texi-url-encoding :html2texi-utf-8)
      (accents-de-utf-8))
    (buffer-substring (point-min) (point-max))))

(defun html2texi-process-url (url text)
  (let* ((parsed-url (url-generic-parse-url (html2texi-decode-url url)))
	 url-list
	 i
	 absolute-file-name
	 locator
	 relative-file-name
	 qualifed-locator)
    ;; petit hack parce que url-generic-parse-url ne fait pas complètement le
    ;; boulot
    (when (and
	   (null  (aref parsed-url 1))
	   (setq i (string-match "#" (aref parsed-url 6)))
	   (null (aref parsed-url 7)))
      (aset parsed-url 7 (substring (aref parsed-url 6) (1+ i)))
      (aset parsed-url 6 (substring (aref parsed-url 6) 0 i)))

    ;; Analyse des nom de fichiers
    (setq absolute-file-name
	  (expand-file-name (aref parsed-url 6) 
			    (file-name-directory (html2texi-current-file html2texi-files-to-do)))
	   relative-file-name (file-relative-name absolute-file-name html2texi-directory-ref))

    (push "@uref{" url-list) ; ça peut être défait ensuite
    ;; URL
    (if (and (eq (aref parsed-url 0)
		 'cl-struct-url)
	     (null (aref parsed-url 1)))
	;; cas où il n'y a pas de protocole
	(cond
	 ;; on pointe vers un fichier HTML, ce n'est donc pas forcément une URL interne
	 ;; => cas suspect
	 ((member (file-name-extension absolute-file-name)
		  '("html" "htm"))
	  (html2texi-add-file-to-do html2texi-files-to-do absolute-file-name)
	  (setq locator (aref parsed-url 7)
		qualified-locator (if locator (concat relative-file-name "#" locator) relative-file-name))

	  (if (and (file-exists-p absolute-file-name)
		   (null (file-name-absolute-p relative-file-name)))
	      (setq
	       url-list (list
			 (html2texi-make-anchor qualified-locator)
			 "@ref{"))
	    (push (html2texi-string-escape qualified-locator) url-list)))

	 ;; cas d'une URL interne
	 ((and (string= "" (aref parsed-url 6))
	       (setq locator (aref parsed-url 7)))
	  (setq qualified-locator  
		(concat 
		 (file-relative-name 
		  (html2texi-current-file html2texi-files-to-do) 
		  html2texi-directory-ref)
		 "#" locator)
		url-list
		(list
		 (html2texi-make-anchor qualified-locator)
		 "@ref{")))

	 ;; cas d'une URL dont on est sûr quelle est externe.
	  (t
	    (push (html2texi-string-escape url) url-list)))
        (push (html2texi-string-escape url) url-list))
     ;; Text
     (when text
       (push "," url-list)
       (push (html2texi-string-escape text) url-list))
     (push "}" url-list)
     (apply 'insert (nreverse url-list))))

(defun html2texi-tag-handler-center (xml-expr)
  (let ((start-point (point))
	(start-ln (line-number-at-pos))
	end-mark)
    (html2texi-process-xml-expr xml-expr)
    (when (and (<= (point) (+ start-point html2texi-@center-max-size))
	       (> (point) start-point)
	       ;; test histoire que le code soit à l'épreuve du temps : il se
	       ;; pourrait qu'on soit déjà centré pour une autre raison.
	       (null (save-excursion
		       (goto-char start-point)
		       (looking-at "\\(\n\\|\\s-\\)*@center\\>")))
	       (let (to-do
		     (ok t)
		     xml-expr
		     (l (cdr-safe (cdr-safe xml-expr))))
		 (while (and ok (or to-do l))
		   (if l
		       (progn
			 (setq xml-expr (pop l))
			 (cond
			  ((stringp xml-expr))
			  ((and (consp xml-expr)
				(memq (car xml-expr) html2texi-allowed-markup-in-@center))
			   (push xml-expr to-do))
			  (t (setq ok nil))))
		     (setq l (cdr-safe (cdr-safe (pop to-do))))))
		 (when ok
		   (setq end-mark (point-marker))
		   (goto-char start-point)
		   (insert "\n@center ")
		   (while (search-forward "\n" end-mark t)
		     (delete-char -1)
		     (insert 32))
		   (goto-char end-mark)
		   (set-marker end-mark nil)))))))

(html2texi-make-simple-markup-handler i)

(defun html2texi-tag-handler-li (xml-expr)
  (insert "\n@item\n")
  (unless (memq (caadr html2texi-xml-stack) '(ol ul))
    (html2texi-fatal-error "<li> était inattendu." xml-expr ))
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-link (xml-expr)
  )

(defun html2texi-tag-handler-ol (xml-expr)
  (insert "\n@enumerate")
   (html2texi-process-xml-expr xml-expr)
  (insert "\n@end enumerate\n"))

(defun html2texi-tag-handler-p (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(defun html2texi-tag-handler-tbody (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-thead (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-tfoot (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-ul (xml-expr)
  (insert "\n@itemize")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n@end itemize\n"))

(defun html2texi-tag-handler-span (xml-expr)
  (insert "@c span: (<span #1>#2</span> => #2.")
  (html2texi-default-handling xml-expr "span: ")
  (html2texi-process-xml-expr xml-expr)
  (insert "@c span: )\n"))

(defun html2texi-tag-handler-style (xml-expr)
  )

(defun html2texi-tag-handler-meta (xml-expr)
  (unless (and (nth 1 html2texi-xml-stack)
	       (eq (caadr html2texi-xml-stack) 'head))
    (html2texi-fatal-error "<meta> inattendu." xml-expr))
  ;; traitement du meta...
  (let* ((attribute-list (nth 1 xml-expr))
	 (http-equiv (assq 'http-equiv attribute-list))
	 (name (assq 'name attribute-list))
	 (content (assq 'content attribute-list)))
    (cond
     ((and (consp name)
	   (consp content)
	   (progn
	     (setq name (cdr name)
		   content (cdr content))
	     (stringp name))
	   (stringp content))
      (cond
       ((string= name "author")
	(html2texi-set-doc-info 'author content))
       ((string= name "language")
	(when (string-match "\\`\\([a-z]\\{2\\}\\(-[A-Z]\\{2\\}\\)?\\)\\'" content)
	  (let ((language (match-string-no-properties 1 content)))
	    (when (= (length language) 5)
	      (aset language 2 ?_))
	    (html2texi-set-doc-info 'language language))))))
     ((and (consp http-equiv)
	   (consp content)
	   (progn (setq http-equiv (cdr http-equiv))
		  (stringp http-equiv))
	   (progn (setq content (cdr content))
		  (stringp content)))
      (setq http-equiv (downcase http-equiv))
      (cond
       ((and (string= http-equiv "content-type")
	     (string-match "charset\\s-*=\\s-*\\([-a-z0-9]+\\)" content))
	(html2texi-set-doc-info 'content-type-charset (match-string-no-properties 1 content)));
       )))))

(defun html2texi-tag-handler-pre (xml-expr)
  (let ((kes html2texi-keep-empty-strings))
    (setq html2texi-keep-empty-strings t)
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-keep-empty-strings kes)))

(defun hmtl2texi-to-plain-text (xml-expr &rest flags)
  (let (ret anchor)
    (dolist (xml-expr (cddr xml-expr))
      (cond
       ((stringp xml-expr)
	(push xml-expr ret))
       ((consp xml-expr)
	(push xml-expr html2texi-xml-stack)
	(cond
	 ((and (eq (car xml-expr) 'a)
	       (setq anchor (assq 'name (nth 1 xml-expr))))
	  (push (html2texi-make-anchor 
		 (concat 
		  (file-relative-name 
		   (html2texi-current-file html2texi-files-to-do) 
		   html2texi-directory-ref)
		  "#" (cdr anchor)))
		html2texi-flushable-anchors) ))
	(let ((str  (hmtl2texi-to-plain-text xml-expr)))
	  (and (null (string= str ""))
	       (push str ret)))
	(pop html2texi-xml-stack))
       (t (html2texi-fatal-error "Expression XML inattendue." xml-expr))))
    (setq  ret (mapconcat 'identity (nreverse ret) " "))
    (if (memq :one-line flags)
	(mapconcat 'identity (split-string ret "\n") " ")
      ret)))


(defun html2texi-tag-handler-title (xml-expr)
  (unless (and  (nth 1 html2texi-xml-stack)
		(eq  (caadr html2texi-xml-stack) 'head))
    (html2texi-fatal-error "<title> inattendu." xml-expr))
  (setq xml-expr (cddr xml-expr))
  (let ((str  (hmtl2texi-to-plain-text xml-expr)))
    (setq str (split-string str "\n")
	  str (mapconcat 'identity str " "))
    (unless (string= str "")
      (html2texi-set-doc-info 'title str))))

(defun html2texi-string-escape (str &optional flatten)
  (cond
   ((stringp str)
    (with-temp-buffer
      (insert str)
      (goto-char (point-min))
      (while (re-search-forward "[,@{}]" nil t)
	(cond
	 ((string= (match-string-no-properties 0) ",")
	  (replace-match "@comma{}"))
	 ((member (match-string-no-properties 0) '("@" "{" "}"))
	  (replace-match (concat "@" (match-string-no-properties 0))))))
      (when flatten
	(goto-char (point-min))
	(while (re-search-forward "\n\\(\\s-*\\)" nil t)
	  (replace-match (if (> 0 (length (match-string 1))) " " "") t t)))
      (buffer-substring (point-min) (point-max))))
   ((and (consp str) (car-safe str))
    (cond
     ((eq (car str) 'span)
      (with-temp-buffer
	(insert "@c span: (<span #1>#2</span> => string-escape of #2.")
	(html2texi-default-handling str "span: ")
	(insert (html2texi-string-escape  (nth 2 str) flatten))
	(insert "@c span: )\n")
	(buffer-substring (point-min) (point-max))))
     (t (html2texi-fatal-error "Une chaîne était attendue" :html2texi-generic-error str))))
   (t  (html2texi-fatal-error "Une chaîne était attendue" :html2texi-generic-error str))))

(defun html2texi-tag-handler-img (xml-expr)
  (let (filename width height alttext extension)
    (dolist (x (cadr xml-expr))
      (cond
       ((eq (car x) 'src)
	(setq filename (cdr x)))
       ((eq (car x) 'alt)
	(setq alttext (cdr x)))))
    (unless filename
      (html2texi-fatal-error "src=... était attendu" xml-expr))
    (setq filename (html2texi-decode-url filename))
    (setq extension (file-name-extension filename)
	  filename (file-name-sans-extension filename))
    (when (member extension '("png" "jpg" "jpeg" "eps" "txt"))
      (setq extension nil))
    (insert "@image{" (html2texi-make-anchor filename (symbol-function 'identity)))
    (let ((remainder (list width height alttext extension)))
	(while remainder
	  (if (let (non-empty)
		(mapc (lambda (x) (setq non-empty (or non-empty (stringp x))))
		      remainder)
		non-empty)
	      (insert "," (or (pop remainder) "") )
	    (setq remainder nil); rompt la boucle (while remainder...)
	    ))
	(insert "}"))))

(defun html2texi-set-doc-info (tag val)
  "Configure pour l'étiquette TAG la valeur VAL concernant les
informations globales au documents. Ces informations concernent
notamment la langue et l'encodage du document."
  (let ((info (assq tag html2texi-document-information)))
    (if info
	(setcdr info val)
      (push (cons tag val) html2texi-document-information))))

(defun html2texi-tag-handler-head (xml-expr)
  (unless html2texi-ignore-head
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-ignore-head t)))

(defun html2texi-tag-handler-noframes (xml-expr)
  )

(if (boundp 'html2texi-handler-hash-table)
    (makunbound 'html2texi-handler-hash-table))

(defconst html2texi-handler-hash-table
  (let ((ht (make-hash-table)))
    (dolist (v '(a b body center code dfn dl dt dd em i kbd li p
    hr div ol ul pre head meta title frameset frame noframes span
    strong table tbody thead tfoot th tr td h1 h2 h3 h4 h5 h5
    html link br img samp style sup sub tt))
      (puthash v (symbol-function (intern (concat "html2texi-tag-handler-" (symbol-name v))))
	       ht))
    ht)
  "Table de hashage des traitement associé à chaque balise HTML"
  )

(defun html2texi-remove-empty-strings (xml-expr)
  (setq xml-expr (cdr xml-expr))
  (save-match-data
  (while (cdr xml-expr)
    (if (and (stringp (cadr xml-expr))
	     (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'" (cadr xml-expr)))
	(setcdr xml-expr (cddr xml-expr))
      (setq xml-expr (cdr xml-expr))))))

(defun html2texi-process-xml-expr (xml-expr)
  (push xml-expr html2texi-xml-stack)
  (dolist (xml-expr (cddr xml-expr))
    (cond
     ((consp xml-expr)
      (push xml-expr html2texi-xml-stack)
      (let ((handler (gethash (intern (downcase (symbol-name (car xml-expr))))
			      html2texi-handler-hash-table)))
	(if handler
	    (funcall handler  xml-expr)
	  (html2texi-default-handling xml-expr)))
      (pop html2texi-xml-stack))
     ((stringp xml-expr)
      (and (or html2texi-keep-empty-strings
	       (null (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'"  xml-expr)))
	   (insert (html2texi-handle-string xml-expr))))
     (t (html2texi-fatal-error "Expression XML inattendue %S" xml-expr))))
  (pop html2texi-xml-stack))

(defun html2texi-default-handling (xml-expr &optional prompt)
  (let ((str (split-string (prin1-to-string xml-expr) "\n")))
    (dolist (str-line str)
      (insert "\n@c " (or prompt "") str-line)))
    (insert "\n"))

(defun html2texi-process-region (beg end)
  (goto-char end)
  (let ((end (point-marker))
	is-xhtml
	re-do
	xml-expr)

    ;; Suppression de tout ce qui est en dehors des balise <html> ... </html>
    (goto-char beg)
    (setq html2texi-line-delta (line-number-at-pos))
    (setq is-xhtml
	  (looking-at "[ \t\n\r]*<!DOCTYPE[ \t\n\r]+html[ \t\n\r]+PUBLIC[ \t\n\r]+\"-//W3C//DTD XHTML"))
    (unless (re-search-forward "<html" end t)
      (html2texi-fatal-error "Balise <html> non trouvée" xml-expr))
    (setq html2texi-line-delta (- (line-number-at-pos) (* 2 html2texi-line-delta)))
    (delete-region beg (match-beginning 0))
    (unless (re-search-forward ">" end t)
      (html2texi-fatal-error "Clôture de la balise <html> trouvée" xml-expr))
    (unless  (re-search-forward "</html" end t)
      (html2texi-fatal-error "Balise </html> non trouvée trouvée" xml-expr))
    (unless (re-search-forward ">" end t)
      (html2texi-fatal-error "Clôture de la balise </html> trouvée" xml-expr))
    (delete-region (match-end 0) end)

    (or is-xhtml
	(html2texi-make-html-clean-xml beg end))

    (setq xml-expr
	  (condition-case
	      sig
	      (xml-parse-region beg end)
	    (error
	     (if (consp sig)
		 (html2texi-warning "File is XHTML but xml-parser reported error `%S'"
				 :html2texi-generic-error
				 (cdr sig))
	       (html2texi-warning "File is XHTML but xml-parser reported errors"
				  :html2texi-generic-error))
		  (if is-xhtml :html2texi-redo nil)))
	  xml-expr
	  (if (eq xml-expr :html2texi-redo)
	       (progn
		 (html2texi-make-html-clean-xml beg end)
		 (xml-parse-region beg end))
	     xml-expr))

    (delete-region beg end)
    (set-marker end nil)
    xml-expr))

(if t
;; plus partique pour déboguer qu'un vrai tampon temporaire
    (defmacro html2texi-with-temp-buffer (&rest body)
      (let ((cur-buff (make-symbol "cur-buff")))
	`(with-current-buffer
	       (let (( ,cur-buff (get-buffer "*HTML2TEXI Temp*")))
		 (and ,cur-buff (kill-buffer ,cur-buff))
		 (get-buffer-create "*HTML2TEXI Temp*"))
       (erase-buffer)
       ,@body)))
  ;;
  (defmacro html2texi-with-temp-buffer (&rest body)
    `(with-temp-buffer ,@body)))



(defun html2texi-make-texi-buffer (&optional buffer )
  (let* ((start-buffer (or buffer (current-buffer)))
	 xml-expr
	 (start-filename  (or (buffer-file-name start-buffer) (buffer-name)))
	 (start-filename-ext (file-name-extension start-filename))
	 done-links-list
	 texi-buffer)
    (setq html2texi-texi-buffer-name
     (concat (concat  (file-name-sans-extension   (file-name-nondirectory start-filename))
		      ".texi")))

    (unless (or (member start-filename-ext '("html" "htm"))
		(y-or-n-p (format "le tampon %s n'a pas une extension html, continuer?"
				  start-filename)))
      (html2texi-fatal-error "Fichier `%s' sans extension html" :html2texi-generic-error start-filename))
    (setq texi-buffer (get-buffer-create html2texi-texi-buffer-name))
    (set-buffer texi-buffer)
    (erase-buffer)
    (dolist (v html2texi-texi-buffer-local-variables)
      (set (make-local-variable v) nil))
    (push (cons default-directory "./") html2texi-directory-stack)
    (setq html2texi-directory-ref default-directory)
    (html2texi-add-file-to-do html2texi-files-to-do start-filename)
    (while (html2texi-files-has-to-do html2texi-files-to-do)
      (setq file-name (html2texi-get-next-file-next-to-do html2texi-files-to-do))
      (if (file-exists-p file-name)
	  (progn
	    (let* ((dir (file-name-as-directory
			 (file-name-directory file-name)))
		   (rel-file-name (file-relative-name file-name html2texi-directory-ref))
		   (rel-dir   (let ((d (file-name-directory rel-file-name )))
				(if d (file-name-as-directory d)
				  "./"))))
	      (push (cons dir rel-dir) html2texi-directory-stack)
	      (if (= (oref html2texi-files-to-do :added-file-count) 1)
		  (insert "@anchor{"  (html2texi-make-anchor rel-file-name) "}\n")
		(insert "\n@node " (html2texi-make-anchor rel-file-name) "\n"))
	      (html2texi-with-temp-buffer
	       (insert-file-contents file-name)
	       (accents-de-html)
	       (html2texi-make-html-clean-xml (point-min) (point-max))
	       (setq xml-expr (html2texi-process-region (point-min) (point-max))))
	      (unless (eq 'html (caar xml-expr))
		(html2texi-fatal-error "Résultat d'analyse XML inattendu" xml-expr))
	      (setq xml-expr (car xml-expr))
	      (html2texi-process-xml-expr xml-expr)
	      (pop html2texi-directory-stack)	))
	(html2texi-warning "Le fichier `%s' n'existe pas!" :html2texi-generic-error file-name)))))

(defun html2texi-insert-doc-info ()
  (let ((author
	 (html2texi-string-escape
	  (or (cdr-safe (assq 'author html2texi-document-information)) "AUTHOR")))
	(title 	 (html2texi-string-escape
		  (or (cdr-safe (assq 'title html2texi-document-information)) "TITLE")))
	(language 	 (let ((language  (cdr-safe (assq 'language html2texi-document-information))))
			   (if language (cons "" (html2texi-string-escape language))
			     (cons "@c " "LANGUAGE"))))
	(encoding  (html2texi-string-escape
			  (or (cdr-safe (assq 'content-type-charset html2texi-document-information))
			      "iso-8859-1"))))

    (goto-char (point-min))
    (insert "\\input texinfo   @c -*-mode:texinfo; coding:" (downcase encoding) "-*-
@setfilename " (file-name-sans-extension (buffer-name)) ".info
" (car language) "@documentlanguage " (cdr language) "
@documentencoding "  (if (let ((case-fold-search t))
			   (string-match "\\`\\(us\\|utf\\|iso\\)" encoding))
			 (upcase encoding) encoding) "
@copying
This manual is for PROGRAM, version VERSION.

Copyright @copyright{} YEARS COPYRIGHT-OWNER.

@quotation
Permission is granted to ...
@end quotation
@end copying

@titlepage
@title " title "@c NAME-OF-MANUAL-WHEN-PRINTED
@c @subtitle SUBTITLE-IF-ANY
@c @subtitle SECOND-SUBTITLE
@author " author "

@c  The following two commands
@c  start the copyright page.
@page
@vskip 0pt plus 1filll
@insertcopying

Published by ...
@end titlepage

@c So the toc is printed at the start.
@contents

@ifnottex
@node Top
@top TITLE

This manual is for PROGRAM, version VERSION.
@end ifnottex
")
    (goto-char (point-max))
    (insert "
@bye") ))

(defun html2texi-beautify-locator (locator)
  (with-temp-buffer
    (insert locator)
    (goto-char (point-min))
    (when (re-search-forward "-002ehtml?\\(-0023\\)?" nil t)
      (if
	  (match-string 1)
	  (replace-match "_" t t)
	(replace-match "" t t)))
    (goto-char (point-min))
    (while (re-search-forward "-[[:xdigit:]]\\{4\\}" nil t)
      (replace-match "-" t t))
    (buffer-substring (point-min) (point-max))))

(defun html2texi-post-process ()
  "Embellit les identificateur de localisation selon
`html2texi-beautify-locators'. Puis pemplace les double lignes
vides en ligne vides simples."
  ;; embellissement des indentificateurs de localisateur
  (let ((dummy-head (html2texi-locator-info "Factice")))
    (when html2texi-beautify-locators
      (doli2-add-first html2texi-locator-list dummy-head)
      (maphash
       #'(lambda (key val)
	   (let* ((beautiful-key (html2texi-beautify-locator key))
		  delta-pos-inc delta-pos locator-list
		  (key-length (length key))
		  cur next)
	     (unless (string= beautiful-key key)
	       (setq delta-pos-inc (- (length beautiful-key) key-length)
		     delta-pos 0
		     val (nreverse (cons dummy-head val))
		     locator-list val
		     next (car val))
	       (save-excursion
		 (while (cdr locator-list)
		   (setq cur next
			 locator-list (cdr locator-list)
			 next (car locator-list))
		   (goto-char (+ (oref cur :position) delta-pos))
		   (delete-region (point) (+ (point) key-length))
		   (insert beautiful-key)
		   (setq delta-pos (+ delta-pos delta-pos-inc))
		   (doli2-.>x-dolist
		    (cur next)
		    (oset cur :position (+ (oref cur :position) delta-pos))))))
	   (dolist (locator-info (cdr val))
	     (doli2-remove html2texi-locator-list locator-info))
	   (puthash key nil (oref html2texi-locator-list :hash-table))))
       (oref html2texi-locator-list :hash-table))
      (doli2-remove-first  html2texi-locator-list)))

  ;; suppression des doubles lignes en trop
  (goto-char (point-min))
  (while (re-search-forward "\\(^[ \t]*\n\\)\\{2,\\}" nil t)
    (replace-match "\n"))
  (normal-mode))

(defun html2texi-save-texi-buffer-maybe ()
  "Sauvegarde le tampon avec le fichier Texinfo."
  (if
      (buffer-file-name) ; le tampon visite déjà un fichier
      (basic-save-buffer)
   (write-file (buffer-name) html2texi-save-texi-buffer-confirm-p)))

;;;###autoload
(defun html2texi ()
  (interactive)
  (let (html2texi-keep-empty-strings
	html2texi-xml-stack
	html2texi-texi-buffer-name
	(html2texi-line-delta 0)
	html2texi-ignore-head
	html2texi-directory-stack
	html2texi-flushable-anchors
	html2texi-directory-ref
	(html2texi-locator-list (html2texi-locator-listing "À embellir"))
	(html2texi-files-to-do (html2texi-files-to-do-listing "À traiter"))
	(html2texi-log-buffer (and html2texi-reuse-log-buffer html2texi-log-buffer)))
  (html2texi-make-texi-buffer)
  (html2texi-insert-doc-info)
  (html2texi-post-process)
  (html2texi-info "Fin de la conversion en HTML !" :html2texi-generic-error )
  (html2texi-save-texi-buffer-maybe)))

;; Log compilation mode stuff
(defun html2texi-define-error-regexps ()
  (dolist (v `(
	       (html-to-texinfo-error
		.
		(
		 ,(concat "^" (regexp-opt (list (aref html2texi-log-error-names 0)
						(aref html2texi-log-error-names 1)))
			  ":\\(" html2texi-filepath-re
			  "\\):\\(?:\\([0-9]+\\):\\)?.*$")
		 1; File
		 2; Line
		 0; Error
		 ))
	       (html-to-texinfo-warning
		.
		(
		 ,(concat "^" (aref html2texi-log-error-names 2)
			  ":\\(" html2texi-filepath-re
			  "\\):\\(?:\\([0-9]+\\):\\)?.*$")
		 1; File
		 2; Line
		 1; Warning
		 ))
	       (html-to-texinfo-info
		.
		(
		 ,(concat "^" (aref html2texi-log-error-names 3)
			  ":")
		 nil; File
		 nil; Line
		 2; Warning
		 ))))
    (add-to-list 'compilation-error-regexp-alist (car v))
    (let ((cell (or (assq (car v) compilation-error-regexp-alist-alist)
		    (car (push (cons  (car v) nil) compilation-error-regexp-alist-alist)))))
      (setcdr cell (cdr v))  )))
(html2texi-define-error-regexps)

;;; html-to-texinfo.el ends here

Revision-number: 25
Prop-content-length: 147
Content-length: 147

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2012-02-22T18:44:50.000000Z
K 7
svn:log
V 45
(doli2-x<.-dolist): parenthèse manquante.

PROPS-END

Node-path: trunk/lisp/doubly-linked-list.el
Node-kind: file
Node-action: change
Text-content-length: 6176
Text-content-md5: e60ed45272a908f75f387c1fd007f1f1
Content-length: 6176

;;; doubly-linked-list.el --- -*- coding: iso-8859-1 -*-
;; Copyright 2012 Vincent Belaïche
;;
;; Author: Vincent Belaïche <vincentb1@users.sourceforge.net>
;; Version: $Id: doubly-linked-list.el,v 1.2 2012-02-22 18:44:50 Vincent Exp $
;; Keywords: 
;; X-URL: not distributed yet

;; 
;; This software is governed by the CeCILL license under French law and
;; abiding by the rules of distribution of free software.  You can  use, 
;; modify and/ or redistribute the software under the terms of the CeCILL
;; license as circulated by CEA, CNRS and INRIA at the following URL
;; "http://www.cecill.info". 
;; 
;; As a counterpart to the access to the source code and  rights to copy,
;; modify and redistribute granted by the license, users are provided only
;; with a limited warranty  and the software's author,  the holder of the
;; economic rights,  and the successive licensors  have only  limited
;; liability. 
;; 
;; In this respect, the user's attention is drawn to the risks associated
;; with loading,  using,  modifying and/or developing or reproducing the
;; software by the user in light of its specific status of free software,
;; that may mean  that it is complicated to manipulate,  and  that  also
;; therefore means  that it is reserved for developers  and  experienced
;; professionals having in-depth computer knowledge. Users are therefore
;; encouraged to load and test the software's suitability as regards their
;; requirements in conditions enabling the security of their systems and/or 
;; data to be ensured and,  more generally, to use and operate it in the 
;; same conditions as regards security. 
;; 
;; The fact that you are presently reading this means that you have had
;; knowledge of the CeCILL license and that you accept its terms.
;; 
;;; Commentary:

;; 

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'doubly-linked-list)

;;; Code:
(require 'eieio)
(eval-when-compile
  (require 'cl))



;;;;##########################################################################
;;;;  User Options, Variables
;;;;##########################################################################

(defclass doli2-list ()
  ((head
    :initarg :head
    :initform nil
    :documentation "Pointe sur le premier élément de la liste si
   la liste est non-vide.")  
   (tail
    :initarg :tail
    :initform nil
    :documentation "Pointe sur le dernier élément de la liste si
    la liste est non vide.")
   (size
    :initarg :size
    :initform 0
    :documentation "Nombre d'éléments de la liste."))
  :documentation "Liste doublement chaînée.")

(defclass doli2-element ()
  ((next 
    :initarg :next
    :initform nil
    :type (or null doli2-element) 
    :documentation "Élément suivant dans la liste, `nil' pour le
    dernier élément.")
   (previous
    :initarg :previous
    :initform nil
    :type (or null doli2-element)
    :documentation "Élément précédent dans la liste, `nil'
    pour le dernier élément."  )) 
  :abstract t
  :documention "Classe de base pour les éléments d'objets de classe
  `doli2-list'.")

(defgeneric doli2-equal ((this doli2-element) (other doli2-element))
  "Comparaison de deux `doli2-element'.")

(defmethod doli2-add-first
  ((this doli2-list)
   (elt doli2-element))
  "Ajoute un nouvel élément en tête de liste."
  (when 
      (or (oref elt :next)
	  (oref elt :previous))
    (error "L'élément est déjà dans une liste"))
  (let ((size (oref this :size)))
    (if (= 0 size)
	(progn
	  (oset this :head elt)
	  (oset this :tail elt)
	  (oset this :size 1))
      (let ((head  (oref this :head)))
	(oset elt :next head)
	(oset head :previous elt))
      (oset this :size (1+ size)))))
  
(defmethod doli2-add-last
  ((this doli2-list)
   (elt doli2-element))
  "Ajoute un nouvel élément en queue de liste."
  (when 
      (or (oref elt :next)
	  (oref elt :previous))
    (error "L'élément est déjà dans une liste"))
  (let ((size (oref this :size)))
    (if (= 0 size)
	(progn
	  (oset this :head elt)
	  (oset this :tail elt)
	  (oset this :size 1))
      (let ((tail  (oref this :tail)))
	(oset elt :previous tail)
	(oset tail :next elt))
      (oset this :size (1+ size)))))

(defmethod doli2-remove
  ((this doli2-list)
   (elt doli2-element))
  "Retranche `elt' de la liste `this'."
  (let ((size (oref this :size)))
  (cond
   ((<= 0 size)
    (error "Liste vide %S" this))
   ((= 1 size)
    (oset this :head nil)
    (oset this :tail nil)
    (oset this :size 0))
   ((eq (oref this :head) elt)
    (let ((next (oref elt :next)))
      (oset this :head next)
      (oset this :size (1- size))
      (oset elt :previous nil)
      (oset elt :next nil)))
   ((eq (oref this :tail) elt)
    (let ((previous (oref elt :previous)))
      (oset this :tail previous)
      (oset this :size (1- size))
      (oset elt :previous nil)
      (oset elt :next nil)))
   (t
    (let ((next (oref elt :next))
	  (previous (oref elt :previous)))
      (oset elt :next nil)
      (oset elt :previous nil)
      (oset this :size (1- size))
      (oset next :previous previous)
      (oset previous :next next))))))

(defmethod doli2-remove-first 
  ((this doli2-list))
  "Retranche le premier élément de la liste `this'. Génère une
erreur si la liste est vide."
  (let ((ret (oref this :head))
	(size (1- (oref this :size))))
    (if (> 0 size)
	(error "Liste vide")
      (oset this :size size)
      (if (< 0  size)
	  (oset this :head (oref ret :next))
	(oset this :head nil)
	(oset this :tail nil)))
     (oset ret :next nil)
     ret))

(defmacro doli2-.>x-dolist (spec &rest body)
  "(doli2-.>x-dolist (FROM TO) BODY) itère sur BODY depuis FROM
inclus, jusqu'à TO exclus en parcourant la liste dans le sens normal."
  `(while (null (eq ,(car spec) ,(cadr spec)))
     ,@body
     (setq ,(car spec) (oref ,(car spec) :next))))

(defmacro doli2-x<.-dolist (args &rest body)
  "(doli2-.>x-dolist (FROM TO) BODY) itère sur BODY depuis FROM
inclus, jusqu'à TO exclus dans le sens inverse."
  `(while (null (eq ,(car spec) ,(cadr spec)))
      ,@body
      (setq ,(car spec) (oref ,(car spec) :previous))))

(provide 'doubly-linked-list)

;;; doubly-linked-list.el ends here


Revision-number: 26
Prop-content-length: 344
Content-length: 344

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2012-03-19T05:32:03.000000Z
K 7
svn:log
V 241
(accents-convertisseur-quote-texinfo, accents-convertisseur-de-quote-texinfo, accents-quote-texinfo,
accents-de-quote-texinfo): Ajout des caractères spéciaux Texinfo.
(accents-de-html): Correction bug `make-marker' -> `(make-marker)'.

PROPS-END

Node-path: trunk/lisp/accents-ascii.el
Node-kind: file
Node-action: change
Text-content-length: 26654
Text-content-md5: 7c2a3cb6b8cf9f4634ffdbc2b32837eb
Content-length: 26654

;; -*- coding: utf-8 -*-
;; Copyright 2008/2012 Vincent Belaïche

;; Author: Vincent Belaïche <vincent.b.1@hotmail.fr>
;; Version: $Id: accents-ascii.el,v 1.4 2012-03-19 05:32:03 Vincent Exp $
;; Keywords: 
;; X-URL: not distributed yet

;; 
;; This software is governed by the CeCILL license under French law and
;; abiding by the rules of distribution of free software.  You can  use, 
;; modify and/ or redistribute the software under the terms of the CeCILL
;; license as circulated by CEA, CNRS and INRIA at the following URL
;; "http://www.cecill.info". 
;; 
;; As a counterpart to the access to the source code and  rights to copy,
;; modify and redistribute granted by the license, users are provided only
;; with a limited warranty  and the software's author,  the holder of the
;; economic rights,  and the successive licensors  have only  limited
;; liability. 
;; 
;; In this respect, the user's attention is drawn to the risks associated
;; with loading,  using,  modifying and/or developing or reproducing the
;; software by the user in light of its specific status of free software,
;; that may mean  that it is complicated to manipulate,  and  that  also
;; therefore means  that it is reserved for developers  and  experienced
;; professionals having in-depth computer knowledge. Users are therefore
;; encouraged to load and test the software's suitability as regards their
;; requirements in conditions enabling the security of their systems and/or 
;; data to be ensured and,  more generally, to use and operate it in the 
;; same conditions as regards security. 
;; 
;; The fact that you are presently reading this means that you have had
;; knowledge of the CeCILL license and that you accept its terms.
;; 
;;; Commentary:

;; accents-tex : change les caractères accentués en accents tex
;; conserve les majuscules, sans demander confirmation.
;;
;; accents-de-tex : change les accents tex en caracteres accentués sans
;; demander confirmation.  les majuscules sont respectees.
;;

(require 'eieio)

(dolist (v '(accents-convertisseur-cache
	     accents-convertisseur-le-cache
	     accents-convertisseur-base
	     accents-convertisseur-simple
	     accents-convertisseur-inverse
	     accents-convertisseur-html
	     accents-convertisseur-de-html))
  (makunbound v))

(defclass accents-convertisseur-cache ()
  ((table-de-hashage
    :initarg :table-de-hashage)
   (expression-rationnelle
    :initarg :expression-rationnelle
    :documentation "Expression rationnelle s'accordant aux
    lettres accentuées à remplacer.")
   (id-convertisseur
    :initarg :id-convertisseur
    :initform nil
    :type symbol)
   (lecteur-clef
    :initarg :lecteur-clef
    :initform nil))
  "C'est la classe qui fait le boulot effectif de remplacement.")

(defvar accents-convertisseur-le-cache
  (make-instance 'accents-convertisseur-cache
		 :table-de-hashage (make-hash-table :test 'equal)))

(defmethod accents-conversion 
  ((this accents-convertisseur-cache) &optional beg end)
  (let (cleanup)
    (save-excursion
      (goto-char (or beg (point-min)))
      (setq end (if (integerp end) 
		    (let ((m (make-marker))) 
		      (setq cleanup t)
		      (set-marker m end)
		      m)
		  end))
      (save-match-data
	(let ((case-fold-search nil)
	      (table-de-hashage (oref this :table-de-hashage))
	      (expression-rationnelle (oref this :expression-rationnelle))
	      (lecteur-clef (or (oref this :lecteur-clef) 
				(function (lambda () (match-string-no-properties 0))))))

	  (while (re-search-forward expression-rationnelle end t)
	    (let ((replacement  
		   (gethash  (funcall lecteur-clef)
			     table-de-hashage)))
	      (and replacement
		   (replace-match replacement t t)))))))
    (when cleanup
      (set-marker end nil))))

(defclass accents-convertisseur-base ()
  ((cache
    :allocation :class
    :documentation "État en cache du convertisseur"))
  "Classe de base pour un convertisseur"  )
(oset-default accents-convertisseur-base cache 
	      accents-convertisseur-le-cache)

(defclass accents-convertisseur-simple 
  (accents-convertisseur-base)
  ((id
    :initarg :id
    :documentation "Symbole d'itentification unique pour le
    cache.")
   (liste-de-remplacement
    :initarg :liste-de-remplacement
    :documentation "Liste d'association") )
  "")

(defmacro accents-definir-conversion
  (CLASS CAR CDR &optional LECTEUR-CLEF)
  `(defmethod accents-conversion 
     ((this ,CLASS) &optional beg end)

     (let ((cache (oref this cache))
	   (id (oref this :id)))
       (unless (eq (oref cache :id-convertisseur)
		   id)
	 (oset cache :id-convertisseur ,LECTEUR-CLEF)
	 (oset cache :lecteur-clef nil)
	 (let ((table-de-hashage (oref cache :table-de-hashage))
	       (liste-de-remplacement (oref this :liste-de-remplacement)))
	   (clrhash table-de-hashage)
	   (dolist (k liste-de-remplacement)
	     (puthash (,CAR k) (,CDR k) table-de-hashage))
	   (oset cache :expression-rationnelle
		 (regexp-opt (mapcar (quote ,CAR) liste-de-remplacement)))))
       (accents-conversion cache beg end))))

(accents-definir-conversion accents-convertisseur-simple car cdr)

(defclass accents-convertisseur-inverse
  (accents-convertisseur-simple)
  ()
  "Convertisseur pour effectuer la conversion inverse vis-à-vis
  de la liste de remplacement.")

(accents-definir-conversion accents-convertisseur-inverse cdr car)

(defun accents-moteur (liste-des-remplacements &optional convert-to-re)
  (save-excursion
	(save-match-data
	  (let ((case-fold-search nil)
		(re (if convert-to-re 
			(mapconcat 'identity 
				   (mapcar 'car liste-des-remplacements)
				   "\\|")
		      (regexp-opt  (mapcar 'car liste-des-remplacements)))))
	    (goto-char (point-min))
	    (while (re-search-forward re nil t)
	      (replace-match
	       (if convert-to-re
		   (save-match-data 
		     (assoc-default (match-string 0) 
				    liste-des-remplacements 'string-match))
		 (cdr (assoc-string (match-string 0) liste-des-remplacements)))
	       t; fixed case
	       t; literal
	       ))))))

(defconst accents-converstisseur-tex
  (make-instance 
   'accents-convertisseur-simple
   :id 'accents-converstisseur-tex
   :liste-de-remplacement 
   '(("\�" . "\\'A")
     ("\À" . "\\`A")
     ("\Â" . "\\^A")
     ("\Ä" .  "\\\"A")
     ("\É" . "\\'E")
     ("\È" . "\\`E")
     ("\Ê" . "\\^E")
     ("\Ë" .  "\\\"E")
     ("\�" . "\\'I")
     ("\Ì" . "\\`I")
     ("\ÃŽ" . "\\^I")
     ("\�" .  "\\\"I")
     ("\0" . "\\'O")
     ("\Ã’" . "\\`O")
     ("\Ô" . "\\^O")
     ("\Ö" .  "\\\"O")
     ("\Ú" . "\\'U")
     ("\Ù" . "\\`U")
     ("\Û" . "\\^U")
     ("\Ü" .  "\\\"U")
     ("\Ç" . "\\c{C}")
     ("\á" . "\\'a")
     ("\à" . "\\`a")
     ("\â" . "\\^a")
     ("\ä"  .  "\\\"a")
     ("\é" . "\\'e")
     ("\è" . "\\`e")
     ("\ê" . "\\^e")
     ("\ë" .  "\\\"e")
     ("\í" .  "\\'\\i")
     ("\ì" .  "\\`\\i")
     ("\î" .  "\\^\\i")
     ("\ï" .  "\\\"\\i")
     ("\ó" . "\\'o")
     ("\ò" . "\\`o")
     ("\ô" . "\\^o")
     ("\ö" .  "\\\"o")
     ("\ú" . "\\'u")
     ("\ù" . "\\`u")
     ("\û" . "\\^u")
     ("\ü" .  "\\\"u")
     ("\ç" . "\\c{c}")
     ("\×" . "\\times{}")
)
   
   )
  "Convertisseur de lettres accentuées en séquence TeX
  équivalentes.")

(defun accents-tex ()
  (interactive)
  "change les caracteres accentues en accents tex"
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-conversion accents-convertisseur-tex beg end)
    ))

(defun accents-de-tex ()
  (interactive)
  "change les caracteres accentues en accents tex"
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-moteur
     '(( "\\\\'[ \n\t]*A" . "\�")
       ( "\\\\`[ \n\t]*A" . "\À")
       ( "\\\\^[ \n\t]*A" . "\Â")
       ( "\\\\\"[ \n\t]*A" . "\Ä")
       ( "\\\\'[ \n\t]*E" . "\É")
       ( "\\\\`[ \n\t]*E" . "\È")
       ( "\\\\^[ \n\t]*E" . "\Ê" )
       ( "\\\\\"[ \n\t]*E" . "\Ë")
       ( "\\\\'[ \n\t]*I" . "\�")
       ( "\\\\`[ \n\t]*I" . "\Ì")
       ( "\\\\^[ \n\t]*I" . "\ÃŽ")
       ( "\\\\\"[ \n\t]*I" . "\�")
       ( "\\\\'[ \n\t]*O" . "\0")
       ( "\\\\`[ \n\t]*O" . "\Ã’")
       ( "\\\\^[ \n\t]*O" . "\Ô")
       ( "\\\\\"[ \n\t]*O" . "\Ö")
       ( "\\\\'[ \n\t]*U" . "\Ú")
       ( "\\\\`[ \n\t]*U" . "\Ù")
       ( "\\\\^[ \n\t]*U" . "\Û")
       ( "\\\\\"[ \n\t]*U" . "\Ü")
       ( "\\\\c[ \n\t]*{C}" . "\Ç")
       ( "\\\\'[ \n\t]*{A}" . "\�")
       ( "\\\\`[ \n\t]*{A}" . "\À")
       ( "\\\\^[ \n\t]*{A}" . "\Â")
       ( "\\\\\"[ \n\t]*{A}" . "\Ä")
       ( "\\\\'[ \n\t]*{E}" . "\É")
       ( "\\\\`[ \n\t]*{E}" . "\È")
       ( "\\\\^[ \n\t]*{E}" . "\Ê" )
       ( "\\\\\"[ \n\t]*{E}" . "\Ë")
       ( "\\\\'[ \n\t]*{I}" . "\�")
       ( "\\\\`[ \n\t]*{I}" . "\Ì")
       ( "\\\\^[ \n\t]*{I}" . "\ÃŽ")
       ( "\\\\\"[ \n\t]*{I}" . "\�")
       ( "\\\\'[ \n\t]*{O}" . "\0")
       ( "\\\\`[ \n\t]*{O}" . "\Ã’")
       ( "\\\\^[ \n\t]*{O}" . "\Ô")
       ( "\\\\\"[ \n\t]*{O}" . "\Ö")
       ( "\\\\'[ \n\t]*{U}" . "\Ú")
       ( "\\\\`[ \n\t]*{U}" . "\Ù")
       ( "\\\\^[ \n\t]*{U}" . "\Û")
       ( "\\\\'[ \n\t]*a" . "\á" )
       ( "\\\\`[ \n\t]*a" . "\à" )
       ( "\\\\^[ \n\t]*a" . "\â" )
       ( "\\\\\"[ \n\t]*a" . "\ä" )
       ( "\\\\'[ \n\t]*e" . "\é" )
       ( "\\\\`[ \n\t]*e" . "\è")
       ( "\\\\^[ \n\t]*e" . "\ê")
       ( "\\\\\"[ \n\t]*e" . "\ë")
       ( "\\\\'{\\\\i}" . "\í")
       ( "\\\\`{\\\\i}" . "\ì")
       ( "\\\\^{\\\\i}" . "\î")
       ( "\\\\\"{\\\\i}" . "\ï")
       ( "\\\\'\\\\[ \n\t]*i" . "\í")
       ( "\\\\`\\\\[ \n\t]*i" . "\ì")
       ( "\\\\^\\\\[ \n\t]*i" . "\î")
       ( "\\\\\"\\\\[ \n\t]*i" . "\ï")
       ( "\\\\'[ \n\t]*o" . "\ó")
       ( "\\\\`[ \n\t]*o" . "\ò")
       ( "\\\\^[ \n\t]*o" . "\ô")
       ( "\\\\\"[ \n\t]*o" . "\ö")
       (  "\\\\'[ \n\t]*u" . "\ú")
       ( "\\\\`[ \n\t]*u" . "\ù")
       ( "\\\\^[ \n\t]*u" . "\û")
       ( "\\\\\"[ \n\t]*u" . "\ü")
       ( "\\\\c[ \n\t]*{c}" . "\ç")
       ( "\\\\\"[ \n\t]*{u}" . "\ü")
       ( "\\\\'[ \n\t]*{a}" . "\á" )
       ( "\\\\`[ \n\t]*{a}" . "\à" )
       ( "\\\\^[ \n\t]*{a}" . "\â" )
       ( "\\\\\"[ \n\t]*{a}" . "\ä" )
       ( "\\\\'[ \n\t]*{e}" . "\é" )
       ( "\\\\`[ \n\t]*{e}" . "\è")
       ( "\\\\^[ \n\t]*{e}" . "\ê")
       ( "\\\\\"[ \n\t]*{e}" . "\ë")
       ( "\\\\'[ \n\t]*{o}" . "\ó")
       ( "\\\\`[ \n\t]*{o}" . "\ò")
       ( "\\\\^[ \n\t]*{o}" . "\ô")
       ( "\\\\\"[ \n\t]*{o}" . "\ö")
       (  "\\\\'[ \n\t]*{u}" . "\ú")
       ( "\\\\`[ \n\t]*{u}" . "\ù")
       ( "\\\\^[ \n\t]*{u}" . "\û")
       ( "\\\\\"[ \n\t]*{u}" . "\ü")
       )
     t ;; utilisation de d'expression régulière
     )
    ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; accents-texinfo : change les caractères accentués en accents texinfo sans
;; demander confirmation les majuscules sont respectées
;;
;; texinfo-accents : change les accents Texinfo en caractères accentués sans
;; demander confirmation les majuscules sont respectées

(defconst accents-convertisseur-texinfo
  (make-instance 
   'accents-convertisseur-simple
   :id 'accents-convertisseur-texinfo
   :liste-de-remplacement 
   '(("\�" . "@'A")
     ("\À" . "@`A")
     ("\Â" . "@^A")
     ("\Ä" .  "@\"A")
     ("\É" . "@'E")
     ("\È" . "@`E")
     ("\Ê" . "@^E")
     ("\Ë" .  "@\"E")
     ("\�" . "@'I")
     ("\Ì" . "@`I")
     ("\ÃŽ" . "@^I")
     ("\�" .  "@\"I")
     ( "\Å’" . "@OE{}")
     ("\0" . "@'O")
     ("\Ç" . "@,{C}")
     ("\Ã’" . "@`O")
     ("\Ô" . "@^O")
     ("\Ö" .  "@\"O")
     ("\Ø" . "@O{}")
     ("\¿" . "@questiondown{}")
     ("\¡" . "@exclamdown{}")
     ("\Ù" . "@`U")
     ("\Ú" . "@'U")
     ("\Û" . "@^U")
     ("\Ü" .  "@\"U")
     ("\ß" . "@ss{}")
     ("\æ" . "@ae{}")
     ( "\–" . " -- ")
     ( "\—" . " --- ")
     ("\á" . "@'a")
     ("\à" . "@`a")
     ("\â" . "@^a")
     ("\ä"  .  "@\"a")
     ("\é" . "@'e")
     ("\è" . "@`e")
     ("\ê" . "@^e")
     ("\ë" .  "@\"e")
     ("\í" .  "@'{@dotless{i}}")
     ("\ì" .  "@`{@dotless{i}}")
     ("\î" .  "@^{@dotless{i}}")
     ("\ï" .  "@\"{@dotless{i}}")
     ("\ó" . "@'o")
     ("\ò" . "@`o")
     ("\ø" . "@o{}")
     ( "\Å“" . "@oe{}")
     ("\ô" . "@^o")
     ("\ö" .  "@\"o")
     ("\ú" . "@'u")
     ("\ù" . "@`u")
     ("\û" . "@^u")
     ("\ü" .  "@\"u")
     ("\ç" . "@,{c}") ))
  "Convertisseur de lettres accentuées en séquence Texinfo
  équivalentes.")

(defconst accents-convertisseur-de-texinfo
  (make-instance
   'accents-convertisseur-inverse
   :id 'accents-convertisseur-de-texinfo
   :liste-de-remplacement (oref accents-convertisseur-texinfo
				:liste-de-remplacement))
  "Converstisseur d'entités Texinfo en lettres accentuées équivalentes" )

(defun accents-texinfo ()
  (interactive)
  "change les caractères accentués en entités Texinfo équivalentes."
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-conversion accents-convertisseur-texinfo beg end)))


(defun accents-de-texinfo ()
  (interactive)
  "change les entités TEXINFO en caractères accentués équivalents."
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-conversion accents-convertisseur-de-texinfo beg end)))


(defconst accents-convertisseur-quote-texinfo
  (make-instance 
   'accents-convertisseur-simple
   :id 'accents-convertisseur-quote-texinfo
   :liste-de-remplacement 
   '(("@" . "@@" )
     ("{" . "@{")
     ("}" . "@}")   ))
  "Convertisseur de caractères spéciaux Texinfo en leurs
  séquences d'échappement respectives.")

(defconst accents-convertisseur-de-quote-texinfo
  (make-instance
   'accents-convertisseur-inverse
   :id 'accents-convertisseur-de-quote-texinfo
   :liste-de-remplacement (oref accents-convertisseur-quote-texinfo
				:liste-de-remplacement))
  "Converstisseur de caractères spéciaux échappés Texinfo en caractères non échappés." )

(defun accents-quote-texinfo ()
  (interactive)
  "Change les caractère spéciaux TEXINFO non échappés `@', `{' et
`}' en caractères échappés `@@', `@{' et `@}'."

  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-conversion accents-convertisseur-quote-texinfo beg end)))


(defun accents-de-quote-texinfo ()
  (interactive)
  "Change les caractère spéciaux TEXINFO échappés `@@', `@{' et
`@}' en caractères non échappés `@', `{' et `}'."
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-conversion accents-convertisseur-de-quote-texinfo beg end)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; accents-html : change les caractères accentués en accents HTML sans demander
;; confirmation les majuscules sont respectées
;;
;; html-accents : change les accents HTML en caractères accentués sans demander
;; confirmation les majuscules sont respectées

(defconst accents-convertisseur-html
  (make-instance 'accents-convertisseur-simple 
		 :id 'accents-convertisseur-html
		 :liste-de-remplacement
   '(
     ( "\∀" . "&forall;")
     ( "\∂" . "&part;")
     ( "\∃" . "&exist;")
     ( "\∅" . "&empty;")
     ( "\∇" . "&nabla;")
     ( "\∈" . "&isin;")
     ( "\∉" . "&notin;")
     ( "\∋" . "&ni;")
     ( "\�" . "&prod;")
     ( "\∑" . "&sum;")
     ( "\−" . "&minus;")
     ( "\∗" . "&lowast;")
     ( "\√" . "&radic;")
     ( "\�" . "&prop;")
     ( "\∞" . "&infin;")
     ( "\∠" . "&ang;")
     ( "\∧" . "&and;")
     ( "\∨" . "&or;")
     ( "\∩" . "&cap;")
     ( "\∪" . "&cup;")
     ( "\∫" . "&int;")
     ( "\∴" . "&there4;")
     ( "\∼" . "&sim;")
     ( "\≅" . "&cong;")
     ( "\≈" . "&asymp;")
     ( "\≠" . "&ne;")
     ( "\≡" . "&equiv;")
     ( "\≤" . "&le;")
     ( "\≥" . "&ge;")
     ( "\⊂" . "&sub;")
     ( "\⊃" . "&sup;")
     ( "\⊄" . "&nsub;")
     ( "\⊆" . "&sube;")
     ( "\⊇" . "&supe;")
     ( "\⊕" . "&oplus;")
     ( "\⊗" . "&otimes;")
     ( "\⊥" . "&perp;")
     ( "\â‹…" . "&sdot;")
     ( "\Α" . "&Alpha;")
     ( "\Î’" . "&Beta;")
     ( "\Γ" . "&Gamma;")
     ( "\Δ" . "&Delta;")
     ( "\Ε" . "&Epsilon;")
     ( "\Ζ" . "&Zeta;")
     ( "\Η" . "&Eta;")
     ( "\Θ" . "&Theta;")
     ( "\Ι" . "&Iota;")
     ( "\Κ" . "&Kappa;")
     ( "\Λ" . "&Lambda;")
     ( "\Μ" . "&Mu;")
     ( "\�" . "&Nu;")
     ( "\Ξ" . "&Xi;")
     ( "\Ο" . "&Omicron;")
     ( "\Π" . "&Pi;")
     ( "\Ρ" . "&Rho;")
     ( "\Σ" . "&Sigma;")
     ( "\Τ" . "&Tau;")
     ( "\Î¥" . "&Upsilon;")
     ( "\Φ" . "&Phi;")
     ( "\Χ" . "&Chi;")
     ( "\Ψ" . "&Psi;")
     ( "\Ω" . "&Omega;")
     ( "\α" . "&alpha;")
     ( "\β" . "&beta;")
     ( "\γ" . "&gamma;")
     ( "\δ" . "&delta;")
     ( "\ε" . "&epsilon;")
     ( "\ζ" . "&zeta;")
     ( "\η" . "&eta;")
     ( "\θ" . "&theta;")
     ( "\ι" . "&iota;")
     ( "\κ" . "&kappa;")
     ( "\λ" . "&lambda;")
     ( "\μ" . "&mu;")
     ( "\ν" . "&nu;")
     ( "\ξ" . "&xi;")
     ( "\ο" . "&omicron;")
     ( "\Ï€" . "&pi;")
     ( "\�" . "&rho;")
     ( "\Ï‚" . "&sigmaf;")
     ( "\σ" . "&sigma;")
     ( "\Ï„" . "&tau;")
     ( "\Ï…" . "&upsilon;")
     ( "\φ" . "&phi;")
     ( "\χ" . "&chi;")
     ( "\ψ" . "&psi;")
     ( "\ω" . "&omega;")
     ( "\Ï‘" . "&thetasym;")
     ( "\Ï’" . "&upsih;")
     ( "\Ï–" . "&piv;")
     ( "\Å’" . "&OElig;")
     ( "\Å“" . "&oelig;")
     ( "\Å " . "&Scaron;")
     ( "\Å¡" . "&scaron;")
     ( "\Ÿ" . "&Yuml;")
     ( "\Æ’" . "&fnof;")
     ( "\ˆ" . "&circ;")
     ( "\˜" . "&tilde;")
     ( "\ " . "&ensp;")
     ( "\ " . "&emsp;")
     ( "\ " . "&thinsp;")
     ( "\‌" . "&zwnj;")
     ( "\�" . "&zwj;")
     ( "\‎" . "&lrm;")
     ( "\�" . "&rlm;")
     ( "\–" . "&ndash;")
     ( "\—" . "&mdash;")
     ( "\‘" . "&lsquo;")
     ( "\’" . "&rsquo;")
     ( "\‚" . "&sbquo;")
     ( "\“" . "&ldquo;")
     ( "\�" . "&rdquo;")
     ( "\„" . "&bdquo;")
     ( "\†" . "&dagger;")
     ( "\‡" . "&Dagger;")
     ( "\•" . "&bull;")
     ( "\…" . "&hellip;")
     ( "\‰" . "&permil;")
     ( "\′" . "&prime;")
     ( "\″" . "&Prime;")
     ( "\‹" . "&lsaquo;")
     ( "\›" . "&rsaquo;")
     ( "\‾" . "&oline;")
     ( "\¢" . "&cent;")
     ( "\€" . "&euro;")
     ( "\£" . "&pound;")
     ( "\Â¥" . "&yen;")
     ( "\§" . "&sect;")
     ( "\©" . "&copy;")
     ( "\®" . "&reg;")
     ( "\â„¢" . "&trade;")
     ( "\ℵ" . "&alefsym;")
     ( "\�" . "&larr;")
     ( "\↑" . "&uarr;")
     ( "\→" . "&rarr;")
     ( "\↓" . "&darr;")
     ( "\↔" . "&harr;")
     ( "\↵" . "&crarr;")
     ( "\�" . "&lArr;")
     ( "\⇒" . "&rArr;")
     ( "\⇔" . "&hArr;")
     ( "\⇓" . "&dArr;")
     ( "\⇑" . "&uArr;")
     ( "\↨"  . "&#8616;")
     ( "\⌈" . "&lceil;")
     ( "\⌉" . "&rceil;")
     ( "\⌊" . "&lfloor;")
     ( "\⌋" . "&rfloor;")
     ( "\â—Š" . "&loz;")
     ( "\â™ " . "&spades;")
     ( "\♣" . "&clubs;")
     ( "\♥" . "&hearts;")
     ( "\♦" . "&diams;")
     ( "\�" . "&Aacute;")
     ( "\À" . "&Agrave;")
     ( "\Â" . "&Acirc;")
     ( "\Ä" . "&Auml;")
     ( "\É" . "&Eacute;")
     ( "È" . "&Egrave;")
     ( "\Ê" . "&Ecirc;")
     ( "\Ë" . "&Euml;")
     ( "\�" . "&Iacute;")
     ( "\Ì" . "&Igrave;")
     ( "\ÃŽ" . "&Icirc;")
     ( "\�" . "&Iuml;")
     ( "\Ó" . "&Oacute;")
     ( "\Ã’" . "&Ograve;")
     ( "\Ô" . "&Ocirc;")
     ( "\Ö" . "&Ouml;")
     ( "\Ú" . "&Uacute")
     ( "\Ù" . "&Ugrave;")
     ( "\Û" . "&Ucirc;")
     ( "\Ü" . "&Uuml;")
     ( "\Ç" . "&Ccedil;")
     ( "\á" . "&aacute;")
     ( "\à" . "&agrave;")
     ( "\â" . "&acirc;")
     ( "\ä" . "&auml;")
     ( "\é" . "&eacute;")
     ( "\è" . "&egrave;")
     ( "\ê" . "&ecirc;")
     ( "\ë" . "&euml;")
     ( "\…" . "&hellip;")
     ( "\í" . "&iacute;")
     ( "\ì" . "&igrave;")
     ( "\î" . "&icirc;")
     ( "\ "  . "&nbsp;")
     ( "\ï" . "&iuml;")
     ( "\ó" . "&oacute;")
     ( "\ò" . "&ograve;")
     ( "\Å“" . "&oelig;")
     ( "\ô" . "&ocirc;")
     ( "\ö" . "&ouml;")
     ( "\ú" . "&uacute")
     ( "\ù" . "&ugrave;")
     ( "\û" . "&ucirc;")
     ( "\ü" . "&uuml;")
     ( "\ç" . "&ccedil;")
     ("\«"  . "&laquo;")
     ("\»"  . "&raquo;")
     ("\ß" . "&szlig;")
     ("\Þ" . "&THORN;")
     ("�" . "&#357;")
     ("\ž" . "&#382;")
     ("\¡" . "&iexcl;")
     ("\¤" . "&curren;")
     ("\¦" . "&brvbar;")
     ("\¨" . "&uml;")
     ("\ª" . "&ordf;")
     ("\¬" . "&not;")
     ("\­" . "&shy;")
     ("\¯" . "&macr;")
     ("\°" . "&deg;")
     ("\±" . "&plusmn;")
     ("\²" . "&sup2;")
     ("\³" . "&sup3;")
     ("\´" . "&acute;")
     ("\µ" . "&micro;")
     ("\¶" . "&para'")
     ("\·" . "&middot;")
     ("\¸" . "&cedil;")
     ("\¹" . "&sup1;")
     ("\º" . "&ordm;")
     ("\¼" . "&frac14;")
     ("\½" . "&frac12;")
     ("\¾" . "&frac34;")
     ("\¿" . "&iquest;")
     ("\Ã" . "&Atilde;")
     ("\Ã…" . "&Aring;")
     ("\Æ" . "&AElig;")
     ("\�" . "&ETH;")
     ("\Ñ" . "&Ntilde;")
     ("\×" . "&times;")
     ("\Ø" . "&Oslash;")
     ("\�" . "&Yacute;")
     ("\ã" . "&atilde;")
     ("\Ã¥" . "&aring;")
     ("\æ" . "&aelig;")
     ("\ð" . "&eth;")
     ("\ñ" . "&ntilde;")
     ("\õ" . "&otilde;")
     ("\÷" . "&divide;")
     ("\ø" . "&oslash;")
     ("\ý" . "&yacute;")
     ("\þ" . "&thorn;")
     ("\ÿ" . "&yuml;")
     ) )
  "Converstisseur de lettres accentuées en entités HTML équivalentes. 
Cf http://www.webdesigneuse.net/Trouver-une-entite-HTML.html")

(defconst accents-convertisseur-de-html
  (make-instance
   'accents-convertisseur-inverse
   :id 'accents-convertisseur-de-html
   :liste-de-remplacement (oref accents-convertisseur-html
				:liste-de-remplacement))
  "Converstisseur d'entités HTML en lettres accentuées équivalentes" )

(defun accents-html ()
  (interactive)
  "change les caractères accentués en entités HTML équivalentes."
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-conversion accents-convertisseur-html beg end)))


(defun accents-de-html ()
  (interactive)
  "change les entités HTML en caractères accentués équivalents."
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end (let ((m (make-marker))) (set-marker m (region-end)) m)))
    (accents-conversion accents-convertisseur-de-html beg end)
    (save-excursion
      (save-match-data 
	(goto-char (or beg (point-min)))
	(while (re-search-forward "&#\\([0-9]+\\);" end t)
	  (replace-match (string (string-to-number (match-string 1))) t t))))
    (when end (set-marker end nil))))

;;---------------------------------------------------------------------------

(defconst accents-convertisseur-quote-html
  (make-instance 'accents-convertisseur-simple 
		 :id 'accents-convertisseur-quote-html
		 :liste-de-remplacement
		 '( ( "<" . "&lt;")
		    ( ">" . "&gt;")
		    ( "\"" . "&quot;")))
  "Convertisseur des caractères `\"', `<', et `>' en entités HTML
  &quot; &lt; et &gt correspondantes.")

(defconst accents-convertisseur-de-quote-html
  (make-instance
   'accents-convertisseur-inverse
   :id 'accents-convertisseur-de-quote-html
   :liste-de-remplacement (oref accents-convertisseur-quote-html
				:liste-de-remplacement))
  "Convertisseur des entités HTML &quot; &lt; et &gt, en caractères correspondants." )

(defun accents-quote-html ()
  (interactive)
  "Convertisseur des caractères `\"', `<', et `>' en entités HTML
  &quot; &lt; et &gt correspondantes."
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-conversion accents-convertisseur-quote-html beg end)))

;;---------------------------------------------------------------------------
(defconst accents-convertisseur-de-utf-8
  (make-instance 
   'accents-convertisseur-simple
   :id 'accents-convertisseur-de-utf-8
   :liste-de-remplacement 
   '(("ï" . "ï")
     ("é" . "é")
     ("â" . "â")
     ("û" . "û")
     ("è" . "è")
     ("ä" . "ä")
     ("ù" . "ù")
     ( "ç" . "ç")
     ("ê" . "ê")
     ("à" . "à")
     ("ô" . "ô")
     ))
  "Conversion de codage UTF-8 non reconue en caractères équivalents")

(defconst accents-convertisseur-de-utf-8
  (make-instance 
   'accents-convertisseur-simple
   :id 'accents-convertisseur-de-utf-8
   :liste-de-remplacement 
   '(
     ("ƒ‹" . "ы")
     ("ƒÃ" . "�")
     ("‘�" . "�")
     ("à" . "à")
     ("â" . "â")
     ("ä" . "ä")
     ("ç" . "ç")
     ("è" . "è")
     ("é" . "é")
     ("ê" . "ê")
     ("ï" . "ï")
     ("ô" . "ô")     
     ("î" . "î")
     ("ù" . "ù")
     ("û" . "û")
     ("��" . "�")
     ("�Ÿ" . "П")
     ("�°" . "а")
     ("�²" . "в")     
     ("�´" . "д")
     ("�µ" . "е")     
     ("�¶" . "ж")
     ("�·" . "з")
     ("�¸" . "и")     
     ("�º" . "к")
     ("�»" . "л")
     ("�¾" . "о")
     ("р" . "р")
     ("р" . "р")
     ("т" . "т")
     ("у" . "у")
     ("ÑÅ" . "т")
     ("�±" . "б")
     ("т´" . "�")
     ("µÑ" . "е")
     ("ˆÑ" . "е")
     ("�£" . "У")
     ("�½" . "н")
     ("�¯" . "Я")
     ("�³" . "г")
     ("ÑÄ" . "т")
     ("�¾" . "о")
     ("ÑÃ" . "у")
     ("‘Ž" . "ю")
     ("�" . "�")
     ("�°" . "а")
     ("�½" . "н")
     ("ш" . "ш")
     ("�¸" . "и")
     ("ю" . "ю")
     
))
  "Conversion de codage UTF-8 non reconue en caractères équivalents")

;(defun doit ()
;  (interactive)
;  (insert (logand (aref (buffer-substring-no-properties (point) (1+ (point))) 0) 255))
;  (delete-region (point) (1+ (point))))

(defconst accents-convertisseur-utf-8
  (make-instance 
   'accents-convertisseur-inverse
   :id 'accents-convertisseur-utf-8
   :liste-de-remplacement (oref accents-convertisseur-de-utf-8
				:liste-de-remplacement))
  "Conversion de codage UTF-8 non reconue en caractères équivalents")

(defun accents-de-utf-8 ()
  (interactive)
  "change les séquence UTF-8 en caractères accentués équivalents."
  (accents-conversion accents-convertisseur-de-utf-8))

(defun accents-utf-8 ()
  (interactive)
  "change les caractères accentués en séquences UTF-8  équivalentes."
  (accents-conversion accents-convertisseur-utf-8))

(provide 'accents-ascii)

Revision-number: 27
Prop-content-length: 424
Content-length: 424

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2012-03-22T20:44:17.000000Z
K 7
svn:log
V 321
- ajout d'une variable muette d'itération dans les dolist, c'est à dire que les bornes ne sont pas impactée
- ajout méthode doli2-remove-last
- ajout macros doli2-x>x-dolist, doli2-<.-dolist, et doli2->-dolist, doli2-<-dolist
- doli2-add-first, doli2-add-first: factorisation de code, et correction d'un bug.

PROPS-END

Node-path: trunk/lisp/doubly-linked-list.el
Node-kind: file
Node-action: change
Text-content-length: 8678
Text-content-md5: 71bcb615aebc05c98f0aea6e9f53ab24
Content-length: 8678


;;; doubly-linked-list.el --- -*- coding: iso-8859-1 -*-
;; Copyright 2012 Vincent Belaïche
;;
;; Author: Vincent Belaïche <vincentb1@users.sourceforge.net>
;; Version: $Id: doubly-linked-list.el,v 1.3 2012-03-22 20:44:17 Vincent Exp $
;; Keywords:
;; X-URL: not distributed yet

;;
;; This software is governed by the CeCILL license under French law and abiding
;; by the rules of distribution of free software.  You can use, modify and/ or
;; redistribute the software under the terms of the CeCILL license as circulated
;; by CEA, CNRS and INRIA at the following URL "http://www.cecill.info".
;;
;; As a counterpart to the access to the source code and rights to copy, modify
;; and redistribute granted by the license, users are provided only with a
;; limited warranty and the software's author, the holder of the economic
;; rights, and the successive licensors have only limited liability.
;;
;; In this respect, the user's attention is drawn to the risks associated with
;; loading, using, modifying and/or developing or reproducing the software by
;; the user in light of its specific status of free software, that may mean that
;; it is complicated to manipulate, and that also therefore means that it is
;; reserved for developers and experienced professionals having in-depth
;; computer knowledge. Users are therefore encouraged to load and test the
;; software's suitability as regards their requirements in conditions enabling
;; the security of their systems and/or data to be ensured and, more generally,
;; to use and operate it in the same conditions as regards security.
;;
;; The fact that you are presently reading this means that you have had
;; knowledge of the CeCILL license and that you accept its terms.
;;
;;; Commentary:

;;

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'doubly-linked-list)

;;; Code:
(require 'eieio)
(eval-when-compile
  (require 'cl))



;;;;##########################################################################
;;;;  User Options, Variables
;;;;##########################################################################

(defclass doli2-list ()
  ((head
    :initarg :head
    :initform nil
    :documentation "Pointe sur le premier élément de la liste si
   la liste est non-vide.")
   (tail
    :initarg :tail
    :initform nil
    :documentation "Pointe sur le dernier élément de la liste si
    la liste est non vide.")
   (size
    :initarg :size
    :initform 0
    :documentation "Nombre d'éléments de la liste."))
  :documentation "Liste doublement chaînée.")

(defclass doli2-element ()
  ((next
    :initarg :next
    :initform nil
    :type (or null doli2-element)
    :documentation "Élément suivant dans la liste, `nil' pour le
    dernier élément.")
   (previous
    :initarg :previous
    :initform nil
    :type (or null doli2-element)
    :documentation "Élément précédent dans la liste, `nil'
    pour le dernier élément."  ))
  :abstract t
  :documention "Classe de base pour les éléments d'objets de classe
  `doli2-list'.")

(defgeneric doli2-equal ((this doli2-element) (other doli2-element))
  "Comparaison de deux `doli2-element'.")

(defmethod doli2-add-first
  ((this doli2-list)
   (elt doli2-element))
  "Ajoute un nouvel élément en tête de liste."
  (when
      (or (oref elt :next)
	  (oref elt :previous))
    (error "L'élément est déjà dans une liste"))
  (let ((size (oref this :size)))
    (if (= 0 size)
	(oset this :tail elt)
      (let ((head  (oref this :head)))
	(oset elt :next head)
	(oset head :previous elt)))
    (oset this :head elt)
    (oset this :size (1+ size))))

(defmethod doli2-add-last
  ((this doli2-list)
   (elt doli2-element))
  "Ajoute un nouvel élément en queue de liste."
  (when
      (or (oref elt :next)
	  (oref elt :previous))
    (error "L'élément est déjà dans une liste"))
  (let ((size (oref this :size)))
    (if (= 0 size)
	  (oset this :head elt)
      (let ((tail  (oref this :tail)))
	(oset elt :previous tail)
	(oset tail :next elt)))
    (oset this :tail elt)
    (oset this :size (1+ size))))

(defmethod doli2-remove
  ((this doli2-list)
   (elt doli2-element))
  "Retranche `elt' de la liste `this'."
  (let ((size (oref this :size)))
    (cond
     ((>= 0 size)
      (error "Liste vide %S" this))
     ((= 1 size)
      (oset this :head nil)
      (oset this :tail nil)
      (oset this :size 0))
     ((eq (oref this :head) elt)
      (let ((next (oref elt :next)))
	(oset this :head next)
	(oset next :previous nil)
	(oset this :size (1- size))
	(oset elt :previous nil)
	(oset elt :next nil)))
     ((eq (oref this :tail) elt)
      (let ((previous (oref elt :previous)))
	(oset this :tail previous)
	(oset previous :next nil)
	(oset this :size (1- size))
	(oset elt :previous nil)
	(oset elt :next nil)))
     (t
      (let ((next (oref elt :next))
	    (previous (oref elt :previous)))
	(oset next :previous previous)
	(oset previous :next next)
	(oset this :size (1- size))
	(oset elt :previous nil)
	(oset elt :next nil))))))

(defmethod doli2-remove-first
  ((this doli2-list))
  "Retranche le premier élément de la liste THIS. Génère une
erreur si la liste est vide."
  (let ((ret (oref this :head))
	(size (1- (oref this :size))))
    (if (> 0 size)
	(error "Liste vide")
      (oset this :size size)
      (if (< 0  size)
	  (let ((next (oref ret :next)))
	    (oset this :head next)
	    (when next (oset next :previous nil)))
	(oset this :head nil)
	(oset this :tail nil)))
     (oset ret :next nil)
     ret))

(defmethod doli2-remove-last
  ((this doli2-list))
  "Retranche le dernier élément de la liste THIS. Génère une
erreur si la liste est vide."
  (let ((ret (oref this :tail))
	(size (1- (oref this :size))))
    (if (> 0 size)
	(error "Liste vide")
      (oset this :size size)
      (if (< 0  size)
	 (let ((previous  (oref ret :previous)))
	  (oset this :tail previous)
	  (when previous (oset previous :next nil)))
	(oset this :tail nil)
	(oset this :head nil)))
     (oset ret :previous nil)
     ret))

(defmacro doli2-.>x-dolist (spec &rest body)
  "(doli2-.>x-dolist (V FROM TO) BODY) itère V sur BODY depuis FROM
inclus, jusqu'à TO exclus en parcourant la liste dans le sens normal."
  `(let ((,(car spec) ,(cadr spec)))
     (while (null (eq ,(car spec) ,(caddr spec)))
       ,@body
       (setq ,(car spec) (oref ,(car spec) :next)))))

(defmacro doli2-x>x-dolist (spec &rest body)
  "(doli2-x>x-dolist (V FROM TO) BODY) itère V sur BODY depuis FROM
exclus, jusqu'à TO exclus en parcourant la liste dans le sens normal."
  `(let ((,(car spec) (oref ,(cadr spec) :next)))
     (unless (eq ,(car spec) ,(caddr spec))
       (while
	   (progn
	     ,@body
	     (setq ,(car spec) (oref ,(car spec) :next))
	     (null (eq ,(car spec) ,(caddr spec))))))))

(defmacro doli2-.>-dolist (spec &rest body)
  "(doli2-.>-dolist (V FROM) BODY) itère sur BODY depuis FROM inclus,
jusqu'à la fin inculse de la liste en parcourant la liste dans le
sens normal."
  `(let ((,(car spec) ,(cadr spec)))
     (while
       (progn
	 ,@body
	 (setq ,(car spec) (oref ,(car spec) :next))))))

(defmacro doli2-x>-dolist (spec &rest body)
  "(doli2-x>-dolist (V FROM) BODY) itère sur BODY depuis FROM exclus,
jusqu'à la fin inculse de la liste en parcourant la liste dans le
sens normal."
  `(let ((,(car spec) (oref ,(cadr spec) :next)))
     (when ,(car spec)
       (while
	   (progn
	     ,@body
	     (setq ,(car spec) (oref ,(car spec) :next)))))))

(defmacro doli2-x<.-dolist (args &rest body)
  "(doli2-.>x-dolist (V FROM TO) BODY) itère sur BODY depuis FROM
inclus, jusqu'à TO exclus dans le sens inverse."
  `(let ((,(car spec) ,(cadr spec)))
     (while (null (eq ,(car spec) ,(caddr spec)))
      ,@body
      (setq ,(car spec) (oref ,(car spec) :previous)))))


(defmacro doli2-<.-dolist (spec &rest body)
  "(doli2-<.-dolist (V FROM) BODY) itère V sur BODY depuis FROM
inclus, jusqu'au début inclus de la liste en parcourant la
liste dans le sens inverse."
  `(while
       (progn
	 ,@body
	 (setq ,from (oref ,from :previous)))))

(defmacro doli2->-dolist (spec &rest body)
  "(doli2->-dolist (V LIST) BODY). Itère sur BODY avec V qui
parcourt LIST dans le sens normal."
  `(let ((,(car spec) (oref ,(cadr spec) :head)))
     (while ,(car spec)
       ,@body
       (setq ,(car spec) (oref ,(car spec) :next)))))

(defmacro doli2-<-dolist (spec &rest body)
  "(doli2->-dolist (V LIST) BODY). Itère sur BODY avec V qui
parcourt LIST dans le sens inverse."
  `(let ((,(car spec) (oref ,(cadr spec) :tail)))
     (while ,(car spec)
       ,@body
       (setq ,(car spec) (oref ,(car spec) :previous)))))

(provide 'doubly-linked-list)

;;; doubly-linked-list.el ends here


Revision-number: 28
Prop-content-length: 3001
Content-length: 3001

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2012-03-23T18:34:36.000000Z
K 7
svn:log
V 2897
(html2texi-convert-restrictions): Ajout.
(html2texi-push-restrictions): Ajout.
(html2texi-pop-restrictions): Ajout.
(html2texi-has-restrictions-p): Ajout.
(html2texi-with-restrictions): Ajout.
(html2texi-locator-info): Ajout du slot "size".
(html2texi-locator-listing): Mise à jour docstring.
(html2texi-add-locator): Utilisation de doli2-add-last pour
l'ajout du localisateur.
(html2texi-document-information): Ajout. Utilisation de cette
classe plutôt que d'une liste d'association comme précédemment. Le
slot header-size n'avait pas d'équivalent dans la liste
d'association.
(html2texi-document-information-object): Renommage de
`html2texi-document-information' en
`html2texi-document-information-object'.
(html2texi-convert-restrictions-object): Ajout.
(html2texi-tag-handler-a): Prise en chage d'une partie texte
formattée dans les @ref et consorts.
(html2texi-tag-handler-a, html2texi-flush-anchors): Utilisateur de
la fonction `html2texi-insert-locator' pour l'enregistrement du
localisateur pour le post-traitement d'embellissement.
(html2texi-insert-locator): Ajout.
(html2texi-tag-handler-frameset, html2texi-tag-handler-frame):
Insertion du frameset comme un article @menu.
(html2texi-tag-handler-html, html2texi-tag-handler-meta)
(html2texi-tag-handler-title, html2texi-insert-doc-info): Accès à
html2texi-document-information-object comme un objet et non plus
plus comme une liste d'association.
(html2texi-process-url): Traitement de texte formatté dans les
@ref et consorts. Utilisation directe ou indirecte de
html2texi-convert-restrictions-object pour la détection
d'erreur (référence dans une référence). Nouvel argument type pour
l'enregistrement dans la html2texi-locator-list, et aussi pour
supporter le nouveau type de localisateur
@menu-item. Enregistreement du localisateur dans la
html2texi-locator-list pour poste-traitement d'embellissement.
(hmtl2texi-to-plain-text): On n'appelle plus html2texi-make-anchor
au moment du push dans html2texi-flushable-anchors mais au moment
du traitement de html2texi-flushable-anchors par le truchement de
html2texi-insert-locator.
(html2texi-set-doc-info): Suppression, du fait que
html2texi-document-information-object est un objet eieio, le même
type de service est directement apporté par eieio.
(html2texi-make-texi-buffer): Variable file-name rendu varialbe de
`let'. Utilisation de html2texi-insert-locator pour l'insertion
des localisateurs avec enregistrement dans html2texi-locator-list.
(html2texi-insert-doc-info): Stockage de la taille de l'en-tête
dans html2texi-document-information-object, utile pour le
post-traitement d'embellissement.
(html2texi-post-process): Débourrage du traitement
d'embellissement des localisateurs.
(html2texi): Ajout des variables définies par `let':
`html2texi-document-information-object' et
`html2texi-convert-restrictions-object'.

PROPS-END

Node-path: trunk/lisp/html-to-texinfo.el
Node-kind: file
Node-action: change
Text-content-length: 72390
Text-content-md5: 083b25063465a4939ded802d84a6b128
Content-length: 72390

;;; html-to-texinfo.el --- -*- coding: iso-8859-1 -*-
;; Copyright 2010/2012 Vincent Belaïche
;;
;; Author: Vincent Belaïche <vincent.b.1@hotmail.fr>
;; Version: $Id: html-to-texinfo.el,v 1.14 2012-03-23 18:34:36 Vincent Exp $
;; Keywords: Texinfo, HTML, conversion
;; X-URL: not distributed yet
;;
;; This software is governed by the CeCILL license under French law and abiding
;; by the rules of distribution of free software.  You can use, modify and/ or
;; redistribute the software under the terms of the CeCILL license as circulated
;; by CEA, CNRS and INRIA at the following URL "http://www.cecill.info".
;;
;; As a counterpart to the access to the source code and rights to copy, modify
;; and redistribute granted by the license, users are provided only with a
;; limited warranty and the software's author, the holder of the economic
;; rights, and the successive licensors have only limited liability.
;;
;; In this respect, the user's attention is drawn to the risks associated with
;; loading, using, modifying and/or developing or reproducing the software by
;; the user in light of its specific status of free software, that may mean that
;; it is complicated to manipulate, and that also therefore means that it is
;; reserved for developers and experienced professionals having in-depth
;; computer knowledge. Users are therefore encouraged to load and test the
;; software's suitability as regards their requirements in conditions enabling
;; the security of their systems and/or data to be ensured and, more generally,
;; to use and operate it in the same conditions as regards security.
;;
;; The fact that you are presently reading this means that you have had
;; knowledge of the CeCILL license and that you accept its terms.
;;
;;; Commentary:

;;

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'html-to-texinfo)

;;; Code:

(provide 'html-to-texinfo)
(eval-when-compile
  (require 'cl))
(require 'eieio)
(require 'calc-ext)
(require 'accents-ascii)
(require 'doubly-linked-list)
(require 'compile)

;;;;##########################################################################
;;;;  User Options, Variables
;;;;##########################################################################

(defconst html2texi-suspicious-html-tags
  '("meta" "br" "hr" "link" "img" "frame")
"Liste des balises pour lesquelles le HTML ne suit pas une
syntaxe strictement XML. Par exemple `<br>' est utilisé au lieu
de `<br/>'."  )

(defconst html2texi-suspicious-html-tags-re
  (regexp-opt html2texi-suspicious-html-tags))

(defconst html2texi-non-recursive-tags
  '("p" "li"))

(defconst html2texi-hierarchy-list
  '(
    (li (ul ol))
    (tr (table))
    (th (tr))
    (td (tr))
    (dd (dl))
    (dt (dl))  ))

(defconst html2texi-non-recursive-tags-re
  (regexp-opt html2texi-non-recursive-tags))

(defconst html2texi-filepath-re
  "\\(?:[A-Za-z]:\\)?[- ~+A-Za-z_0-9./\\]+")

(defconst html2texi-texi-buffer-local-variables
  '(html2texi-document-information)
    "Liste des variables déclarées localement au tampon Texinfo.")

(defconst html2texi-allowed-markup-in-@center
  '(img b i em tt strong dfn code)
  "Liste des balises autorisées pour @center.")

(defconst html2texi-@center-max-size 1000)

(defclass html2texi-simple-markup ()
  ((class-dependant
    :initarg :class-dependant
    :initform nil
    :custom '(repeat
	  (list
	   (regexp :tag "clef")
	   (string :tag "prologue")
	   (string :tag "épilogue")
	   (boolean :tag "conserver les espaces et retours chariot")
	   ))
    :documentation "\
Liste d'association dont les éléments sont de la forme
 (CLEF PROLOGUE ÉPILOGUE)

Supposons que l'objet décrit le traitement de la balise TAG,
alors lorsque le code HTML `<TAG class=\"CLEF\">CONTENU</TAG>'
est rencontré, alors il est convertie en le code Texinfo
`PROLOGUE TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU.")
   (preamble
    :initarg :preamble
    :type string
    :documentation "\
Prologue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (postamble
    :initarg :postamble
    :type string
    :documentation "\
Épilogue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (space-verb
    :initarg :space-verb
    :initform nil
    :type boolean
    :documentation "\
Vrai lorsque les espaces et retours chariot sont à conserver tels quels."
    ))
  :documentation "\
Un object de type `html2texi-simple-markup'
décrit le traitement d'une balise simple comme par exemple
<code>.")

(defclass html2texi-convert-restrictions ()
  ((current-restrictions
    :initarg :current-restrictions
    :initform nil
    :documentation "Liste des restrictions de conversion
    courantes. Par exemple dans un @ref les @table sont
    interdite.")
   (stack
    :initform nil
    :documentation "Pile pour ajouter des restrictions, et les ôter ensuite."))
  :documentation "Contexte des restrictions de conversions courantes.")

(defmethod html2texi-push-restrictions
  ((this html2texi-convert-restrictions) &rest restrictions)
  "Ajoute les restrictions de conversion RESTRICTIONS."
  (let ((current-restrictions (oref this :current-restrictions))
	new-restrictions)
    (dolist (v restrictions)
      (unless (memq v current-restrictions)
	(push v new-restrictions)))
    (oset this :current-restrictions (append new-restrictions
					    (oref this :current-restrictions)))
    (oset this stack (cons new-restrictions (oref this stack)))))

(defmethod html2texi-pop-restrictions
  ((this html2texi-convert-restrictions))
  "Restaure les restrictions d'avant l'appel à `html2texi-push-restrictions'."
  (let* ((new-stack (oref this stack))
	 (latest (pop new-stack))
	 (current (oref this :current-restrictions)))
    (oset this stack new-stack)
    (dotimes (i (length latest))
      (pop current))
    (oset this :current-restrictions current)))

(defmethod html2texi-has-restrictions-p
  ((this html2texi-convert-restrictions) &rest restrictions)
  "Teste si l'une des restrictions dans RESTRICTIONS est en vigueur."
  (let ((current-restrictions (oref this :current-restrictions))
	ret restriction)
    (while restrictions
      (setq restriction (pop restrictions)
	    ret (memq restriction current-restrictions)
	    restrictions (if ret nil restrictions)))
    ret))

(defmacro html2texi-with-restrictions (restrictions &rest body)
  "Effectue BODY avec les restrictions dans la liste RESTRICTIONS."
 `(progn
    (html2texi-push-restrictions html2texi-convert-restrictions-object ,@restrictions)
    (unwind-protect
	(progn ,@body)
      (html2texi-pop-restrictions html2texi-convert-restrictions-object))))

(defclass html2texi-locator-info (doli2-element)
 ((id
   :initarg :id
   :type string
   :documentation "Identifiant d'ancre.")
  (type
   :initarg :type
   :type symbol
   :documentation "Soit `:@anchor', `:@ref',
    `:@node', soit `:@menu-item'."  )
  (position
   :initarg :position
   :type integer
   :documention "Point dans le tampon Texinfo où l'ancre est utilisée.")
  (size
   :initarg :size
   :type integer
   :documentation "Nombre de caractères dans le localisateur."))
:documentation "Détient l'information concernant une ancre
utilisée soit par un `@anchor', soit un `@node', soit un
`@ref'.")

(defclass html2texi-locator-listing (doli2-list)
  ((hash-table
    :initarg :hash-table))
  :documentation "Liste de `html2texi-locator-info', c'est à dire
    de pointeurs sur des `@node', `@ref' ou `@anchor', ou des
    entrée de `@menu', de sorte à embellir les noms de localisateurs a
    postériori."  )

(defmethod initialize-instance ((this html2texi-locator-listing) &rest fields)
  (call-next-method)
  (oset this :hash-table (make-hash-table)))

(defmethod html2texi-add-locator ((this html2texi-locator-listing) locator-info)
  (let* ((locator-id (oref locator-info :id))
	 (table (oref this :hash-table)))
    (doli2-add-last this locator-info)
    (puthash
     locator-id
     (cons locator-info (gethash locator-id table))
     table)))

(defclass html2texi-files-to-do-listing ()
  ((already-to-do
   :initarg :already-to-do
   :initform nil
   :documentation "Liste des fichiers qui ont été trouvés comme
   étant à traiter lors du traitement d'un fichier qui a déjà été
   complètement traité.")
   (doing-or-done
    :initarg :doing-or-done
    :initform nil
    :documentation "Liste des fichiers qui ont déjà été traités, le
    premier de la liste est le fichier en cours de traitement."
    )
   (added-file-count
    :initarg :added-file-count
    :initform 0
    :documentation "Nombre de fichier qui est été ajouté à la
  liste des fichiers à traiter.")
   (soon-to-do
   :initarg :soon-to-do
   :initform nil
   :documentation "Liste des fichiers qui sont trouvés comme
   étant à traiter lors du traitement du fichier en cours de
   traitement."))
  :documentation "Objet servant à lister les fichiers à
  traiter. Il comprend deux listes: `already-to-do' et
  `soon-to-do' parce que lors du traitement d'un fichier TOTO les
  nouveaux fichiers à traiter sont mis dans `soon-to-do' dans
  l'ordre où ils sont rencontrés, du coup une fois que le fichier
  TOTO a complètement été traité, on inverse cet ordre en
  transvasant le contenu de `soon-to-do' dans `already-to-do'.")

(defclass html2texi-table-fmt-ctxt ()
  ((col-number
    :initarg :col-number
    :initform 0
    :type integer)
   (row-number
    :initarg :row-number
    :initform 0
    :type integer)
   (head-on-row-0
    :initarg :head-on-row-0
    :initform nil
    :type boolean)
   (force-head
    :initarg :force-head
    :initform nil
    :type boolean)
   (col-count
    :initarg :col-count
    :initform 0
    :type integer
    :documentation
    "Nombre de colonnes dans le tableau.")
   (col-info
    :initarg :col-info
    :documentation
    "Liste d'information sur chaque colonne. Le premier élément
    est factice est ne correspond à aucune colonne.")
   (col-info-last
    :initarg :col-info-last
    :documentation
    "Pointe sur la dernière cons-cell de l'attribut `:col-info'.")
   (col-info-length
    :initarg :col-info-length
    :initform 0
    :type integer))
  :documentation "Contexte de formattage d'une table.")

(defmethod initialize-instance ((this html2texi-table-fmt-ctxt) &rest fields)
  (call-next-method)
  (let ((ci (list 0)))
    ;; le premier élément ne correspond pas à une colonne mais servira à
    ;; reduire le vecteur des informations sur chaque colonne
    (oset this :col-info ci)
    (oset this :col-info-last ci)))


(defmethod html2texi-files-has-to-do ((this html2texi-files-to-do-listing))
  (or (oref this :already-to-do)
      (oref this :soon-to-do))  )

(defmethod html2texi-current-file ((this html2texi-files-to-do-listing))
  (car (oref this :doing-or-done)))

(defmethod html2texi-get-next-file-next-to-do  ((this html2texi-files-to-do-listing))
  "Récupère le prochain fichier à traiter. L'appel de cette
méthode si aucun fichier n'est à traiter génère une erreur."
  (let ((soon-to-do (oref this :soon-to-do))
	(already-to-do (oref this :already-to-do)))
    (when soon-to-do
      (while soon-to-do (push (pop soon-to-do) already-to-do))
      (oset this :soon-to-do nil))
    (let ((next (pop already-to-do)))
      (oset this :already-to-do already-to-do)
      (oset this :doing-or-done (cons next (oref this :doing-or-done)))
      next)))

(defmethod html2texi-add-file-to-do   ((this html2texi-files-to-do-listing) next)
  "Ajoute le fichier dont le nom absolu est NEXT à la liste des
fichier à traiter. Renvoie `nil' si le fichier était déjà
connu, non-`nil' sinon."
  (unless (or (member next (oref this :already-to-do))
	      (member next (oref this :doing-or-done))
	      (member next (oref this :soon-to-do)))
    (oset this :soon-to-do (cons next (oref this :soon-to-do)))
    (oset this :added-file-count (1+ (oref this :added-file-count)))))

(defclass html2texi-document-information ()
  ((author
    :initarg :author
    :type string)
   (title
    :initarg :title
    :type string)
   (language
    :initarg :language
    :type string)
   (encoding
    :initarg :encoding
    :type string)
   (header-size
    :initarg :header-size
    :type integer)
   )
  :documentation "Information sur le document Texinfo")

(defun html2texi-texinfo-inside-comment-p ()
  "Renvoie non nil lorsque le point est dans un commentaire Texinfo."
  (save-match-data
    (save-excursion
      (let ((cur (point))
	    (end (progn (end-of-line) (point))))
	(beginning-of-line)
	(and (re-search-forward "\\(^\\|[^@]\\)@c\\(omment\\)\\_>" end t)
	     (<= (match-beginning 0) cur))))))

(defmethod html2texi-handle-simple-markup
  ((this html2texi-simple-markup) xml-expr)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe
			(and class-attribute
			     (assoc-string (cdr class-attribute)
					   (oref this :class-dependant))))
		      (list (oref this :preamble)
			    (oref this :postamble)))))
    (insert (car pre-post))
    (let ((beg (point))
	  end)
      (html2texi-process-xml-expr xml-expr)
      (unless (oref this :space-verb)
	(setq end (point-marker))
	(goto-char beg)
	(while (re-search-forward "[\n\r]\\s-*" nil end)
	  (let ((replace-str " "))
	    (save-match-data
	      (cond
	       ((html2texi-texinfo-inside-comment-p)
		(setq replace-str nil))))
	      (and replace-str (replace-match replace-str t t)))))
	(goto-char end)
	(set-marker end nil))
    (insert (cadr pre-post))))


(defcustom html2texi-save-texi-buffer-confirm-p
  t
  "`nil' pour sauvegarder sans confirmation le tampon Texinfo
après la conversion, `t' sinon."
  :type '(radio
	  (const :tag "Sans confirmation" nil)
	  (const :tag "Demander confirmation" t))
  :group 'html2texi)

(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-reuse-log-buffer t
  "Mettre à `nil' pour que le tampon de sortie des erreurs &
avertissement soit re-généré avec un nom unique à chaque
traitement."
  :type  '(radio
	  (const :tag "Créer un nouveau tampon d'erreurs à chaque conversion." nil)
	  (const :tag "Réutiliser le tampon d'erreurs s'il existe déjà." t))
  :group 'html2texi)

(defcustom html2texi-url-encoding
  :html2texi-utf-8
  "Sélectionne le codage des URL."
  :type '(radio
	  (symbol :tag "UTF-8" :html2texi-utf-8)
	  (symbol :tag "ISO-8859-1" :html2texi-latin-1))
  :group 'html2texi)

(defcustom html2texi-i-simple-markup
  (html2texi-simple-markup "html2texi-i-simple-markup"
   :preamble "@i{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-b-simple-markup
  (html2texi-simple-markup "html2texi-b-simple-markup"
   :preamble "@b{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-kbd-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :preamble "@kbd{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-dfn-simple-markup
  (html2texi-simple-markup "html2texi-dfn-simple-markup"
   :preamble "@dfn{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-em-simple-markup
  (html2texi-simple-markup "html2texi-em-simple-markup"
   :preamble "@emph{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-sub-simple-markup
  (html2texi-simple-markup "html2texi-sub-simple-markup"
   :preamble ""
   :postamble "")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<sub class=\"CLEF\">CONTENU</sub>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-sup-simple-markup
  (html2texi-simple-markup "html2texi-sup-simple-markup"
   :preamble ""
   :postamble "")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<sup class=\"CLEF\">CONTENU</sup>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-samp-simple-markup
  (html2texi-simple-markup "html2texi-samp-simple-markup"
   :preamble "@samp{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<samp class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-strong-simple-markup
  (html2texi-simple-markup "html2texi-strong-simple-markup"
   :preamble "@strong{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-tt-simple-markup
  (html2texi-simple-markup "html2texi-tt-simple-markup"
   :preamble "@t{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<tt class=\"CLEF\">CONTENU</tt>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-handle-two-columns-table-as-@table
  t
 "Si `nil' alors une table `<table>...</table>'
avec deux colonne sera gérée en texinfo par une `@table', si non
`nil', alors elle sera gérée par une `@multitable'."
  :type
  '(choice
    (const :tag "t pour @table" t)
    (const :tag "nil pour @multitable" nil))
  :group 'html2texi)

(defcustom html2texi-log-error-names
   ["Erreur fatale" "Erreur" "Avertissement" "Info"]
   "Liste des types d'erreur préfixant les messages d'erreur dans
le tampon de sortie des erreurs & avertissement de traitement."
   :type
   '(vector
     (string :tag "Erreur fatale")
     (string :tag "Erreur")
     (string :tag "Avertissement")
     (string :tag "Info"))
   :group 'html2texi  )

(defcustom html2texi-log-buffer-name
  "*HTML2TEXI*"
  "Nom du tampon de sortie des erreurs et avertissements de traitement."
  :type 'string
  :group 'html2texi)

(defcustom html2texi-beautify-locators
  t
  "Embellit les identificateur de localisateur après génération
  du Texinfo."
  :type '(radio
	  (const :tag "Ne pas embellir les identificateurs de localisateur." nil)
	  (const :tag "Embellir les identificateurs de localisateur." t))
  :group 'html2texi )

(defvar html2texi-document-information-object nil
  "Objet de classe `html2texi-document-information' pour mémoriser les informations (titre,
  auteurs, etc...) propres à un document.")

(defvar html2texi-line-delta 0
  "Décalage entre le numéro de ligne du code XML au sein le
  tampon Texinfo en cours de traitement, et son numéro de ligne
  dans le fichier HTML source.")

(defvar html2texi-xml-stack nil
  "Pile des expressions XML")

(defvar html2texi-keep-empty-strings nil
  "Non nil si les chaînes vides sont à conserver.")

(defvar html2texi-ignore-head nil
  "Non nil si on ignore le <head> (dans un fichier HTML lié).")

(defvar html2texi-directory-stack nil
  "Pile des chemins de répertoire.")

(defvar html2texi-files-to-do nil
  "Base des fichiers non encore traités, instanciée localement
  comme un objet de class `html2texi-files-to-do-listing'.")

(defvar html2texi-flushable-anchors nil
  "Liste de nom d'ancrage de lien dont l'insertion a été remise à
  plus tard." )

(defvar html2texi-postpone-output nil
  "Non `nil' lorsque l'insertion du code est remise à plus tard.")

(defvar html2texi-directory-ref nil
  "Répertoire de référence")

(defvar html2texi-log-buffer nil
  "Tampon de sortie des erreurs et avertissements de traitement.")

(defvar html2texi-reusable-log-buffer nil
  "Quand `html2texi-reuse-log-buffer' vaut est non `nil', tampon
  qu'on essaie de reutiliser pour la sortie des erreurs..")

(defvar html2texi-texi-buffer-name nil
  "Nom du tampon Texinfo généré.")

(defvar html2texi-locator-list nil
  "Liste des localisateurs, pour post-traitement d'embellissement
  des identificateurs de localisateur.")

(defvar html2texi-convert-restrictions-object nil
  "Objet de classe `html2texi-convert-restrictions' comprenant la
  liste courante des restrictions de conversion."  )

(defmacro html2texi-make-simple-markup-handler (tag)
  `(defun ,(intern (concat "html2texi-tag-handler-" (symbol-name tag)))
     (xml-expr)
     (html2texi-handle-simple-markup
      ,(intern (concat "html2texi-"  (symbol-name tag) "-simple-markup"))
      xml-expr) ))

(defun html2texi-make-html-clean-xml (beg end)
  (let  ((end-arg end)
	 end)
    ;; initialisation de end comme un marque
    (if (markerp end-arg)
	(setq end end-arg)
      (goto-char end-arg)
      (setq end (point-marker)))

    ;; rend les balise implicitement auto-closante vraiment auto-closante
    (goto-char beg)
    (while (re-search-forward (concat "<\\(" html2texi-suspicious-html-tags-re "\\)\\>")
			      end t)
      (let ((tag (match-string-no-properties 1)))
	(unless (re-search-forward ">" nil t)
	  (html2texi-fatal-error "Clôture non trouvé pour la balise %s" nil
				 tag))
	(when (null (looking-back "/>"))
	  (backward-char)
	  (insert "/")
	  (forward-char))))

    ;; marque de paragraphe et de ligne
    (goto-char beg)
    (let (tag-stack pos-< pos->
		    tag is-closure self-closing)
      (while (re-search-forward "<\\(/\\)?\\([a-zA-Z]+\\)\\>" end t)
	(setq pos-< (match-beginning 0)
	      tag (match-string-no-properties 2)
	      is-closure (match-string-no-properties 1))
	(unless (string= tag (downcase tag))
	  (replace-match (setq tag (downcase tag)) 2))
	(unless (re-search-forward ">" end t)
	  (html2texi-fatal-error "Soufflet de clôture non trouvé pour la balise %s" nil
		 tag))

	(setq pos-> (point)
	      self-closing (looking-back "/>"))
	(cond
	 ((and self-closing  is-closure)
	  (html2texi-fatal-error "balise %s à la fois de clôture et auto-closante" nil
		 tag))

	 (self-closing
	  ;; do nothing
	  )

	 ((null is-closure)
	  (when (and
		 (string-match (concat "\\`" html2texi-non-recursive-tags-re "\\'") tag)
		 tag-stack
		 (string= tag (caar tag-stack)))
	    ;; clôture
	    (save-excursion
	      (goto-char pos-<)
	      (insert "</" tag "><!-- HTML2TEXI: repaired (1) -->")
	      (html2texi-warning "Ajout clôture `</%s>'" nil tag))
	    (pop tag-stack))
	  (push (list tag) tag-stack))

	 (is-closure
	  (if (and tag-stack
		   (string= (caar tag-stack) tag))
	      (pop tag-stack)
	    (let ((first (assoc-string tag tag-stack)) rev)
	      (if first
		  (progn
		    (while (and tag-stack (null (eq (car tag-stack) first)))
		      (push (pop tag-stack) rev))
		    (pop tag-stack)
		    (save-excursion
		      (goto-char pos-<)
		      (dolist (c rev)
			(insert  "</" (car c) "><!-- HTML2TEXI: repaired (2) -->" )
			(html2texi-warning "Ajout clôture `</%s>'" nil tag))))

		(save-excursion
		  (goto-char pos->)
		  (insert "-->")
		  (goto-char pos-<)
		  (insert "<!-- HTML2TEXI: repaired (3). "))
		(html2texi-warning "Clôture de %s ne correspondant à aucune ouverture" nil tag)))))))


      (let (p-pos li-pos markup poss pos)
	(while (re-search-forward "<\\(/\\)?\\(p\\|li\\)\\>[^>]*>" end t)
	  (setq markup (match-string-no-properties 2)
		poss (intern (concat markup "-pos"))
		pos (symbol-value poss))
	  (if (match-string-no-properties 1)
	      (if  pos
		  (if (= pos (match-beginning 0))
		      (set poss nil)
		    (html2texi-fatal-error "Clôture de balise %s ne correspondant à aucune ouverture" nil
					   (match-string-no-properties 0)))
		(save-excursion
		  (save-match-data
		    (unless  (re-search-forward
			      (format "<\\(/\\)?\\(%s\\)\\>[^>]+>" markup)
			      end t)
		      (html2texi-fatal-error "Ouverture de balise <%s> sans clôture" nil
					     markup))
		    (set poss (match-beginning 0))
		    (unless (match-string-no-properties 1)
		      (goto-char (match-beginning 0))
		      (insert (format "</%s>" markup))
		      (dolist (symb '(p-pos li-pos))
			(unless (or (null (symbol-value symb))
				    (eq symb poss))
			  (set symb (+ (length markup) 3 (symbol-value symb)))))))))))
	))

    ;; mise entre guillemets anglais des attributs entier sans guillemets
    (goto-char beg)
    (let (p1 p2 added-dquote-attributes p-start p-end)
      ;; tant qu'on trouve potentiellement un attribut sans "..."
      (while (re-search-forward "\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([-+]?[0-9]+\\)"
				nil end)
	(setq p1 (match-beginning 1)
	      p2 (match-end 0))
	(if
	    ;; si la position est bien entre < et >
	    (and (re-search-backward "[<>]" beg t)
		 (looking-at "<\\sw+")
		 (progn
		   (goto-char (setq p-start (match-end 0)))
		   (re-search-forward "[<>]" end t)
		   (string= (match-string-no-properties 0) ">"))
		 (>= (setq p-end (match-beginning 0)) p1))
	    ;; alors on fait la réparation
	    (progn
	      (goto-char p-start)
	      (while
		  (progn
		    (while (looking-at "\\(?:\\s-\\|\n\\)*\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\"[^\"]*\"")
		      (goto-char (match-end 0)))
		    (cond
		     ((looking-at  "\\(?:\\s-\\|\n\\)*\\(\\sw+\\)\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([-+]?[0-9]+\\)")
		      (push (match-string-no-properties 1) added-dquote-attributes)
		      (goto-char (match-beginning 2))
		      (insert ?\")
		      (goto-char (1+ (match-end 2)))
		      (insert ?\")
		      (setq p-end (+ 2 p-end)))
		     ((looking-at "\\(?:\\s-\\|\n\\)*>")
		      (goto-char (match-end 0))
		      (insert "<!-- HTML2TEXI inserted double quotes around values for attibutes: "
			      (mapconcat (lambda (x) (concat "`" x "'"))
					 added-dquote-attributes
					 ", ")
			      " -->")
		      nil)
		     (t (html2texi-error "Attribut au format invalide: %s."
			       (buffer-substring (point) p-end)))))))
	  ;; sinon on continue à chercher un attribut potentiel dont la valeur
	  ;; n'est pas entre "..."
	  (goto-char p2))))

    ;; un peu de ménage...
    (unless (markerp end-arg)
      (set-marker end nil)) ))

;;;==========================================================================
;;; définition des gestionnaires de balise
;;;--------------------------------------------------------------------------

(defun html2texi-tag-handler-a (xml-expr)
  (let (name href text (xml-expr-length (length xml-expr)))
    (dolist (attrib (cadr xml-expr))
      (cond
       ((eq (car attrib) 'href)
	(setq href (cdr attrib)))
       ((eq (car attrib) 'name)
	(setq name (cdr attrib)))))
    (and (cddr xml-expr)
	 (setq text (if (cdddr xml-expr)
			xml-expr
		      (caddr xml-expr))))
    (cond
     (href (html2texi-process-url href text))
     ((= xml-expr-length 3)
      (cond
       ((stringp text)
	(insert (html2texi-string-escape text t)))
       ((consp text)
	(html2texi-process-xml-expr text)	)
       (t (error "Le format du text de la balise <a> était inattendu"))))
     ((> xml-expr-length 3)
      (html2texi-process-xml-expr `(div nil ,@(cddr xml-expr)))))
    (and
     name
     (progn
       (insert "\n@anchor{")
       (html2texi-insert-locator
	 (concat
	  (file-relative-name
	   (html2texi-current-file html2texi-files-to-do)
	   html2texi-directory-ref)
	  "#" name) :@anchor)
       (insert "}\n")))))

(html2texi-make-simple-markup-handler b)

(defun html2texi-flush-anchors ()
  (while html2texi-flushable-anchors
    (insert "@anchor{")
    (html2texi-insert-locator (pop html2texi-flushable-anchors) :@anchor)
    (insert "}\n")))

(defun html2texi-tag-handler-h1 (xml-expr)
  (insert "@chapter " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))


(defun html2texi-tag-handler-h2 (xml-expr)
  (insert "@section " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))

(defun html2texi-tag-handler-h3 (xml-expr)
  (insert "@subsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
    (html2texi-flush-anchors))

(defun html2texi-tag-handler-h4 (xml-expr)
  (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))

(defun html2texi-tag-handler-h5 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
     (html2texi-flush-anchors))

(defun html2texi-tag-handler-h6 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
   (html2texi-flush-anchors))

(html2texi-make-simple-markup-handler samp)


(defun html2texi-get-col-span (xml-expr)
  ;; xml-expr is <td> or <th>
  (let ((col-span (cdr-safe (assq 'colspan (nth 1 xml-expr)))))
    (setq col-span
	  (cond
	   ((integerp
	       (setq col-span
		     (if (stringp col-span)
			 (string-to-number col-span)
		       col-span)))
	      col-span)
	   ((null col-span) 1)
	   (t (error "colspan invalide"))))  ))

(html2texi-make-simple-markup-handler sub)
(html2texi-make-simple-markup-handler sup)

(html2texi-make-simple-markup-handler tt)

(defvar html2texi-table-fmt-current-ctxt nil)

(defun html2texi-tag-handler-table (xml-expr)
  (let* ((html2texi-table-fmt-current-ctxt (html2texi-table-fmt-ctxt "Table formatting context"))
	 (xml-table-info
	  (vector xml-expr;0: table items
		  nil;1: thead items
		  nil;2: tbody items
		  nil;3: tfoot items
		  0;4: bitmap champ trouvé:
					; 1 = plain table (found a tr item not a thead|tbody|tfoot)
					; 2 = thead found
					; 4 = tbody found
					; 8 = tfoot found
		  0;5: bitmap traité
		  1;6: en cours de traitement
		  ))
	 (xml-items (cddr xml-expr)))

    ;; tout d'abord on analyse la table pour trouver le nombre de colonne
    (while (or xml-items (/= (aref xml-table-info 4)  (aref xml-table-info 5)))
      (if xml-items
	  (let ((xml-expr (pop xml-items)))
	    (cond
	     ((and (consp xml-expr)
		   (eq (car xml-expr) 'tr))
	      (when (= (aref xml-table-info 6) 1)
		;; cas d'une table avec les lignes directement sous <table> ... </table>
		(and (/= (logand (aref xml-table-info 4)
				 14) 0)
		     (html2texi-error "Table avec à la fois des lignes directement sous <table> ... </table>\
 et des lignes sous une balise <X>...</X> avec X dans {thead, tbody, tfoot}" xml-expr))
		(aset xml-table-info 4 (logior (aref xml-table-info 4) 1)))
	      ;; plus besoin de chercher une ligne: on compte les colonnes sur la
	      ;; première ligne trouvée
	      (setq xml-items nil)
	      (dolist  (xml-expr (cddr xml-expr))
		(cond
		 ((consp xml-expr)
		  (if (memq  (car xml-expr) '(th td))
		      (progn
			(oset html2texi-table-fmt-current-ctxt :col-count
			      (+ (oref html2texi-table-fmt-current-ctxt :col-count)
				 (html2texi-get-col-span xml-expr)))
			(when (> (oref html2texi-table-fmt-current-ctxt :col-count)
				 (oref html2texi-table-fmt-current-ctxt :col-info-length))
			  (let ((l (make-list (- (oref html2texi-table-fmt-current-ctxt :col-count)
						 (oref html2texi-table-fmt-current-ctxt :col-info-length))
					      '(abs 1))))
			    (setcdr (oref html2texi-table-fmt-current-ctxt :col-info-last) l)
			    (oset html2texi-table-fmt-current-ctxt :col-info-last (last l))
			    (oset html2texi-table-fmt-current-ctxt :col-info-length
				  (oref html2texi-table-fmt-current-ctxt :col-count)))))
		    (html2texi-error "balise inattendu dans une table" xml-expr)))
		 ((stringp xml-expr)
		  (unless (string-match
			   "\\`\\s-*\\(\n\\s-*\\)*\\'"
			   xml-expr)
		    (html2texi-error "Chaîne inattendue" xml-expr)))
		 (t (html2texi-error "Élément inattendu" xml-expr)))))

	     ;; la table est organisé en thead/tbody/tfoot
	     ((and (consp xml-expr)
		   (memq (car xml-expr) '(thead tbody tfoot)))
	      (let* ((thead 1) (tbody 2) (tfoot 3) (index (symbol-value (car xml-expr))))
		(and (/= (logand (aref xml-table-info 4)
				 (lsh 1 index)) 0)
		     (html2texi-error "Balise `%s' en double dans la table"
				      (aref xml-table-info 0)
				      (symbol-name (car xml-expr))))
		(aset xml-table-info 4 (logior  (aref xml-table-info 4) (lsh 1 index)))
		(aset xml-table-info index xml-expr)))

	     ;; chaîne qui n'est pas un blanc au beau milieu de la table...
	     ((stringp xml-expr)
	      (unless (string-match
		       "\\`\\s-*\\(\n\\s-*\\)*\\'"
		       xml-expr)
		(html2texi-error "Chaîne inattendue" xml-expr)))
	     (t (html2texi-error "Élément inattendu" xml-expr))))
	;; xml-items est nil

	;; on marque le champ courant (c.-à-d. table | thead | tbody | tfoot)
	;; comme ayant été traité
	(aset xml-table-info 5 (logior
				(aref xml-table-info 5)
				(logand
				 (aref xml-table-info 4)
				 (aref xml-table-info 6))))
	;; maintenant on cherche s'il en est un champ restant à parcourir
	(let ((index 0)
	      (to-be-processed (logxor  (aref xml-table-info 4)
					(aref xml-table-info 5))))
	  (while (and (/= to-be-processed 0)
		      (= (logand to-be-processed 1) 0))
	    (setq index (1+ index)
		  to-be-processed (lsh to-be-processed -1)))
	  (when (/= to-be-processed 0)
	    (setq xml-items (cdr-safe (cdr-safe (aref xml-table-info index))))
	    (aset xml-table-info 6 (lsh 1 index))) )))


    ;; maintenant qu'on a fini d'analyser la table, on peut la traiter.
    (if (or (> (oref html2texi-table-fmt-current-ctxt :col-count) 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(progn
	  (insert "@multitable @columnfractions ")
	  (let ((total-weight
		 (math-reduce-vec
		  (lambda (r x)
		    (+ r
		       (cond
			((eq (car x) 'abs) (cadr x))
			((eq (car x) 'rel)
			 (setcar x 'abs)
			 (setcar (cdr x)
				 (* (cadr x)
				    (oref html2texi-table-fmt-current-ctxt :col-info-length))) (cadr x)))))
		  (cons 'vec (oref html2texi-table-fmt-current-ctxt :col-info)))))
	    (insert
	     (mapconcat
	      (lambda (x)
		(number-to-string
		 (/ (float (cadr x)) (oref html2texi-table-fmt-current-ctxt :col-info-length))))
	      (cdr (oref html2texi-table-fmt-current-ctxt :col-info))
	      " ")))
	  (insert "\n"))
      (insert "@table\n"))

    (dotimes (i 4)
      (when (/= 0 (logand (aref xml-table-info 4) (lsh 1 i)))
	(if (/= i 2)
	    (html2texi-process-xml-expr  (aref xml-table-info i))
	  (oset html2texi-table-fmt-current-ctxt :force-head t)
	  (html2texi-process-xml-expr  (aref xml-table-info 2))
	  (oset html2texi-table-fmt-current-ctxt :force-head nil))))

    (if (or (> (oref html2texi-table-fmt-current-ctxt :col-count) 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(insert "@end multitable\n")
      (insert "@end table\n"))))


(defun html2texi-tag-handler-tr (xml-expr)
  (oset html2texi-table-fmt-current-ctxt :col-number 0)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n")
  (oset html2texi-table-fmt-current-ctxt :row-number
	(1+ (oref html2texi-table-fmt-current-ctxt :row-number))))

(defun html2texi-tag-handler-th (xml-expr)
  (if   (= 0 (oref html2texi-table-fmt-current-ctxt :col-number))
      (if (and (= 0 (oref html2texi-table-fmt-current-ctxt :row-number))
	       (null html2texi-handle-two-columns-table-as-@table))
	  (progn
	    (oset html2texi-table-fmt-current-ctxt :head-on-row-0 t)
	    (insert "@headitem ")
	    (html2texi-process-xml-expr xml-expr))
	(insert "@item ")
	(html2texi-process-xml-expr xml-expr))
    (when (or (> (oref html2texi-table-fmt-current-ctxt :col-count) 2)
	      (null html2texi-handle-two-columns-table-as-@table))
      (insert "@tab "))
    (html2texi-process-xml-expr xml-expr)
    (unless (and  (= 0 (oref html2texi-table-fmt-current-ctxt :row-number))
		  (oref html2texi-table-fmt-current-ctxt :head-on-row-0))
	(insert "\n")))
  (oset html2texi-table-fmt-current-ctxt :col-number
	(1+ (oref html2texi-table-fmt-current-ctxt :col-number))))

(defun html2texi-tag-handler-td (xml-expr)
  (if  (oref html2texi-table-fmt-current-ctxt :force-head)
      (html2texi-tag-handler-th xml-expr)
    (if (= 0 (oref html2texi-table-fmt-current-ctxt :col-number))
	(insert "@item ")
      (if (or (> (oref html2texi-table-fmt-current-ctxt :col-count) 2)
	      (null html2texi-handle-two-columns-table-as-@table))
	  (insert "@tab ")))
    (html2texi-process-xml-expr xml-expr)
    (insert "\n")
    (oset html2texi-table-fmt-current-ctxt :col-number
	  (1+ (oref html2texi-table-fmt-current-ctxt :col-number)))))

(defun html2texi-cur-dir ()
  "Détermine le répertoire courant relativement au répertoire du
HTML racine de départ. La valeur retournée se termine par une oblique `/'"
  (let ((cur-dir  (nreverse (split-string (cdar html2texi-directory-stack) "/")))
	(ref-dir  (nreverse (split-string html2texi-directory-ref "/"))))
    (unless (and (string= (car cur-dir) "")
		 (string= (car ref-dir) ""))
      (error "Format invalide de répertoire"))
    (setq cur-dir (nreverse (cdr cur-dir))
	  ref-dir (cdr ref-dir))
    (if (or (string= (car cur-dir) "")
	    (string-match "\\`[a-z]:" (car cur-dir)))
	;; cur-dir est un chemin absolu
	(progn
	  (setq ref-dir (nreverse ref-dir))
	  (while (and cur-dir ref-dir (string= (car cur-dir) (car ref-dir)))
	    (setq cur-dir (cdr cur-dir)
		  ref-dir (cdr ref-dir)))
	  (while ref-dir
	    (push ".." cur-dir)
	    (setq ref-dir (cdr ref-dir)))
	  (concat (mapconcat 'identity cur-dir "/") "/"))
      (while (and cur-dir
		  (cond
		   ((string= (car cur-dir) "..")
		    (unless ref-dir
		      (error "Chemin invalide"))
		    (setq ref-dir (cdr ref-dir)
			  cur-dir (cdr cur-dir)))
		   ((string= (car cur-dir) ".")
		    (setq cur-dir (cdr cur-dir)))
		   (t nil))))
      (dolist (e cur-dir)
	(push e ref-dir))
      (mapconcat 'identity  (nreverse (cons "" ref-dir)) "/") )))

(defun html2texi-anchor-escape (anchor)
  (let (ret)
    (setq anchor
	  (mapconcat
	   'identity
	   (split-string anchor "-") "--"))
    (mapc
     (lambda (x)
       (if
	(or (and (>= x ?a) (<= x ?z))
	     (and (>= x ?A) (<= x ?Z))
	     (and (>= x ?0) (<= x ?9))
	     (member x '(?_ ?- ?/)))
	   (push (string x) ret)
	 (push (format "-%04x" x) ret)))
     anchor)
    (apply 'concat (nreverse ret))))

(defun html2texi-make-anchor (name &optional escape-function)
  (let* ((anchor (expand-file-name (concat (html2texi-cur-dir) name)))
	 (l-a (length anchor))
	 (l-r (length html2texi-directory-ref))
	 (l (min l-a l-r))
	 (start 0)
	 (i -1))
    (while (and
	    (< (setq i (1+ i)) l)
	    (prog1
		(= (aref anchor i) (aref html2texi-directory-ref i))
	      (and (= (aref anchor i) ?/)
		   (setq start (1+ i))))))
    (setq anchor (list (substring anchor start)))
    (dotimes (i (length (split-string (substring html2texi-directory-ref start))))
      (push "../" anchor))
    (setq anchor (apply 'concat anchor))
    (html2texi-string-escape (funcall (or escape-function 'html2texi-anchor-escape) anchor))))

(defun html2texi-insert-locator (name type &optional escape-function)
  (let ((locator (html2texi-make-anchor name  escape-function)))
    (html2texi-add-locator
     html2texi-locator-list
     (make-instance
      'html2texi-locator-info
      :id locator
      :type type
      :position (point)
      :size (length locator)))
    (insert locator)))

(defun html2texi-simple-markup-handle (xml-expr class-alist preamble postamble)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe
			(and class-attribute
			     (assoc-string (cdr class-attribute) class-alist)))
		      (list preamble postamble))))
    (insert (car pre-post))
   (html2texi-process-xml-expr xml-expr)
   (insert (cadr pre-post))))

(defun html2texi-tag-handler-body (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))


(html2texi-make-simple-markup-handler code)

(defun html2texi-tag-handler-br (xml-expr)
  (insert "@*\n"))

(defun html2texi-tag-handler-div (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(html2texi-make-simple-markup-handler dfn)

(defun html2texi-tag-handler-dl (xml-expr)
  (insert "@table @asis\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "@end table\n"))

(defun html2texi-tag-handler-dt (xml-expr)
  (insert "@item ")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(defun html2texi-tag-handler-dd (xml-expr)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(html2texi-make-simple-markup-handler em)

(defun html2texi-tag-handler-frameset (xml-expr)
  (insert "\n@menu\n")
  (html2texi-with-restrictions
   (:frameset)
   (html2texi-process-xml-expr xml-expr))
  (insert "@end menu\n"))

(defun html2texi-tag-handler-frame (xml-expr)
  (unless (html2texi-has-restrictions-p html2texi-convert-restrictions-object :framset)
    (html2texi-error "<frame> hors d'un <frameset> !" xml-expr))
  (let (url text)
    (dolist (x (cadr xml-expr))
      (cond
       ((eq (car x) 'src)
	(setq url (cdr x)))
       ((eq (car x) 'name)
	(setq text (cdr x)))))
    (when url
      (html2texi-process-url url text :@menu-item))))

(defun html2texi-tag-handler-hr (xml-expr)
  (insert "@c <hr/>\n"))

(html2texi-make-simple-markup-handler kbd)

(defun html2texi-tag-handler-html (xml-expr)
  "\
Traitement de la balise html."
  (let* ((attributes (nth 1 xml-expr))
	 (lang (assq 'lang attributes)))
    (when lang
      	(oset html2texi-document-information-object :language (cdr lang))))
    (html2texi-process-xml-expr xml-expr))

(html2texi-make-simple-markup-handler strong)

(defun html2texi-handle-string (str)
  (let (ret (pos0 0) pos1 (len (length str)))
    (while (and
	    (< pos0 len)
	    (setq pos1 (string-match "[{}@]" str pos0)))
      (push (substring str pos0 pos1) ret)
      (push (concat "@" (match-string-no-properties 0 str)) ret)
      (setq pos0 (1+ pos1)))
    (when (< pos0 len)
      (push (substring str pos0 pos1) ret))
    (apply 'concat (nreverse ret))))

(defun html2texi-generate-or-reuse-log-buffer ()
  (if (buffer-live-p html2texi-reusable-log-buffer)
	(with-current-buffer html2texi-reusable-log-buffer
	 (let ((inhibit-read-only t))
	   (erase-buffer)
	   html2texi-reusable-log-buffer))
    (setq html2texi-reusable-log-buffer
	  (let* ((compilation-error-regexp-alist
		  '(html-to-texinfo-error
		    html-to-texinfo-warning
		    html-to-texinfo-info))
		 (b (generate-new-buffer html2texi-log-buffer-name)))
	    (with-current-buffer b
	      (compilation-mode)
	      b)))))

(defun html2texi-fatal-error (format-str xml-expr &rest args)
  (html2texi-with-log
   (insert (aref html2texi-log-error-names 0) ":"
	   (html2texi-current-file html2texi-files-to-do) ":"
	   (if (eq xml-expr :html2texi-generic-error)
	       ""
	     (format "%d:" (+ line-number html2texi-line-delta)))
	   (apply
	    'format
	    (concat format-str
		    "\n"
		    (aref html2texi-log-error-names 3)
		    ": <<<-----------\n"
		    (aref html2texi-log-error-names 3)
		    ": xml-expr=%S\n"
		    (aref html2texi-log-error-names 3)
		    ": xml-stack=%S\nInfo: ----------->>>\n")
	    `( ,@args ,xml-expr ,html2texi-xml-stack)) ?\n))
  (apply 'error format-str args))

(defmacro html2texi-with-log (&rest body)
  `(progn
     (setq html2texi-log-buffer (html2texi-generate-or-reuse-log-buffer))
     (display-buffer html2texi-log-buffer)
     (let ((line-number (line-number-at-pos)))
       (with-current-buffer html2texi-log-buffer
	 (let ((inhibit-read-only t))
	   ,@body)))))


(defun html2texi-error (format-str xml-expr &rest args)
  (html2texi-with-log
   (insert (aref html2texi-log-error-names 1) ":"
	   (html2texi-current-file html2texi-files-to-do) ":"
	   (if (eq xml-expr :html2texi-generic-error)
	       ""
	     (format "%d:" (+ line-number html2texi-line-delta)))
	   " "
	   (apply 'format format-str args) ?\n)))

(defun html2texi-warning (format-str xml-expr &rest args)
  (html2texi-with-log
   (insert (aref html2texi-log-error-names 2) ":"
	   (html2texi-current-file html2texi-files-to-do)":"
	   (if (eq xml-expr :html2texi-generic-error)
	       ""
	     (format "%d:" (+  line-number html2texi-line-delta)))
	   (apply 'format format-str args) ?\n)))

(defun html2texi-info (format-str xml-expr &rest args)
  (html2texi-with-log
   (insert (aref html2texi-log-error-names 3) ":"
	   (html2texi-current-file html2texi-files-to-do)":"
	   (if (eq xml-expr :html2texi-generic-error)
	       ""
	     (format "%d:" (+  line-number html2texi-line-delta)))
	   (apply 'format format-str args) ?\n)))

(defun html2texi-decode-url (url)
  "Décode les `%20' et autres séquences hexadécimale"
  (with-temp-buffer
    (insert url)
    (goto-char (point-min))
    (while (re-search-forward "%\\([[:xdigit:]]\\{2\\}\\)" nil t)
      (replace-match (string (math-read-radix
			       (match-string-no-properties 1) 16)) t t))
    (when (eq html2texi-url-encoding :html2texi-utf-8)
      (accents-de-utf-8))
    (buffer-substring (point-min) (point-max))))

(defun html2texi-process-url (url xml-expr &optional type)
  (when (html2texi-has-restrictions-p html2texi-convert-restrictions-object :ref)
    (html2texi-error "Référence recursive" xml-expr))

  (html2texi-with-restrictions
   (:ref)

   (let* ((parsed-url (url-generic-parse-url (html2texi-decode-url url)))
	  (delimiters (case type
			((:@menu-item)  ["* " ":: " ".\n"])
			(t  ["@ref{" "," "}"])))
	  url-list
	  i
	  absolute-file-name
	  locator
	  relative-file-name
	  qualified-locator)
     ;; petit hack parce que url-generic-parse-url ne fait pas complètement le
     ;; boulot
     (when (and
	    (null  (aref parsed-url 1))
	    (setq i (string-match "#" (aref parsed-url 6)))
	    (null (aref parsed-url 7)))
       (aset parsed-url 7 (substring (aref parsed-url 6) (1+ i)))
       (aset parsed-url 6 (substring (aref parsed-url 6) 0 i)))

     ;; Analyse des nom de fichiers
     (setq absolute-file-name
	   (expand-file-name (aref parsed-url 6)
			     (file-name-directory (html2texi-current-file html2texi-files-to-do)))
	   relative-file-name (file-relative-name absolute-file-name html2texi-directory-ref))

     (push "@uref{" url-list) ; ça peut être défait ensuite
     ;; URL
     (if (and (eq (aref parsed-url 0)
		  'cl-struct-url)
	      (null (aref parsed-url 1)))
	 ;; cas où il n'y a pas de protocole
	 (cond
	  ;; on pointe vers un fichier HTML, ce n'est donc pas forcément une URL interne
	  ;; => cas suspect
	  ((member (file-name-extension absolute-file-name)
		   '("html" "htm"))
	   (html2texi-add-file-to-do html2texi-files-to-do absolute-file-name)
	   (setq locator (aref parsed-url 7)
		 qualified-locator (if locator (concat relative-file-name "#" locator) relative-file-name))

	   (if (and (file-exists-p absolute-file-name)
		    (null (file-name-absolute-p relative-file-name)))
	       (setq
		url-list (list
			  (setq qualified-locator (html2texi-make-anchor qualified-locator))
			  (aref delimiters 0)))
	     (push (html2texi-string-escape qualified-locator) url-list)))

	  ;; cas d'une URL interne
	  ((and (string= "" (aref parsed-url 6))
		(setq locator (aref parsed-url 7)))
	   (setq qualified-locator
		 (concat
		  (file-relative-name
		   (html2texi-current-file html2texi-files-to-do)
		   html2texi-directory-ref)
		  "#" locator)
		 url-list
		 (list
		  (setq qualified-locator (html2texi-make-anchor qualified-locator))
		  (aref delimiters 0))))

	  ;; cas d'une URL dont on est sûr quelle est externe.
	  (t
	   (push (setq qualified-locator (html2texi-string-escape url)) url-list)))
       (push  (setq qualified-locator (html2texi-string-escape url)) url-list))
     ;; Text
     (when xml-expr
       (push (aref delimiters 1) url-list)
       (push xml-expr url-list))
     (push (aref delimiters 2) url-list)
     (dolist (v (nreverse url-list))
       (when (eq qualified-locator v)
	 (html2texi-add-locator
	  html2texi-locator-list
	  (make-instance
	   'html2texi-locator-info
	   :id qualified-locator
	   :type type
	   :position (point)
	   :size (length qualified-locator))))
       (cond
	((stringp v) (insert v))
	((consp v) (html2texi-process-xml-expr v))) ))))

(defun html2texi-tag-handler-center (xml-expr)
  (let ((start-point (point))
	(start-ln (line-number-at-pos))
	end-mark)
    (html2texi-process-xml-expr xml-expr)
    (when (and (<= (point) (+ start-point html2texi-@center-max-size))
	       (> (point) start-point)
	       ;; test histoire que le code soit à l'épreuve du temps : il se
	       ;; pourrait qu'on soit déjà centré pour une autre raison.
	       (null (save-excursion
		       (goto-char start-point)
		       (looking-at "\\(\n\\|\\s-\\)*@center\\>")))
	       (let (to-do
		     (ok t)
		     xml-expr
		     (l (cdr-safe (cdr-safe xml-expr))))
		 (while (and ok (or to-do l))
		   (if l
		       (progn
			 (setq xml-expr (pop l))
			 (cond
			  ((stringp xml-expr))
			  ((and (consp xml-expr)
				(memq (car xml-expr) html2texi-allowed-markup-in-@center))
			   (push xml-expr to-do))
			  (t (setq ok nil))))
		     (setq l (cdr-safe (cdr-safe (pop to-do))))))
		 (when ok
		   (setq end-mark (point-marker))
		   (goto-char start-point)
		   (insert "\n@center ")
		   (while (search-forward "\n" end-mark t)
		     (delete-char -1)
		     (insert 32))
		   (goto-char end-mark)
		   (set-marker end-mark nil)))))))

(html2texi-make-simple-markup-handler i)

(defun html2texi-tag-handler-li (xml-expr)
  (insert "\n@item\n")
  (unless (memq (caadr html2texi-xml-stack) '(ol ul))
    (html2texi-fatal-error "<li> était inattendu." xml-expr ))
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-link (xml-expr)
  )

(defun html2texi-tag-handler-ol (xml-expr)
  (insert "\n@enumerate")
   (html2texi-process-xml-expr xml-expr)
  (insert "\n@end enumerate\n"))

(defun html2texi-tag-handler-p (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(defun html2texi-tag-handler-tbody (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-thead (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-tfoot (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-ul (xml-expr)
  (insert "\n@itemize")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n@end itemize\n"))

(defun html2texi-tag-handler-span (xml-expr)
  (insert "@c span: (<span #1>#2</span> => #2.")
  (html2texi-default-handling xml-expr "span: ")
  (html2texi-process-xml-expr xml-expr)
  (insert "@c span: )\n"))

(defun html2texi-tag-handler-style (xml-expr)
  )

(defun html2texi-tag-handler-meta (xml-expr)
  (unless (and (nth 1 html2texi-xml-stack)
	       (eq (caadr html2texi-xml-stack) 'head))
    (html2texi-fatal-error "<meta> inattendu." xml-expr))
  ;; traitement du meta...
  (let* ((attribute-list (nth 1 xml-expr))
	 (http-equiv (assq 'http-equiv attribute-list))
	 (name (assq 'name attribute-list))
	 (content (assq 'content attribute-list)))
    (cond
     ((and (consp name)
	   (consp content)
	   (progn
	     (setq name (cdr name)
		   content (cdr content))
	     (stringp name))
	   (stringp content))
      (cond
       ((string= name "author")
	(oset html2texi-document-information-object :author content))
       ((string= name "language")
	(when (string-match "\\`\\([a-z]\\{2\\}\\(-[A-Z]\\{2\\}\\)?\\)\\'" content)
	  (let ((language (match-string-no-properties 1 content)))
	    (when (= (length language) 5)
	      (aset language 2 ?_))
	    (oset html2texi-document-information-object :language language))))))
     ((and (consp http-equiv)
	   (consp content)
	   (progn (setq http-equiv (cdr http-equiv))
		  (stringp http-equiv))
	   (progn (setq content (cdr content))
		  (stringp content)))
      (setq http-equiv (downcase http-equiv))
      (cond
       ((and (string= http-equiv "content-type")
	     (string-match "charset\\s-*=\\s-*\\([-a-z0-9]+\\)" content))
	(oset html2texi-document-information-object
	      :encoding
	      (match-string-no-properties 1 content)));
       )))))

(defun html2texi-tag-handler-pre (xml-expr)
  (let ((kes html2texi-keep-empty-strings))
    (setq html2texi-keep-empty-strings t)
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-keep-empty-strings kes)))

(defun hmtl2texi-to-plain-text (xml-expr &rest flags)
  (let (ret anchor)
    (dolist (xml-expr (cddr xml-expr))
      (cond
       ((stringp xml-expr)
	(push xml-expr ret))
       ((consp xml-expr)
	(push xml-expr html2texi-xml-stack)
	(cond
	 ((and (eq (car xml-expr) 'a)
	       (setq anchor (assq 'name (nth 1 xml-expr))))
	  (push (concat
		 (file-relative-name
		  (html2texi-current-file html2texi-files-to-do)
		   html2texi-directory-ref)
		 "#" (cdr anchor))
		html2texi-flushable-anchors) ))
	(let ((str  (hmtl2texi-to-plain-text xml-expr)))
	  (and (null (string= str ""))
	       (push str ret)))
	(pop html2texi-xml-stack))
       (t (html2texi-fatal-error "Expression XML inattendue." xml-expr))))
    (setq  ret (mapconcat 'identity (nreverse ret) " "))
    (if (memq :one-line flags)
	(mapconcat 'identity (split-string ret "\n") " ")
      ret)))


(defun html2texi-tag-handler-title (xml-expr)
  (unless (and  (nth 1 html2texi-xml-stack)
		(eq  (caadr html2texi-xml-stack) 'head))
    (html2texi-fatal-error "<title> inattendu." xml-expr))
  (setq xml-expr (cddr xml-expr))
  (let ((str  (hmtl2texi-to-plain-text xml-expr)))
    (setq str (split-string str "\n")
	  str (mapconcat 'identity str " "))
    (unless (string= str "")
      (oset html2texi-document-information-object :title str))))

(defun html2texi-string-escape (str &optional flatten)
  (cond
   ((stringp str)
    (with-temp-buffer
      (insert str)
      (goto-char (point-min))
      (while (re-search-forward "[,@{}]" nil t)
	(cond
	 ((string= (match-string-no-properties 0) ",")
	  (replace-match "@comma{}"))
	 ((member (match-string-no-properties 0) '("@" "{" "}"))
	  (replace-match (concat "@" (match-string-no-properties 0))))))
      (when flatten
	(goto-char (point-min))
	(while (re-search-forward "\n\\(\\s-*\\)" nil t)
	  (replace-match (if (> 0 (length (match-string 1))) " " "") t t)))
      (buffer-substring (point-min) (point-max))))
   ((and (consp str) (car-safe str))
    (cond
     ((eq (car str) 'span)
      (with-temp-buffer
	(insert "@c span: (<span #1>#2</span> => string-escape of #2.")
	(html2texi-default-handling str "span: ")
	(insert (html2texi-string-escape  (nth 2 str) flatten))
	(insert "@c span: )\n")
	(buffer-substring (point-min) (point-max))))
     (t (html2texi-fatal-error "Une chaîne était attendue" :html2texi-generic-error str))))
   (t  (html2texi-fatal-error "Une chaîne était attendue" :html2texi-generic-error str))))

(defun html2texi-tag-handler-img (xml-expr)
  (let (filename width height alttext extension)
    (dolist (x (cadr xml-expr))
      (cond
       ((eq (car x) 'src)
	(setq filename (cdr x)))
       ((eq (car x) 'alt)
	(setq alttext (cdr x)))))
    (unless filename
      (html2texi-fatal-error "src=... était attendu" xml-expr))
    (setq filename (html2texi-decode-url filename))
    (setq extension (file-name-extension filename)
	  filename (file-name-sans-extension filename))
    (when (member extension '("png" "jpg" "jpeg" "eps" "txt"))
      (setq extension nil))
    (insert "@image{" (html2texi-make-anchor filename (symbol-function 'identity)))
    (let ((remainder (list width height alttext extension)))
	(while remainder
	  (if (let (non-empty)
		(mapc (lambda (x) (setq non-empty (or non-empty (stringp x))))
		      remainder)
		non-empty)
	      (insert "," (or (pop remainder) "") )
	    (setq remainder nil); rompt la boucle (while remainder...)
	    ))
	(insert "}"))))

(defun html2texi-tag-handler-head (xml-expr)
  (unless html2texi-ignore-head
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-ignore-head t)))

(defun html2texi-tag-handler-noframes (xml-expr)
  )

(if (boundp 'html2texi-handler-hash-table)
    (makunbound 'html2texi-handler-hash-table))

(defconst html2texi-handler-hash-table
  (let ((ht (make-hash-table)))
    (dolist (v '(a b body center code dfn dl dt dd em i kbd li p
    hr div ol ul pre head meta title frameset frame noframes span
    strong table tbody thead tfoot th tr td h1 h2 h3 h4 h5 h5
    html link br img samp style sup sub tt))
      (puthash v (symbol-function (intern (concat "html2texi-tag-handler-" (symbol-name v))))
	       ht))
    ht)
  "Table de hashage des traitements associés à chaque balise HTML"
  )

(defun html2texi-remove-empty-strings (xml-expr)
  (setq xml-expr (cdr xml-expr))
  (save-match-data
  (while (cdr xml-expr)
    (if (and (stringp (cadr xml-expr))
	     (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'" (cadr xml-expr)))
	(setcdr xml-expr (cddr xml-expr))
      (setq xml-expr (cdr xml-expr))))))

(defun html2texi-process-xml-expr (xml-expr)
  (push xml-expr html2texi-xml-stack)
  (dolist (xml-expr (cddr xml-expr))
    (cond
     ((consp xml-expr)
      (push xml-expr html2texi-xml-stack)
      (let ((handler (gethash (intern (downcase (symbol-name (car xml-expr))))
			      html2texi-handler-hash-table)))
	(if handler
	    (funcall handler  xml-expr)
	  (html2texi-default-handling xml-expr)))
      (pop html2texi-xml-stack))
     ((stringp xml-expr)
      (and (or html2texi-keep-empty-strings
	       (null (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'"  xml-expr)))
	   (insert (html2texi-handle-string xml-expr))))
     (t (html2texi-fatal-error "Expression XML inattendue %S" xml-expr))))
  (pop html2texi-xml-stack))

(defun html2texi-default-handling (xml-expr &optional prompt)
  (let ((str (split-string (prin1-to-string xml-expr) "\n")))
    (dolist (str-line str)
      (insert "\n@c " (or prompt "") str-line)))
    (insert "\n"))

(defun html2texi-process-region (beg end)
  (goto-char end)
  (let ((end (point-marker))
	is-xhtml
	re-do
	xml-expr)

    ;; Suppression de tout ce qui est en dehors des balise <html> ... </html>
    (goto-char beg)
    (setq html2texi-line-delta (line-number-at-pos))
    (setq is-xhtml
	  (looking-at "[ \t\n\r]*<!DOCTYPE[ \t\n\r]+html[ \t\n\r]+PUBLIC[ \t\n\r]+\"-//W3C//DTD XHTML"))
    (unless (re-search-forward "<html" end t)
      (html2texi-fatal-error "Balise <html> non trouvée" xml-expr))
    (setq html2texi-line-delta (- (line-number-at-pos) (* 2 html2texi-line-delta)))
    (delete-region beg (match-beginning 0))
    (unless (re-search-forward ">" end t)
      (html2texi-fatal-error "Clôture de la balise <html> trouvée" xml-expr))
    (unless  (re-search-forward "</html" end t)
      (html2texi-fatal-error "Balise </html> non trouvée trouvée" xml-expr))
    (unless (re-search-forward ">" end t)
      (html2texi-fatal-error "Clôture de la balise </html> trouvée" xml-expr))
    (delete-region (match-end 0) end)

    (or is-xhtml
	(html2texi-make-html-clean-xml beg end))

    (setq xml-expr
	  (condition-case
	      sig
	      (xml-parse-region beg end)
	    (error
	     (if (consp sig)
		 (html2texi-warning "File is XHTML but xml-parser reported error `%S'"
				 :html2texi-generic-error
				 (cdr sig))
	       (html2texi-warning "File is XHTML but xml-parser reported errors"
				  :html2texi-generic-error))
		  (if is-xhtml :html2texi-redo nil)))
	  xml-expr
	  (if (eq xml-expr :html2texi-redo)
	       (progn
		 (html2texi-make-html-clean-xml beg end)
		 (xml-parse-region beg end))
	     xml-expr))

    (delete-region beg end)
    (set-marker end nil)
    xml-expr))

(if t
;; plus partique pour déboguer qu'un vrai tampon temporaire
    (defmacro html2texi-with-temp-buffer (&rest body)
      (let ((cur-buff (make-symbol "cur-buff")))
	`(with-current-buffer
	       (let (( ,cur-buff (get-buffer "*HTML2TEXI Temp*")))
		 (and ,cur-buff (kill-buffer ,cur-buff))
		 (get-buffer-create "*HTML2TEXI Temp*"))
       (erase-buffer)
       ,@body)))
  ;;
  (defmacro html2texi-with-temp-buffer (&rest body)
    `(with-temp-buffer ,@body)))

(defun html2texi-make-texi-buffer (&optional buffer )
  (let* ((start-buffer (or buffer (current-buffer)))
	 xml-expr
	 (start-filename  (or (buffer-file-name start-buffer) (buffer-name)))
	 (start-filename-ext (file-name-extension start-filename))
	 done-links-list
	 texi-buffer)
    (setq html2texi-texi-buffer-name
	  (concat (concat  (file-name-sans-extension   (file-name-nondirectory start-filename))
			   ".texi")))

    (unless (or (member start-filename-ext '("html" "htm"))
		(y-or-n-p (format "le tampon %s n'a pas une extension html, continuer?"
				  start-filename)))
      (html2texi-fatal-error "Fichier `%s' sans extension html" :html2texi-generic-error start-filename))
    (setq texi-buffer (get-buffer-create html2texi-texi-buffer-name))
    (set-buffer texi-buffer)
    (erase-buffer)
    (dolist (v html2texi-texi-buffer-local-variables)
      (set (make-local-variable v) nil))
    (push (cons default-directory "./") html2texi-directory-stack)
    (setq html2texi-directory-ref default-directory)
    (html2texi-add-file-to-do html2texi-files-to-do start-filename)
    (while (html2texi-files-has-to-do html2texi-files-to-do)
      (let ((file-name (html2texi-get-next-file-next-to-do html2texi-files-to-do)))
	(if (file-exists-p file-name)
	    (progn
	      (let* ((dir (file-name-as-directory
			   (file-name-directory file-name)))
		     (rel-file-name (file-relative-name file-name html2texi-directory-ref))
		     (rel-dir   (let ((d (file-name-directory rel-file-name )))
				  (if d (file-name-as-directory d)
				    "./"))))
		(push (cons dir rel-dir) html2texi-directory-stack)
		(if (= (oref html2texi-files-to-do :added-file-count) 1)
		    (progn
		      (insert "@anchor{")
		      (html2texi-insert-locator rel-file-name :@anchor)
		      (insert "}\n"))
		  (insert "\n@node ")
		  (html2texi-insert-locator rel-file-name :@node)
		  (insert "\n"))
		(html2texi-with-temp-buffer
		 (insert-file-contents file-name)
		 (accents-de-html)
		 (html2texi-make-html-clean-xml (point-min) (point-max))
		 (setq xml-expr (html2texi-process-region (point-min) (point-max))))
		(unless (eq 'html (caar xml-expr))
		  (html2texi-fatal-error "Résultat d'analyse XML inattendu" xml-expr))
		(setq xml-expr (car xml-expr))
		(html2texi-process-xml-expr xml-expr)
		(pop html2texi-directory-stack)	))
	  (html2texi-warning "Le fichier `%s' n'existe pas!" :html2texi-generic-error file-name))))))

(defun html2texi-insert-doc-info ()
  (let ((author
	 (html2texi-string-escape
	  (if (slot-boundp html2texi-document-information-object :author)
	      (oref  html2texi-document-information-object :author)
	    "AUTHOR")))
	(title 	 (html2texi-string-escape
		  (if (slot-boundp html2texi-document-information-object :title)
		      (oref  html2texi-document-information-object :title)
		    "TITLE")))
	(language (if (slot-boundp html2texi-document-information-object :language)
		       (cons "" (html2texi-string-escape (oref html2texi-document-information-object
							       :language)))
		    (cons "@c " "LANGUAGE")))
	(encoding  (html2texi-string-escape
		  (if (slot-boundp html2texi-document-information-object :encoding)
		      (oref  html2texi-document-information-object :encoding)
		    "iso-8859-1"))))

    (goto-char (point-min))
    (insert "\\input texinfo   @c -*-mode:texinfo; coding:" (downcase encoding) "-*-
@setfilename " (file-name-sans-extension (buffer-name)) ".info
" (car language) "@documentlanguage " (cdr language) "
@documentencoding "  (if (let ((case-fold-search t))
			   (string-match "\\`\\(us\\|utf\\|iso\\)" encoding))
			 (upcase encoding) encoding) "
@copying
This manual is for PROGRAM, version VERSION.

Copyright @copyright{} YEARS COPYRIGHT-OWNER.

@quotation
Permission is granted to ...
@end quotation
@end copying

@titlepage
@title " title "@c NAME-OF-MANUAL-WHEN-PRINTED
@c @subtitle SUBTITLE-IF-ANY
@c @subtitle SECOND-SUBTITLE
@author " author "

@c  The following two commands
@c  start the copyright page.
@page
@vskip 0pt plus 1filll
@insertcopying

Published by ...
@end titlepage

@c So the toc is printed at the start.
@contents

@ifnottex
@node Top
@top TITLE

This manual is for PROGRAM, version VERSION.
@end ifnottex
")
    (oset html2texi-document-information-object :header-size (- (point) (point-min)))
    (goto-char (point-max))
    (insert "
@bye") ))

(defun html2texi-beautify-locator (locator)
  (with-temp-buffer
    (insert locator)
    (goto-char (point-min))
    (when (re-search-forward "-002ehtml?\\(-0023\\)?" nil t)
      (if
	  (match-string 1)
	  (replace-match "_" t t)
	(replace-match "" t t)))
    (goto-char (point-min))
    (while (re-search-forward "-[[:xdigit:]]\\{4\\}" nil t)
      (replace-match "-" t t))
    (buffer-substring (point-min) (point-max))))

(defun html2texi-post-process ()
  "Embellit les identificateur de localisation selon
`html2texi-beautify-locators'. Puis pemplace les double lignes
vides en ligne vides simples."
  ;; embellissement des indentificateurs de localisateur
  (when html2texi-beautify-locators
    (html2texi-info "Embellissement des localisateurs..." :html2texi-generic-error )
    (let ((offset (oref html2texi-document-information-object :header-size)))
      (doli2->-dolist (v html2texi-locator-list)
		      (oset v :position (+ offset (oref v :position)))))
    (let ((dummy-tail (html2texi-locator-info "Factice"))
	  key-val-pairs
	  (table (oref html2texi-locator-list :hash-table)))
      (doli2-add-last html2texi-locator-list dummy-tail)
      (maphash
       #'(lambda (key val)
	   (push (cons key val) key-val-pairs))
       table)
      (dolist (key-val key-val-pairs)
	(let* ((key (car key-val))
	      (val (cdr key-val))
	      (beautiful-key (html2texi-beautify-locator key))
	      delta-pos-inc delta-pos locator-list
	      (key-length (length key))
	      cur next)
	  (if (string= beautiful-key key)
	      (puthash key nil table)
	    (setq delta-pos-inc (- (length beautiful-key) key-length)
		  delta-pos 0
		  locator-list (reverse (cons dummy-tail val))
		       next (pop locator-list))
	    (save-excursion
	      (while (null (eq next dummy-tail))
		(setq cur next
		      next (pop locator-list))
		(goto-char (+ (oref cur :position) delta-pos))
		(let* ((from (point))
		       (to (+ from key-length)))
		  (unless (string= (buffer-substring-no-properties from to) key)
		    (html2texi-fatal-error "Tampon corrompu: trouvé `%s' et attendait `%s'"
					   :html2texi-generic-error
					   (buffer-substring-no-properties from to)
					   key))
		  (delete-region from to))
		(insert beautiful-key)
		(setq delta-pos (+ delta-pos delta-pos-inc))
		(doli2-x>x-dolist
		 (v cur next)
		 (oset v :position (+ (oref v :position) delta-pos)))
		(doli2-remove html2texi-locator-list cur)))
	    (remhash key table)
	    (puthash beautiful-key t table))))
      (doli2-remove-last  html2texi-locator-list)))

  ;; suppression des doubles lignes en trop
  (goto-char (point-min))
  (while (re-search-forward "\\(^[ \t]*\n\\)\\{2,\\}" nil t)
    (replace-match "\n"))
  (normal-mode))

(defun html2texi-save-texi-buffer-maybe ()
  "Sauvegarde le tampon avec le fichier Texinfo."
  (if
      (buffer-file-name) ; le tampon visite déjà un fichier
      (basic-save-buffer)
   (write-file (buffer-name) html2texi-save-texi-buffer-confirm-p)))

;;;###autoload
(defun html2texi ()
  (interactive)
  (let (html2texi-keep-empty-strings
	html2texi-xml-stack
	html2texi-texi-buffer-name
	(html2texi-line-delta 0)
	html2texi-ignore-head
	html2texi-directory-stack
	html2texi-flushable-anchors
	html2texi-directory-ref
	(html2texi-locator-list (html2texi-locator-listing "À embellir"))
	(html2texi-files-to-do (html2texi-files-to-do-listing "À traiter"))
	(html2texi-document-information-object (html2texi-document-information "Info doc"))
	(html2texi-log-buffer (and html2texi-reuse-log-buffer html2texi-log-buffer))
	(html2texi-convert-restrictions-object (html2texi-convert-restrictions "Restrictions de conversion")))
  (html2texi-make-texi-buffer)
  (html2texi-insert-doc-info)
  (html2texi-post-process)
  (html2texi-info "Fin de la conversion en HTML !" :html2texi-generic-error )
  (html2texi-save-texi-buffer-maybe)))

;; Log compilation mode stuff
(defun html2texi-define-error-regexps ()
  (dolist (v `(
	       (html-to-texinfo-error
		.
		(
		 ,(concat "^" (regexp-opt (list (aref html2texi-log-error-names 0)
						(aref html2texi-log-error-names 1)))
			  ":\\(" html2texi-filepath-re
			  "\\):\\(?:\\([0-9]+\\):\\)?.*$")
		 1; File
		 2; Line
		 0; Error
		 ))
	       (html-to-texinfo-warning
		.
		(
		 ,(concat "^" (aref html2texi-log-error-names 2)
			  ":\\(" html2texi-filepath-re
			  "\\):\\(?:\\([0-9]+\\):\\)?.*$")
		 1; File
		 2; Line
		 1; Warning
		 ))
	       (html-to-texinfo-info
		.
		(
		 ,(concat "^" (aref html2texi-log-error-names 3)
			  ":")
		 nil; File
		 nil; Line
		 2; Warning
		 ))))
    (add-to-list 'compilation-error-regexp-alist (car v))
    (let ((cell (or (assq (car v) compilation-error-regexp-alist-alist)
		    (car (push (cons  (car v) nil) compilation-error-regexp-alist-alist)))))
      (setcdr cell (cdr v))  )))
(html2texi-define-error-regexps)

;;; html-to-texinfo.el ends here

Revision-number: 29
Prop-content-length: 240
Content-length: 240

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2012-05-08T08:05:54.000000Z
K 7
svn:log
V 137
- Ajout gestion espace insécable par le conversiteur Texinfo.
- Correction bug et typo dans docstring converstisseur -> convertisseur

PROPS-END

Node-path: trunk/lisp/accents-ascii.el
Node-kind: file
Node-action: change
Text-content-length: 26608
Text-content-md5: c4f5d561f6bf64083cddbb9a134a7787
Content-length: 26608

;; -*- coding: utf-8 -*-
;; Copyright 2008/2012 Vincent Belaïche

;; Author: Vincent Belaïche <vincent.b.1@hotmail.fr>
;; Version: $Id: accents-ascii.el,v 1.5 2012-05-08 08:05:54 Vincent Exp $
;; Keywords:
;; X-URL: not distributed yet

;;
;; This software is governed by the CeCILL license under French law and
;; abiding by the rules of distribution of free software.  You can  use,
;; modify and/ or redistribute the software under the terms of the CeCILL
;; license as circulated by CEA, CNRS and INRIA at the following URL
;; "http://www.cecill.info".
;;
;; As a counterpart to the access to the source code and  rights to copy,
;; modify and redistribute granted by the license, users are provided only
;; with a limited warranty  and the software's author,  the holder of the
;; economic rights,  and the successive licensors  have only  limited
;; liability.
;;
;; In this respect, the user's attention is drawn to the risks associated
;; with loading,  using,  modifying and/or developing or reproducing the
;; software by the user in light of its specific status of free software,
;; that may mean  that it is complicated to manipulate,  and  that  also
;; therefore means  that it is reserved for developers  and  experienced
;; professionals having in-depth computer knowledge. Users are therefore
;; encouraged to load and test the software's suitability as regards their
;; requirements in conditions enabling the security of their systems and/or
;; data to be ensured and,  more generally, to use and operate it in the
;; same conditions as regards security.
;;
;; The fact that you are presently reading this means that you have had
;; knowledge of the CeCILL license and that you accept its terms.
;;
;;; Commentary:

;; accents-tex : change les caractères accentués en accents tex
;; conserve les majuscules, sans demander confirmation.
;;
;; accents-de-tex : change les accents tex en caracteres accentués sans
;; demander confirmation.  les majuscules sont respectees.
;;

(require 'eieio)

(dolist (v '(accents-convertisseur-cache
	     accents-convertisseur-le-cache
	     accents-convertisseur-base
	     accents-convertisseur-simple
	     accents-convertisseur-inverse
	     accents-convertisseur-html
	     accents-convertisseur-de-html))
  (makunbound v))

(defclass accents-convertisseur-cache ()
  ((table-de-hashage
    :initarg :table-de-hashage)
   (expression-rationnelle
    :initarg :expression-rationnelle
    :documentation "Expression rationnelle s'accordant aux
    lettres accentuées à remplacer.")
   (id-convertisseur
    :initarg :id-convertisseur
    :initform nil
    :type symbol)
   (lecteur-clef
    :initarg :lecteur-clef
    :initform nil))
  "C'est la classe qui fait le boulot effectif de remplacement.")

(defvar accents-convertisseur-le-cache
  (make-instance 'accents-convertisseur-cache
		 :table-de-hashage (make-hash-table :test 'equal)))

(defmethod accents-conversion
  ((this accents-convertisseur-cache) &optional beg end)
  (let (cleanup)
    (save-excursion
      (goto-char (or beg (point-min)))
      (setq end (if (integerp end)
		    (let ((m (make-marker)))
		      (setq cleanup t)
		      (set-marker m end)
		      m)
		  end))
      (save-match-data
	(let ((case-fold-search nil)
	      (table-de-hashage (oref this :table-de-hashage))
	      (expression-rationnelle (oref this :expression-rationnelle))
	      (lecteur-clef (or (oref this :lecteur-clef)
				(function (lambda () (match-string-no-properties 0))))))

	  (while (re-search-forward expression-rationnelle end t)
	    (let ((replacement
		   (gethash  (funcall lecteur-clef)
			     table-de-hashage)))
	      (and replacement
		   (replace-match replacement t t)))))))
    (when cleanup
      (set-marker end nil))))

(defclass accents-convertisseur-base ()
  ((cache
    :allocation :class
    :documentation "État en cache du convertisseur"))
  "Classe de base pour un convertisseur"  )
(oset-default accents-convertisseur-base cache
	      accents-convertisseur-le-cache)

(defclass accents-convertisseur-simple
  (accents-convertisseur-base)
  ((id
    :initarg :id
    :documentation "Symbole d'itentification unique pour le
    cache.")
   (liste-de-remplacement
    :initarg :liste-de-remplacement
    :documentation "Liste d'association") )
  "")

(defmacro accents-definir-conversion
  (CLASS CAR CDR &optional LECTEUR-CLEF)
  `(defmethod accents-conversion
     ((this ,CLASS) &optional beg end)

     (let ((cache (oref this cache))
	   (id (oref this :id)))
       (unless (eq (oref cache :id-convertisseur)
		   id)
	 (oset cache :id-convertisseur ,LECTEUR-CLEF)
	 (oset cache :lecteur-clef nil)
	 (let ((table-de-hashage (oref cache :table-de-hashage))
	       (liste-de-remplacement (oref this :liste-de-remplacement)))
	   (clrhash table-de-hashage)
	   (dolist (k liste-de-remplacement)
	     (puthash (,CAR k) (,CDR k) table-de-hashage))
	   (oset cache :expression-rationnelle
		 (regexp-opt (mapcar (quote ,CAR) liste-de-remplacement)))))
       (accents-conversion cache beg end))))

(accents-definir-conversion accents-convertisseur-simple car cdr)

(defclass accents-convertisseur-inverse
  (accents-convertisseur-simple)
  ()
  "Convertisseur pour effectuer la conversion inverse vis-à-vis
  de la liste de remplacement.")

(accents-definir-conversion accents-convertisseur-inverse cdr car)

(defun accents-moteur (liste-des-remplacements &optional convert-to-re)
  (save-excursion
	(save-match-data
	  (let ((case-fold-search nil)
		(re (if convert-to-re
			(mapconcat 'identity
				   (mapcar 'car liste-des-remplacements)
				   "\\|")
		      (regexp-opt  (mapcar 'car liste-des-remplacements)))))
	    (goto-char (point-min))
	    (while (re-search-forward re nil t)
	      (replace-match
	       (if convert-to-re
		   (save-match-data
		     (assoc-default (match-string 0)
				    liste-des-remplacements 'string-match))
		 (cdr (assoc-string (match-string 0) liste-des-remplacements)))
	       t; fixed case
	       t; literal
	       ))))))

(defconst accents-convertisseur-tex
  (make-instance
   'accents-convertisseur-simple
   :id 'accents-convertisseur-tex
   :liste-de-remplacement
   '(("\�" . "\\'A")
     ("\À" . "\\`A")
     ("\Â" . "\\^A")
     ("\Ä" .  "\\\"A")
     ("\É" . "\\'E")
     ("\È" . "\\`E")
     ("\Ê" . "\\^E")
     ("\Ë" .  "\\\"E")
     ("\�" . "\\'I")
     ("\Ì" . "\\`I")
     ("\ÃŽ" . "\\^I")
     ("\�" .  "\\\"I")
     ("\0" . "\\'O")
     ("\Ã’" . "\\`O")
     ("\Ô" . "\\^O")
     ("\Ö" .  "\\\"O")
     ("\Ú" . "\\'U")
     ("\Ù" . "\\`U")
     ("\Û" . "\\^U")
     ("\Ü" .  "\\\"U")
     ("\Ç" . "\\c{C}")
     ("\á" . "\\'a")
     ("\à" . "\\`a")
     ("\â" . "\\^a")
     ("\ä"  .  "\\\"a")
     ("\é" . "\\'e")
     ("\è" . "\\`e")
     ("\ê" . "\\^e")
     ("\ë" .  "\\\"e")
     ("\í" .  "\\'\\i")
     ("\ì" .  "\\`\\i")
     ("\î" .  "\\^\\i")
     ("\ï" .  "\\\"\\i")
     ("\ó" . "\\'o")
     ("\ò" . "\\`o")
     ("\ô" . "\\^o")
     ("\ö" .  "\\\"o")
     ("\ú" . "\\'u")
     ("\ù" . "\\`u")
     ("\û" . "\\^u")
     ("\ü" .  "\\\"u")
     ("\ç" . "\\c{c}")
     ("\×" . "\\times{}")
)

   )
  "Convertisseur de lettres accentuées en séquence TeX
  équivalentes.")

(defun accents-tex ()
  (interactive)
  "change les caracteres accentues en accents tex"
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-conversion accents-convertisseur-tex beg end)
    ))

(defun accents-de-tex ()
  (interactive)
  "change les caracteres accentues en accents tex"
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-moteur
     '(( "\\\\'[ \n\t]*A" . "\�")
       ( "\\\\`[ \n\t]*A" . "\À")
       ( "\\\\^[ \n\t]*A" . "\Â")
       ( "\\\\\"[ \n\t]*A" . "\Ä")
       ( "\\\\'[ \n\t]*E" . "\É")
       ( "\\\\`[ \n\t]*E" . "\È")
       ( "\\\\^[ \n\t]*E" . "\Ê" )
       ( "\\\\\"[ \n\t]*E" . "\Ë")
       ( "\\\\'[ \n\t]*I" . "\�")
       ( "\\\\`[ \n\t]*I" . "\Ì")
       ( "\\\\^[ \n\t]*I" . "\ÃŽ")
       ( "\\\\\"[ \n\t]*I" . "\�")
       ( "\\\\'[ \n\t]*O" . "\0")
       ( "\\\\`[ \n\t]*O" . "\Ã’")
       ( "\\\\^[ \n\t]*O" . "\Ô")
       ( "\\\\\"[ \n\t]*O" . "\Ö")
       ( "\\\\'[ \n\t]*U" . "\Ú")
       ( "\\\\`[ \n\t]*U" . "\Ù")
       ( "\\\\^[ \n\t]*U" . "\Û")
       ( "\\\\\"[ \n\t]*U" . "\Ü")
       ( "\\\\c[ \n\t]*{C}" . "\Ç")
       ( "\\\\'[ \n\t]*{A}" . "\�")
       ( "\\\\`[ \n\t]*{A}" . "\À")
       ( "\\\\^[ \n\t]*{A}" . "\Â")
       ( "\\\\\"[ \n\t]*{A}" . "\Ä")
       ( "\\\\'[ \n\t]*{E}" . "\É")
       ( "\\\\`[ \n\t]*{E}" . "\È")
       ( "\\\\^[ \n\t]*{E}" . "\Ê" )
       ( "\\\\\"[ \n\t]*{E}" . "\Ë")
       ( "\\\\'[ \n\t]*{I}" . "\�")
       ( "\\\\`[ \n\t]*{I}" . "\Ì")
       ( "\\\\^[ \n\t]*{I}" . "\ÃŽ")
       ( "\\\\\"[ \n\t]*{I}" . "\�")
       ( "\\\\'[ \n\t]*{O}" . "\0")
       ( "\\\\`[ \n\t]*{O}" . "\Ã’")
       ( "\\\\^[ \n\t]*{O}" . "\Ô")
       ( "\\\\\"[ \n\t]*{O}" . "\Ö")
       ( "\\\\'[ \n\t]*{U}" . "\Ú")
       ( "\\\\`[ \n\t]*{U}" . "\Ù")
       ( "\\\\^[ \n\t]*{U}" . "\Û")
       ( "\\\\'[ \n\t]*a" . "\á" )
       ( "\\\\`[ \n\t]*a" . "\à" )
       ( "\\\\^[ \n\t]*a" . "\â" )
       ( "\\\\\"[ \n\t]*a" . "\ä" )
       ( "\\\\'[ \n\t]*e" . "\é" )
       ( "\\\\`[ \n\t]*e" . "\è")
       ( "\\\\^[ \n\t]*e" . "\ê")
       ( "\\\\\"[ \n\t]*e" . "\ë")
       ( "\\\\'{\\\\i}" . "\í")
       ( "\\\\`{\\\\i}" . "\ì")
       ( "\\\\^{\\\\i}" . "\î")
       ( "\\\\\"{\\\\i}" . "\ï")
       ( "\\\\'\\\\[ \n\t]*i" . "\í")
       ( "\\\\`\\\\[ \n\t]*i" . "\ì")
       ( "\\\\^\\\\[ \n\t]*i" . "\î")
       ( "\\\\\"\\\\[ \n\t]*i" . "\ï")
       ( "\\\\'[ \n\t]*o" . "\ó")
       ( "\\\\`[ \n\t]*o" . "\ò")
       ( "\\\\^[ \n\t]*o" . "\ô")
       ( "\\\\\"[ \n\t]*o" . "\ö")
       (  "\\\\'[ \n\t]*u" . "\ú")
       ( "\\\\`[ \n\t]*u" . "\ù")
       ( "\\\\^[ \n\t]*u" . "\û")
       ( "\\\\\"[ \n\t]*u" . "\ü")
       ( "\\\\c[ \n\t]*{c}" . "\ç")
       ( "\\\\\"[ \n\t]*{u}" . "\ü")
       ( "\\\\'[ \n\t]*{a}" . "\á" )
       ( "\\\\`[ \n\t]*{a}" . "\à" )
       ( "\\\\^[ \n\t]*{a}" . "\â" )
       ( "\\\\\"[ \n\t]*{a}" . "\ä" )
       ( "\\\\'[ \n\t]*{e}" . "\é" )
       ( "\\\\`[ \n\t]*{e}" . "\è")
       ( "\\\\^[ \n\t]*{e}" . "\ê")
       ( "\\\\\"[ \n\t]*{e}" . "\ë")
       ( "\\\\'[ \n\t]*{o}" . "\ó")
       ( "\\\\`[ \n\t]*{o}" . "\ò")
       ( "\\\\^[ \n\t]*{o}" . "\ô")
       ( "\\\\\"[ \n\t]*{o}" . "\ö")
       (  "\\\\'[ \n\t]*{u}" . "\ú")
       ( "\\\\`[ \n\t]*{u}" . "\ù")
       ( "\\\\^[ \n\t]*{u}" . "\û")
       ( "\\\\\"[ \n\t]*{u}" . "\ü")
       )
     t ;; utilisation de d'expression régulière
     )
    ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; accents-texinfo : change les caractères accentués en accents texinfo sans
;; demander confirmation les majuscules sont respectées
;;
;; texinfo-accents : change les accents Texinfo en caractères accentués sans
;; demander confirmation les majuscules sont respectées

(defconst accents-convertisseur-texinfo
  (make-instance
   'accents-convertisseur-simple
   :id 'accents-convertisseur-texinfo
   :liste-de-remplacement
   '(("\�" . "@'A")
     ("\À" . "@`A")
     ("\Â" . "@^A")
     ("\Ä" .  "@\"A")
     ("\É" . "@'E")
     ("\È" . "@`E")
     ("\Ê" . "@^E")
     ("\Ë" .  "@\"E")
     ("\�" . "@'I")
     ("\Ì" . "@`I")
     ("\ÃŽ" . "@^I")
     ("\�" .  "@\"I")
     ( "\Å’" . "@OE{}")
     ("\0" . "@'O")
     ("\Ç" . "@,{C}")
     ("\Ã’" . "@`O")
     ("\Ô" . "@^O")
     ("\Ö" .  "@\"O")
     ("\Ø" . "@O{}")
     ("\¿" . "@questiondown{}")
     ("\¡" . "@exclamdown{}")
     ("\Ù" . "@`U")
     ("\Ú" . "@'U")
     ("\Û" . "@^U")
     ("\Ü" .  "@\"U")
     ("\ß" . "@ss{}")
     ("\æ" . "@ae{}")
     ( "\–" . " -- ")
     ( "\—" . " --- ")
     ("\á" . "@'a")
     ("\à" . "@`a")
     ("\â" . "@^a")
     ("\ä"  .  "@\"a")
     ("\é" . "@'e")
     ("\è" . "@`e")
     ("\ê" . "@^e")
     ("\ë" .  "@\"e")
     ("\í" .  "@'{@dotless{i}}")
     ("\ì" .  "@`{@dotless{i}}")
     ("\î" .  "@^{@dotless{i}}")
     ("\ï" .  "@\"{@dotless{i}}")
     ("\ó" . "@'o")
     ("\ò" . "@`o")
     ("\ø" . "@o{}")
     ( "\Å“" . "@oe{}")
     ("\ô" . "@^o")
     ("\ö" .  "@\"o")
     ("\ú" . "@'u")
     ("\ù" . "@`u")
     ("\û" . "@^u")
     ("\ü" .  "@\"u")
     ("\ç" . "@,{c}")
     ("\ " . "@tie{}")     ))
  "Convertisseur de lettres accentuées en séquence Texinfo
  équivalentes.")

(defconst accents-convertisseur-de-texinfo
  (make-instance
   'accents-convertisseur-inverse
   :id 'accents-convertisseur-de-texinfo
   :liste-de-remplacement (oref accents-convertisseur-texinfo
				:liste-de-remplacement))
  "Convertisseur d'entités Texinfo en lettres accentuées équivalentes" )

(defun accents-texinfo ()
  (interactive)
  "change les caractères accentués en entités Texinfo équivalentes."
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-conversion accents-convertisseur-texinfo beg end)))


(defun accents-de-texinfo ()
  (interactive)
  "change les entités TEXINFO en caractères accentués équivalents."
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-conversion accents-convertisseur-de-texinfo beg end)))


(defconst accents-convertisseur-quote-texinfo
  (make-instance
   'accents-convertisseur-simple
   :id 'accents-convertisseur-quote-texinfo
   :liste-de-remplacement
   '(("@" . "@@" )
     ("{" . "@{")
     ("}" . "@}")   ))
  "Convertisseur de caractères spéciaux Texinfo en leurs
  séquences d'échappement respectives.")

(defconst accents-convertisseur-de-quote-texinfo
  (make-instance
   'accents-convertisseur-inverse
   :id 'accents-convertisseur-de-quote-texinfo
   :liste-de-remplacement (oref accents-convertisseur-quote-texinfo
				:liste-de-remplacement))
  "Convertisseur de caractères spéciaux échappés Texinfo en caractères non échappés." )

(defun accents-quote-texinfo ()
  (interactive)
  "Change les caractère spéciaux TEXINFO non échappés `@', `{' et
`}' en caractères échappés `@@', `@{' et `@}'."

  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-conversion accents-convertisseur-quote-texinfo beg end)))


(defun accents-de-quote-texinfo ()
  (interactive)
  "Change les caractère spéciaux TEXINFO échappés `@@', `@{' et
`@}' en caractères non échappés `@', `{' et `}'."
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-conversion accents-convertisseur-de-quote-texinfo beg end)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; accents-html : change les caractères accentués en accents HTML sans demander
;; confirmation les majuscules sont respectées
;;
;; html-accents : change les accents HTML en caractères accentués sans demander
;; confirmation les majuscules sont respectées

(defconst accents-convertisseur-html
  (make-instance 'accents-convertisseur-simple
		 :id 'accents-convertisseur-html
		 :liste-de-remplacement
   '(
     ( "\∀" . "&forall;")
     ( "\∂" . "&part;")
     ( "\∃" . "&exist;")
     ( "\∅" . "&empty;")
     ( "\∇" . "&nabla;")
     ( "\∈" . "&isin;")
     ( "\∉" . "&notin;")
     ( "\∋" . "&ni;")
     ( "\�" . "&prod;")
     ( "\∑" . "&sum;")
     ( "\−" . "&minus;")
     ( "\∗" . "&lowast;")
     ( "\√" . "&radic;")
     ( "\�" . "&prop;")
     ( "\∞" . "&infin;")
     ( "\∠" . "&ang;")
     ( "\∧" . "&and;")
     ( "\∨" . "&or;")
     ( "\∩" . "&cap;")
     ( "\∪" . "&cup;")
     ( "\∫" . "&int;")
     ( "\∴" . "&there4;")
     ( "\∼" . "&sim;")
     ( "\≅" . "&cong;")
     ( "\≈" . "&asymp;")
     ( "\≠" . "&ne;")
     ( "\≡" . "&equiv;")
     ( "\≤" . "&le;")
     ( "\≥" . "&ge;")
     ( "\⊂" . "&sub;")
     ( "\⊃" . "&sup;")
     ( "\⊄" . "&nsub;")
     ( "\⊆" . "&sube;")
     ( "\⊇" . "&supe;")
     ( "\⊕" . "&oplus;")
     ( "\⊗" . "&otimes;")
     ( "\⊥" . "&perp;")
     ( "\â‹…" . "&sdot;")
     ( "\Α" . "&Alpha;")
     ( "\Î’" . "&Beta;")
     ( "\Γ" . "&Gamma;")
     ( "\Δ" . "&Delta;")
     ( "\Ε" . "&Epsilon;")
     ( "\Ζ" . "&Zeta;")
     ( "\Η" . "&Eta;")
     ( "\Θ" . "&Theta;")
     ( "\Ι" . "&Iota;")
     ( "\Κ" . "&Kappa;")
     ( "\Λ" . "&Lambda;")
     ( "\Μ" . "&Mu;")
     ( "\�" . "&Nu;")
     ( "\Ξ" . "&Xi;")
     ( "\Ο" . "&Omicron;")
     ( "\Π" . "&Pi;")
     ( "\Ρ" . "&Rho;")
     ( "\Σ" . "&Sigma;")
     ( "\Τ" . "&Tau;")
     ( "\Î¥" . "&Upsilon;")
     ( "\Φ" . "&Phi;")
     ( "\Χ" . "&Chi;")
     ( "\Ψ" . "&Psi;")
     ( "\Ω" . "&Omega;")
     ( "\α" . "&alpha;")
     ( "\β" . "&beta;")
     ( "\γ" . "&gamma;")
     ( "\δ" . "&delta;")
     ( "\ε" . "&epsilon;")
     ( "\ζ" . "&zeta;")
     ( "\η" . "&eta;")
     ( "\θ" . "&theta;")
     ( "\ι" . "&iota;")
     ( "\κ" . "&kappa;")
     ( "\λ" . "&lambda;")
     ( "\μ" . "&mu;")
     ( "\ν" . "&nu;")
     ( "\ξ" . "&xi;")
     ( "\ο" . "&omicron;")
     ( "\Ï€" . "&pi;")
     ( "\�" . "&rho;")
     ( "\Ï‚" . "&sigmaf;")
     ( "\σ" . "&sigma;")
     ( "\Ï„" . "&tau;")
     ( "\Ï…" . "&upsilon;")
     ( "\φ" . "&phi;")
     ( "\χ" . "&chi;")
     ( "\ψ" . "&psi;")
     ( "\ω" . "&omega;")
     ( "\Ï‘" . "&thetasym;")
     ( "\Ï’" . "&upsih;")
     ( "\Ï–" . "&piv;")
     ( "\Å’" . "&OElig;")
     ( "\Å“" . "&oelig;")
     ( "\Å " . "&Scaron;")
     ( "\Å¡" . "&scaron;")
     ( "\Ÿ" . "&Yuml;")
     ( "\Æ’" . "&fnof;")
     ( "\ˆ" . "&circ;")
     ( "\˜" . "&tilde;")
     ( "\ " . "&ensp;")
     ( "\ " . "&emsp;")
     ( "\ " . "&thinsp;")
     ( "\‌" . "&zwnj;")
     ( "\�" . "&zwj;")
     ( "\‎" . "&lrm;")
     ( "\�" . "&rlm;")
     ( "\–" . "&ndash;")
     ( "\—" . "&mdash;")
     ( "\‘" . "&lsquo;")
     ( "\’" . "&rsquo;")
     ( "\‚" . "&sbquo;")
     ( "\“" . "&ldquo;")
     ( "\�" . "&rdquo;")
     ( "\„" . "&bdquo;")
     ( "\†" . "&dagger;")
     ( "\‡" . "&Dagger;")
     ( "\•" . "&bull;")
     ( "\…" . "&hellip;")
     ( "\‰" . "&permil;")
     ( "\′" . "&prime;")
     ( "\″" . "&Prime;")
     ( "\‹" . "&lsaquo;")
     ( "\›" . "&rsaquo;")
     ( "\‾" . "&oline;")
     ( "\¢" . "&cent;")
     ( "\€" . "&euro;")
     ( "\£" . "&pound;")
     ( "\Â¥" . "&yen;")
     ( "\§" . "&sect;")
     ( "\©" . "&copy;")
     ( "\®" . "&reg;")
     ( "\â„¢" . "&trade;")
     ( "\ℵ" . "&alefsym;")
     ( "\�" . "&larr;")
     ( "\↑" . "&uarr;")
     ( "\→" . "&rarr;")
     ( "\↓" . "&darr;")
     ( "\↔" . "&harr;")
     ( "\↵" . "&crarr;")
     ( "\�" . "&lArr;")
     ( "\⇒" . "&rArr;")
     ( "\⇔" . "&hArr;")
     ( "\⇓" . "&dArr;")
     ( "\⇑" . "&uArr;")
     ( "\↨"  . "&#8616;")
     ( "\⌈" . "&lceil;")
     ( "\⌉" . "&rceil;")
     ( "\⌊" . "&lfloor;")
     ( "\⌋" . "&rfloor;")
     ( "\â—Š" . "&loz;")
     ( "\â™ " . "&spades;")
     ( "\♣" . "&clubs;")
     ( "\♥" . "&hearts;")
     ( "\♦" . "&diams;")
     ( "\�" . "&Aacute;")
     ( "\À" . "&Agrave;")
     ( "\Â" . "&Acirc;")
     ( "\Ä" . "&Auml;")
     ( "\É" . "&Eacute;")
     ( "È" . "&Egrave;")
     ( "\Ê" . "&Ecirc;")
     ( "\Ë" . "&Euml;")
     ( "\�" . "&Iacute;")
     ( "\Ì" . "&Igrave;")
     ( "\ÃŽ" . "&Icirc;")
     ( "\�" . "&Iuml;")
     ( "\Ó" . "&Oacute;")
     ( "\Ã’" . "&Ograve;")
     ( "\Ô" . "&Ocirc;")
     ( "\Ö" . "&Ouml;")
     ( "\Ú" . "&Uacute")
     ( "\Ù" . "&Ugrave;")
     ( "\Û" . "&Ucirc;")
     ( "\Ü" . "&Uuml;")
     ( "\Ç" . "&Ccedil;")
     ( "\á" . "&aacute;")
     ( "\à" . "&agrave;")
     ( "\â" . "&acirc;")
     ( "\ä" . "&auml;")
     ( "\é" . "&eacute;")
     ( "\è" . "&egrave;")
     ( "\ê" . "&ecirc;")
     ( "\ë" . "&euml;")
     ( "\…" . "&hellip;")
     ( "\í" . "&iacute;")
     ( "\ì" . "&igrave;")
     ( "\î" . "&icirc;")
     ( "\ "  . "&nbsp;")
     ( "\ï" . "&iuml;")
     ( "\ó" . "&oacute;")
     ( "\ò" . "&ograve;")
     ( "\Å“" . "&oelig;")
     ( "\ô" . "&ocirc;")
     ( "\ö" . "&ouml;")
     ( "\ú" . "&uacute")
     ( "\ù" . "&ugrave;")
     ( "\û" . "&ucirc;")
     ( "\ü" . "&uuml;")
     ( "\ç" . "&ccedil;")
     ("\«"  . "&laquo;")
     ("\»"  . "&raquo;")
     ("\ß" . "&szlig;")
     ("\Þ" . "&THORN;")
     ("�" . "&#357;")
     ("\ž" . "&#382;")
     ("\¡" . "&iexcl;")
     ("\¤" . "&curren;")
     ("\¦" . "&brvbar;")
     ("\¨" . "&uml;")
     ("\ª" . "&ordf;")
     ("\¬" . "&not;")
     ("\­" . "&shy;")
     ("\¯" . "&macr;")
     ("\°" . "&deg;")
     ("\±" . "&plusmn;")
     ("\²" . "&sup2;")
     ("\³" . "&sup3;")
     ("\´" . "&acute;")
     ("\µ" . "&micro;")
     ("\¶" . "&para'")
     ("\·" . "&middot;")
     ("\¸" . "&cedil;")
     ("\¹" . "&sup1;")
     ("\º" . "&ordm;")
     ("\¼" . "&frac14;")
     ("\½" . "&frac12;")
     ("\¾" . "&frac34;")
     ("\¿" . "&iquest;")
     ("\Ã" . "&Atilde;")
     ("\Ã…" . "&Aring;")
     ("\Æ" . "&AElig;")
     ("\�" . "&ETH;")
     ("\Ñ" . "&Ntilde;")
     ("\×" . "&times;")
     ("\Ø" . "&Oslash;")
     ("\�" . "&Yacute;")
     ("\ã" . "&atilde;")
     ("\Ã¥" . "&aring;")
     ("\æ" . "&aelig;")
     ("\ð" . "&eth;")
     ("\ñ" . "&ntilde;")
     ("\õ" . "&otilde;")
     ("\÷" . "&divide;")
     ("\ø" . "&oslash;")
     ("\ý" . "&yacute;")
     ("\þ" . "&thorn;")
     ("\ÿ" . "&yuml;")
     ) )
  "Convertisseur de lettres accentuées en entités HTML équivalentes.
Cf http://www.webdesigneuse.net/Trouver-une-entite-HTML.html")

(defconst accents-convertisseur-de-html
  (make-instance
   'accents-convertisseur-inverse
   :id 'accents-convertisseur-de-html
   :liste-de-remplacement (oref accents-convertisseur-html
				:liste-de-remplacement))
  "Convertisseur d'entités HTML en lettres accentuées équivalentes" )

(defun accents-html ()
  (interactive)
  "change les caractères accentués en entités HTML équivalentes."
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-conversion accents-convertisseur-html beg end)))


(defun accents-de-html ()
  (interactive)
  "change les entités HTML en caractères accentués équivalents."
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end (let ((m (make-marker))) (set-marker m (region-end)) m)))
    (accents-conversion accents-convertisseur-de-html beg end)
    (save-excursion
      (save-match-data
	(goto-char (or beg (point-min)))
	(while (re-search-forward "&#\\([0-9]+\\);" end t)
	  (replace-match (string (string-to-number (match-string 1))) t t))))
    (when end (set-marker end nil))))

;;---------------------------------------------------------------------------

(defconst accents-convertisseur-quote-html
  (make-instance 'accents-convertisseur-simple
		 :id 'accents-convertisseur-quote-html
		 :liste-de-remplacement
		 '( ( "<" . "&lt;")
		    ( ">" . "&gt;")
		    ( "\"" . "&quot;")))
  "Convertisseur des caractères `\"', `<', et `>' en entités HTML
  &quot; &lt; et &gt correspondantes.")

(defconst accents-convertisseur-de-quote-html
  (make-instance
   'accents-convertisseur-inverse
   :id 'accents-convertisseur-de-quote-html
   :liste-de-remplacement (oref accents-convertisseur-quote-html
				:liste-de-remplacement))
  "Convertisseur des entités HTML &quot; &lt; et &gt, en caractères correspondants." )

(defun accents-quote-html ()
  (interactive)
  "Convertisseur des caractères `\"', `<', et `>' en entités HTML
  &quot; &lt; et &gt correspondantes."
  (let (beg end)
    (if (region-active-p)
	(setq beg (region-beginning)
	      end  (region-end)))
    (accents-conversion accents-convertisseur-quote-html beg end)))

;;---------------------------------------------------------------------------
(defconst accents-convertisseur-de-utf-8
  (make-instance
   'accents-convertisseur-simple
   :id 'accents-convertisseur-de-utf-8
   :liste-de-remplacement
   '(("ï" . "ï")
     ("é" . "é")
     ("â" . "â")
     ("û" . "û")
     ("è" . "è")
     ("ä" . "ä")
     ("ù" . "ù")
     ( "ç" . "ç")
     ("ê" . "ê")
     ("à" . "à")
     ("ô" . "ô")
     ))
  "Conversion de codage UTF-8 non reconue en caractères équivalents")

(defconst accents-convertisseur-de-utf-8
  (make-instance
   'accents-convertisseur-simple
   :id 'accents-convertisseur-de-utf-8
   :liste-de-remplacement
   '(
     ("ƒ‹" . "ы")
     ("ƒÃ" . "�")
     ("‘�" . "�")
     ("à" . "à")
     ("â" . "â")
     ("ä" . "ä")
     ("ç" . "ç")
     ("è" . "è")
     ("é" . "é")
     ("ê" . "ê")
     ("ï" . "ï")
     ("ô" . "ô")
     ("î" . "î")
     ("ù" . "ù")
     ("û" . "û")
     ("��" . "�")
     ("�Ÿ" . "П")
     ("�°" . "а")
     ("�²" . "в")
     ("�´" . "д")
     ("�µ" . "е")
     ("�¶" . "ж")
     ("�·" . "з")
     ("�¸" . "и")
     ("�º" . "к")
     ("�»" . "л")
     ("�¾" . "о")
     ("р" . "р")
     ("р" . "р")
     ("т" . "т")
     ("у" . "у")
     ("ÑÅ" . "т")
     ("�±" . "б")
     ("т´" . "�")
     ("µÑ" . "е")
     ("ˆÑ" . "е")
     ("�£" . "У")
     ("�½" . "н")
     ("�¯" . "Я")
     ("�³" . "г")
     ("ÑÄ" . "т")
     ("�¾" . "о")
     ("ÑÃ" . "у")
     ("‘Ž" . "ю")
     ("�" . "�")
     ("�°" . "а")
     ("�½" . "н")
     ("ш" . "ш")
     ("�¸" . "и")
     ("ю" . "ю")

))
  "Conversion de codage UTF-8 non reconue en caractères équivalents")

;(defun doit ()
;  (interactive)
;  (insert (logand (aref (buffer-substring-no-properties (point) (1+ (point))) 0) 255))
;  (delete-region (point) (1+ (point))))

(defconst accents-convertisseur-utf-8
  (make-instance
   'accents-convertisseur-inverse
   :id 'accents-convertisseur-utf-8
   :liste-de-remplacement (oref accents-convertisseur-de-utf-8
				:liste-de-remplacement))
  "Conversion de codage UTF-8 non reconue en caractères équivalents")

(defun accents-de-utf-8 ()
  (interactive)
  "change les séquence UTF-8 en caractères accentués équivalents."
  (accents-conversion accents-convertisseur-de-utf-8))

(defun accents-utf-8 ()
  (interactive)
  "change les caractères accentués en séquences UTF-8  équivalentes."
  (accents-conversion accents-convertisseur-utf-8))

(provide 'accents-ascii)

Revision-number: 30
Prop-content-length: 174
Content-length: 174

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2012-06-17T11:19:59.000000Z
K 7
svn:log
V 72
Ajout de la génération des @menu selon le chaînage de fichier.

PROPS-END

Node-path: trunk/lisp/html-to-texinfo.el
Node-kind: file
Node-action: change
Text-content-length: 75204
Text-content-md5: 7d96dcefeee3a66321adb1b1b4706341
Content-length: 75204

;;; html-to-texinfo.el --- -*- coding: iso-8859-15 -*-
;; Copyright 2010/2012 Vincent Belaïche
;;
;; Author: Vincent Belaïche <vincent.b.1@hotmail.fr>
;; Version: $Id: html-to-texinfo.el,v 1.15 2012-06-17 11:19:59 Vincent Exp $
;; Keywords: Texinfo, HTML, conversion
;; X-URL: not distributed yet
;;
;; This software is governed by the CeCILL license under French law and abiding
;; by the rules of distribution of free software.  You can use, modify and/ or
;; redistribute the software under the terms of the CeCILL license as circulated
;; by CEA, CNRS and INRIA at the following URL "http://www.cecill.info".
;;
;; As a counterpart to the access to the source code and rights to copy, modify
;; and redistribute granted by the license, users are provided only with a
;; limited warranty and the software's author, the holder of the economic
;; rights, and the successive licensors have only limited liability.
;;
;; In this respect, the user's attention is drawn to the risks associated with
;; loading, using, modifying and/or developing or reproducing the software by
;; the user in light of its specific status of free software, that may mean that
;; it is complicated to manipulate, and that also therefore means that it is
;; reserved for developers and experienced professionals having in-depth
;; computer knowledge. Users are therefore encouraged to load and test the
;; software's suitability as regards their requirements in conditions enabling
;; the security of their systems and/or data to be ensured and, more generally,
;; to use and operate it in the same conditions as regards security.
;;
;; The fact that you are presently reading this means that you have had
;; knowledge of the CeCILL license and that you accept its terms.
;;
;;; Commentary:

;;

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'html-to-texinfo)

;;; Code:

(provide 'html-to-texinfo)
(eval-when-compile
  (require 'cl))
(require 'eieio)
(require 'calc-ext)
(require 'accents-ascii)
(require 'doubly-linked-list)
(require 'compile)

;;;;##########################################################################
;;;;  User Options, Variables
;;;;##########################################################################

(defconst html2texi-suspicious-html-tags
  '("meta" "br" "hr" "link" "img" "frame")
"Liste des balises pour lesquelles le HTML ne suit pas une
syntaxe strictement XML. Par exemple `<br>' est utilisé au lieu
de `<br/>'."  )

(defconst html2texi-suspicious-html-tags-re
  (regexp-opt html2texi-suspicious-html-tags))

(defconst html2texi-non-recursive-tags
  '("p" "li"))

(defconst html2texi-hierarchy-list
  '(
    (li (ul ol))
    (tr (table))
    (th (tr))
    (td (tr))
    (dd (dl))
    (dt (dl))  ))

(defconst html2texi-non-recursive-tags-re
  (regexp-opt html2texi-non-recursive-tags))

(defconst html2texi-filepath-re
  "\\(?:[A-Za-z]:\\)?[- ~+A-Za-z_0-9./\\]+")

(defconst html2texi-texi-buffer-local-variables
  '(html2texi-document-information)
    "Liste des variables déclarées localement au tampon Texinfo.")

(defconst html2texi-allowed-markup-in-@center
  '(img b i em tt strong dfn code)
  "Liste des balises autorisées pour @center.")

(defconst html2texi-@center-max-size 1000)

(defclass html2texi-simple-markup ()
  ((class-dependant
    :initarg :class-dependant
    :initform nil
    :custom '(repeat
	  (list
	   (regexp :tag "clef")
	   (string :tag "prologue")
	   (string :tag "épilogue")
	   (boolean :tag "conserver les espaces et retours chariot")
	   ))
    :documentation "\
Liste d'association dont les éléments sont de la forme
 (CLEF PROLOGUE ÉPILOGUE)

Supposons que l'objet décrit le traitement de la balise TAG,
alors lorsque le code HTML `<TAG class=\"CLEF\">CONTENU</TAG>'
est rencontré, alors il est convertie en le code Texinfo
`PROLOGUE TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU.")
   (preamble
    :initarg :preamble
    :type string
    :documentation "\
Prologue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (postamble
    :initarg :postamble
    :type string
    :documentation "\
Épilogue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (space-verb
    :initarg :space-verb
    :initform nil
    :type boolean
    :documentation "\
Vrai lorsque les espaces et retours chariot sont à conserver tels quels."
    ))
  :documentation "\
Un object de type `html2texi-simple-markup'
décrit le traitement d'une balise simple comme par exemple
<code>.")

(defclass html2texi-convert-restrictions ()
  ((current-restrictions
    :initarg :current-restrictions
    :initform nil
    :documentation "Liste des restrictions de conversion
    courantes. Par exemple dans un @ref les @table sont
    interdite.")
   (stack
    :initform nil
    :documentation "Pile pour ajouter des restrictions, et les ôter ensuite."))
  :documentation "Contexte des restrictions de conversions courantes.")

(defmethod html2texi-push-restrictions
  ((this html2texi-convert-restrictions) &rest restrictions)
  "Ajoute les restrictions de conversion RESTRICTIONS."
  (let ((current-restrictions (oref this :current-restrictions))
	new-restrictions)
    (dolist (v restrictions)
      (unless (memq v current-restrictions)
	(push v new-restrictions)))
    (oset this :current-restrictions (append new-restrictions
					    (oref this :current-restrictions)))
    (oset this stack (cons new-restrictions (oref this stack)))))

(defmethod html2texi-pop-restrictions
  ((this html2texi-convert-restrictions))
  "Restaure les restrictions d'avant l'appel à `html2texi-push-restrictions'."
  (let* ((new-stack (oref this stack))
	 (latest (pop new-stack))
	 (current (oref this :current-restrictions)))
    (oset this stack new-stack)
    (dotimes (i (length latest))
      (pop current))
    (oset this :current-restrictions current)))

(defmethod html2texi-has-restrictions-p
  ((this html2texi-convert-restrictions) &rest restrictions)
  "Teste si l'une des restrictions dans RESTRICTIONS est en vigueur."
  (let ((current-restrictions (oref this :current-restrictions))
	ret restriction)
    (while restrictions
      (setq restriction (pop restrictions)
	    ret (memq restriction current-restrictions)
	    restrictions (if ret nil restrictions)))
    ret))

(defmacro html2texi-with-restrictions (restrictions &rest body)
  "Effectue BODY avec les restrictions dans la liste RESTRICTIONS."
 `(progn
    (html2texi-push-restrictions html2texi-convert-restrictions-object ,@restrictions)
    (unwind-protect
	(progn ,@body)
      (html2texi-pop-restrictions html2texi-convert-restrictions-object))))

(defclass html2texi-locator-info (doli2-element)
 ((id
   :initarg :id
   :type string
   :documentation "Identifiant d'ancre.")
  (type
   :initarg :type
   :type symbol
   :documentation "Soit `:@anchor', `:@ref',
    `:@node', soit `:@menu-item'."  )
  (position
   :initarg :position
   :type integer
   :documention "Point dans le tampon Texinfo où l'ancre est utilisée.")
  (size
   :initarg :size
   :type integer
   :documentation "Nombre de caractères dans le localisateur."))
:documentation "Détient l'information concernant une ancre
utilisée soit par un `@anchor', soit un `@node', soit un
`@ref'.")

(defclass html2texi-locator-listing (doli2-list)
  ((hash-table
    :initarg :hash-table))
  :documentation "Liste de `html2texi-locator-info', c'est à dire
    de pointeurs sur des `@node', `@ref' ou `@anchor', ou des
    entrée de `@menu', de sorte à embellir les noms de localisateurs a
    postériori."  )

(defmethod initialize-instance ((this html2texi-locator-listing) &rest fields)
  (call-next-method)
  (oset this :hash-table (make-hash-table)))

(defmethod html2texi-add-locator ((this html2texi-locator-listing) locator-info)
  (let* ((locator-id (oref locator-info :id))
	 (table (oref this :hash-table)))
    (doli2-add-last this locator-info)
    (puthash
     locator-id
     (cons locator-info (gethash locator-id table))
     table)))

(defclass html2texi-node-info ()
  ((up
    :initarg :up
    :type string
    :documentation "Identifiant du n½ud supérieur.")
   (next
    :initarg :next
    :type string
    :documentation "Identifiant du n½ud suivant.")
   (prev
    :initarg :prev
    :documentation "Identifiant du n½ud précédent.")
   (locator
    :initarg :locator
    :documentation "Localisateur pour le n½ud que cet objet décrit."))
  :documentation "Objet décriant les liaison d'un n½ud avec les autres n½uds.")


(defclass html2texi-files-to-do-listing ()
  ((already-to-do
   :initarg :already-to-do
   :initform nil
   :documentation "Liste des fichiers qui ont été trouvés comme
   étant à traiter lors du traitement d'un fichier qui a déjà été
   complètement traité.")
   (doing-or-done
    :initarg :doing-or-done
    :initform nil
    :documentation "Liste des fichiers qui ont déjà été traités, le
    premier de la liste est le fichier en cours de traitement."
    )
   (added-file-count
    :initarg :added-file-count
    :initform 0
    :documentation "Nombre de fichier qui est été ajouté à la
  liste des fichiers à traiter.")
   (soon-to-do
   :initarg :soon-to-do
   :initform nil
   :documentation "Liste des fichiers qui sont trouvés comme
   étant à traiter lors du traitement du fichier en cours de
   traitement.")
   (in-menu
    :initarg :in-menu
    :documentation "Liste des fichiers qui sont référencés dans un `@menu'."))
  :documentation "Objet servant à lister les fichiers à
  traiter. Il comprend deux listes: `already-to-do' et
  `soon-to-do' parce que lors du traitement d'un fichier TOTO les
  nouveaux fichiers à traiter sont mis dans `soon-to-do' dans
  l'ordre où ils sont rencontrés, du coup une fois que le fichier
  TOTO a complètement été traité, on inverse cet ordre en
  transvasant le contenu de `soon-to-do' dans `already-to-do'.")

(defclass html2texi-table-fmt-ctxt ()
  ((col-number
    :initarg :col-number
    :initform 0
    :type integer)
   (row-number
    :initarg :row-number
    :initform 0
    :type integer)
   (head-on-row-0
    :initarg :head-on-row-0
    :initform nil
    :type boolean)
   (force-head
    :initarg :force-head
    :initform nil
    :type boolean)
   (col-count
    :initarg :col-count
    :initform 0
    :type integer
    :documentation
    "Nombre de colonnes dans le tableau.")
   (col-info
    :initarg :col-info
    :documentation
    "Liste d'information sur chaque colonne. Le premier élément
    est factice est ne correspond à aucune colonne.")
   (col-info-last
    :initarg :col-info-last
    :documentation
    "Pointe sur la dernière cons-cell de l'attribut `:col-info'.")
   (col-info-length
    :initarg :col-info-length
    :initform 0
    :type integer))
  :documentation "Contexte de formattage d'une table.")

(defmethod initialize-instance ((this html2texi-table-fmt-ctxt) &rest fields)
  (call-next-method)
  (let ((ci (list 0)))
    ;; le premier élément ne correspond pas à une colonne mais servira à
    ;; reduire le vecteur des informations sur chaque colonne
    (oset this :col-info ci)
    (oset this :col-info-last ci)))


(defmethod initialize-instance ((this html2texi-files-to-do-listing) &rest fields)
  (call-next-method)
  (oset this :in-menu  (make-hash-table)))

(defmethod html2texi-files-make-menu-maybe ((this html2texi-files-to-do-listing))
  (let* ((soon-to-do (oref this :soon-to-do))
	(in-menu (oref this :in-menu))
	(up (html2texi-current-file this))
	(prev up)
	menu-files)
    (dolist (f soon-to-do)
      (unless (or (gethash f in-menu) (null (file-exists-p f)))
	(push f menu-files)))
    (when menu-files
      (insert "\n@menu\n")
      (while menu-files
	(let* ((f (pop menu-files))
	       (next (and (cdr menu-files) (cadr menu-files)))
	       (node-info (progn
			   (html2texi-process-url (concat "file:" f) "" :@menu-item)
			   (gethash f in-menu))))
	  (oset node-info :up up)
	  (oset node-info :next next)
	  (oset node-info :prev prev)
	  (setq prev f)))
      (insert "@end menu\n"))))

(defmethod html2texi-files-has-to-do ((this html2texi-files-to-do-listing))
  (or (oref this :already-to-do)
      (oref this :soon-to-do))  )

(defmethod html2texi-current-file ((this html2texi-files-to-do-listing))
  (car (oref this :doing-or-done)))

(defmethod html2texi-get-next-file-next-to-do  ((this html2texi-files-to-do-listing))
  "Récupère le prochain fichier à traiter. L'appel de cette
méthode si aucun fichier n'est à traiter génère une erreur."
  (let ((soon-to-do (oref this :soon-to-do))
	(already-to-do (oref this :already-to-do)))
    (when soon-to-do
      (while soon-to-do (push (pop soon-to-do) already-to-do))
      (oset this :soon-to-do nil))
    (let ((next (pop already-to-do)))
      (oset this :already-to-do already-to-do)
      (oset this :doing-or-done (cons next (oref this :doing-or-done)))
      next)))

(defmethod html2texi-add-file-to-do   ((this html2texi-files-to-do-listing) next)
  "Ajoute le fichier dont le nom absolu est NEXT à la liste des
fichier à traiter. Renvoie `nil' si le fichier était déjà
connu, non-`nil' sinon."
  (unless (or (member next (oref this :already-to-do))
	      (member next (oref this :doing-or-done))
	      (member next (oref this :soon-to-do)))
    (oset this :soon-to-do (cons next (oref this :soon-to-do)))
    (oset this :added-file-count (1+ (oref this :added-file-count)))))

(defmethod html2texi-add-menu-reference  ((this html2texi-files-to-do-listing) file locator)
  (let ((in-menu (oref this :in-menu)))
    (if (gethash file in-menu)
	(html2texi-fatal-error "Double référence au fichier `%s'" :html2texi-generic-error file)
      (puthash file (make-instance 'html2texi-node-info
				   :locator locator) in-menu))))

(defclass html2texi-document-information ()
  ((author
    :initarg :author
    :type string)
   (title
    :initarg :title
    :type string)
   (language
    :initarg :language
    :type string)
   (encoding
    :initarg :encoding
    :type string)
   (header-size
    :initarg :header-size
    :type integer)
   )
  :documentation "Information sur le document Texinfo")

(defun html2texi-texinfo-inside-comment-p ()
  "Renvoie non nil lorsque le point est dans un commentaire Texinfo."
  (save-match-data
    (save-excursion
      (let ((cur (point))
	    (end (progn (end-of-line) (point))))
	(beginning-of-line)
	(and (re-search-forward "\\(^\\|[^@]\\)@c\\(omment\\)\\_>" end t)
	     (<= (match-beginning 0) cur))))))

(defmethod html2texi-handle-simple-markup
  ((this html2texi-simple-markup) xml-expr)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe
			(and class-attribute
			     (assoc-string (cdr class-attribute)
					   (oref this :class-dependant))))
		      (list (oref this :preamble)
			    (oref this :postamble)))))
    (insert (car pre-post))
    (let ((beg (point))
	  end)
      (html2texi-process-xml-expr xml-expr)
      (unless (oref this :space-verb)
	(setq end (point-marker))
	(goto-char beg)
	(while (re-search-forward "[\n\r]\\s-*" nil end)
	  (let ((replace-str " "))
	    (save-match-data
	      (cond
	       ((html2texi-texinfo-inside-comment-p)
		(setq replace-str nil))))
	      (and replace-str (replace-match replace-str t t)))))
	(goto-char end)
	(set-marker end nil))
    (insert (cadr pre-post))))


(defcustom html2texi-save-texi-buffer-confirm-p
  t
  "`nil' pour sauvegarder sans confirmation le tampon Texinfo
après la conversion, `t' sinon."
  :type '(radio
	  (const :tag "Sans confirmation" nil)
	  (const :tag "Demander confirmation" t))
  :group 'html2texi)

(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-reuse-log-buffer t
  "Mettre à `nil' pour que le tampon de sortie des erreurs &
avertissement soit re-généré avec un nom unique à chaque
traitement."
  :type  '(radio
	  (const :tag "Créer un nouveau tampon d'erreurs à chaque conversion." nil)
	  (const :tag "Réutiliser le tampon d'erreurs s'il existe déjà." t))
  :group 'html2texi)

(defcustom html2texi-url-encoding
  :html2texi-utf-8
  "Sélectionne le codage des URL."
  :type '(radio
	  (symbol :tag "UTF-8" :html2texi-utf-8)
	  (symbol :tag "ISO-8859-1" :html2texi-latin-1))
  :group 'html2texi)

(defcustom html2texi-i-simple-markup
  (html2texi-simple-markup "html2texi-i-simple-markup"
   :preamble "@i{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-b-simple-markup
  (html2texi-simple-markup "html2texi-b-simple-markup"
   :preamble "@b{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-kbd-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :preamble "@kbd{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-dfn-simple-markup
  (html2texi-simple-markup "html2texi-dfn-simple-markup"
   :preamble "@dfn{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-em-simple-markup
  (html2texi-simple-markup "html2texi-em-simple-markup"
   :preamble "@emph{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-sub-simple-markup
  (html2texi-simple-markup "html2texi-sub-simple-markup"
   :preamble ""
   :postamble "")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<sub class=\"CLEF\">CONTENU</sub>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-sup-simple-markup
  (html2texi-simple-markup "html2texi-sup-simple-markup"
   :preamble ""
   :postamble "")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<sup class=\"CLEF\">CONTENU</sup>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-samp-simple-markup
  (html2texi-simple-markup "html2texi-samp-simple-markup"
   :preamble "@samp{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<samp class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-strong-simple-markup
  (html2texi-simple-markup "html2texi-strong-simple-markup"
   :preamble "@strong{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-tt-simple-markup
  (html2texi-simple-markup "html2texi-tt-simple-markup"
   :preamble "@t{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<tt class=\"CLEF\">CONTENU</tt>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-handle-two-columns-table-as-@table
  t
 "Si `nil' alors une table `<table>...</table>'
avec deux colonne sera gérée en texinfo par une `@table', si non
`nil', alors elle sera gérée par une `@multitable'."
  :type
  '(choice
    (const :tag "t pour @table" t)
    (const :tag "nil pour @multitable" nil))
  :group 'html2texi)

(defcustom html2texi-log-error-names
   ["Erreur fatale" "Erreur" "Avertissement" "Info"]
   "Liste des types d'erreur préfixant les messages d'erreur dans
le tampon de sortie des erreurs & avertissement de traitement."
   :type
   '(vector
     (string :tag "Erreur fatale")
     (string :tag "Erreur")
     (string :tag "Avertissement")
     (string :tag "Info"))
   :group 'html2texi  )

(defcustom html2texi-log-buffer-name
  "*HTML2TEXI*"
  "Nom du tampon de sortie des erreurs et avertissements de traitement."
  :type 'string
  :group 'html2texi)

(defcustom html2texi-beautify-locators
  t
  "Embellit les identificateur de localisateur après génération
  du Texinfo."
  :type '(radio
	  (const :tag "Ne pas embellir les identificateurs de localisateur." nil)
	  (const :tag "Embellir les identificateurs de localisateur." t))
  :group 'html2texi )

(defvar html2texi-document-information-object nil
  "Objet de classe `html2texi-document-information' pour mémoriser les informations (titre,
  auteurs, etc...) propres à un document.")

(defvar html2texi-line-delta 0
  "Décalage entre le numéro de ligne du code XML au sein le
  tampon Texinfo en cours de traitement, et son numéro de ligne
  dans le fichier HTML source.")

(defvar html2texi-xml-stack nil
  "Pile des expressions XML")

(defvar html2texi-keep-empty-strings nil
  "Non nil si les chaînes vides sont à conserver.")

(defvar html2texi-ignore-head nil
  "Non nil si on ignore le <head> (dans un fichier HTML lié).")

(defvar html2texi-directory-stack nil
  "Pile des chemins de répertoire.")

(defvar html2texi-files-to-do nil
  "Base des fichiers non encore traités, instanciée localement
  comme un objet de class `html2texi-files-to-do-listing'.")

(defvar html2texi-flushable-anchors nil
  "Liste de nom d'ancrage de lien dont l'insertion a été remise à
  plus tard." )

(defvar html2texi-postpone-output nil
  "Non `nil' lorsque l'insertion du code est remise à plus tard.")

(defvar html2texi-directory-ref nil
  "Répertoire de référence")

(defvar html2texi-log-buffer nil
  "Tampon de sortie des erreurs et avertissements de traitement.")

(defvar html2texi-reusable-log-buffer nil
  "Quand `html2texi-reuse-log-buffer' vaut est non `nil', tampon
  qu'on essaie de reutiliser pour la sortie des erreurs..")

(defvar html2texi-texi-buffer-name nil
  "Nom du tampon Texinfo généré.")

(defvar html2texi-locator-list nil
  "Liste des localisateurs, pour post-traitement d'embellissement
  des identificateurs de localisateur.")

(defvar html2texi-convert-restrictions-object nil
  "Objet de classe `html2texi-convert-restrictions' comprenant la
  liste courante des restrictions de conversion."  )

(defmacro html2texi-make-simple-markup-handler (tag)
  `(defun ,(intern (concat "html2texi-tag-handler-" (symbol-name tag)))
     (xml-expr)
     (html2texi-handle-simple-markup
      ,(intern (concat "html2texi-"  (symbol-name tag) "-simple-markup"))
      xml-expr) ))

(defun html2texi-make-html-clean-xml (beg end)
  (let  ((end-arg end)
	 end)
    ;; initialisation de end comme un marque
    (if (markerp end-arg)
	(setq end end-arg)
      (goto-char end-arg)
      (setq end (point-marker)))

    ;; rend les balise implicitement auto-closante vraiment auto-closante
    (goto-char beg)
    (while (re-search-forward (concat "<\\(" html2texi-suspicious-html-tags-re "\\)\\>")
			      end t)
      (let ((tag (match-string-no-properties 1)))
	(unless (re-search-forward ">" nil t)
	  (html2texi-fatal-error "Clôture non trouvé pour la balise %s" nil
				 tag))
	(when (null (looking-back "/>"))
	  (backward-char)
	  (insert "/")
	  (forward-char))))

    ;; marque de paragraphe et de ligne
    (goto-char beg)
    (let (tag-stack pos-< pos->
		    tag is-closure self-closing)
      (while (re-search-forward "<\\(/\\)?\\([a-zA-Z]+\\)\\>" end t)
	(setq pos-< (match-beginning 0)
	      tag (match-string-no-properties 2)
	      is-closure (match-string-no-properties 1))
	(unless (string= tag (downcase tag))
	  (replace-match (setq tag (downcase tag)) 2))
	(unless (re-search-forward ">" end t)
	  (html2texi-fatal-error "Soufflet de clôture non trouvé pour la balise %s" nil
		 tag))

	(setq pos-> (point)
	      self-closing (looking-back "/>"))
	(cond
	 ((and self-closing  is-closure)
	  (html2texi-fatal-error "balise %s à la fois de clôture et auto-closante" nil
		 tag))

	 (self-closing
	  ;; do nothing
	  )

	 ((null is-closure)
	  (when (and
		 (string-match (concat "\\`" html2texi-non-recursive-tags-re "\\'") tag)
		 tag-stack
		 (string= tag (caar tag-stack)))
	    ;; clôture
	    (save-excursion
	      (goto-char pos-<)
	      (insert "</" tag "><!-- HTML2TEXI: repaired (1) -->")
	      (html2texi-warning "Ajout clôture `</%s>'" nil tag))
	    (pop tag-stack))
	  (push (list tag) tag-stack))

	 (is-closure
	  (if (and tag-stack
		   (string= (caar tag-stack) tag))
	      (pop tag-stack)
	    (let ((first (assoc-string tag tag-stack)) rev)
	      (if first
		  (progn
		    (while (and tag-stack (null (eq (car tag-stack) first)))
		      (push (pop tag-stack) rev))
		    (pop tag-stack)
		    (save-excursion
		      (goto-char pos-<)
		      (dolist (c rev)
			(insert  "</" (car c) "><!-- HTML2TEXI: repaired (2) -->" )
			(html2texi-warning "Ajout clôture `</%s>'" nil tag))))

		(save-excursion
		  (goto-char pos->)
		  (insert "-->")
		  (goto-char pos-<)
		  (insert "<!-- HTML2TEXI: repaired (3). "))
		(html2texi-warning "Clôture de %s ne correspondant à aucune ouverture" nil tag)))))))


      (let (p-pos li-pos markup poss pos)
	(while (re-search-forward "<\\(/\\)?\\(p\\|li\\)\\>[^>]*>" end t)
	  (setq markup (match-string-no-properties 2)
		poss (intern (concat markup "-pos"))
		pos (symbol-value poss))
	  (if (match-string-no-properties 1)
	      (if  pos
		  (if (= pos (match-beginning 0))
		      (set poss nil)
		    (html2texi-fatal-error "Clôture de balise %s ne correspondant à aucune ouverture" nil
					   (match-string-no-properties 0)))
		(save-excursion
		  (save-match-data
		    (unless  (re-search-forward
			      (format "<\\(/\\)?\\(%s\\)\\>[^>]+>" markup)
			      end t)
		      (html2texi-fatal-error "Ouverture de balise <%s> sans clôture" nil
					     markup))
		    (set poss (match-beginning 0))
		    (unless (match-string-no-properties 1)
		      (goto-char (match-beginning 0))
		      (insert (format "</%s>" markup))
		      (dolist (symb '(p-pos li-pos))
			(unless (or (null (symbol-value symb))
				    (eq symb poss))
			  (set symb (+ (length markup) 3 (symbol-value symb)))))))))))
	))

    ;; mise entre guillemets anglais des attributs entier sans guillemets
    (goto-char beg)
    (let (p1 p2 added-dquote-attributes p-start p-end)
      ;; tant qu'on trouve potentiellement un attribut sans "..."
      (while (re-search-forward "\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([-+]?[0-9]+\\)"
				nil end)
	(setq p1 (match-beginning 1)
	      p2 (match-end 0))
	(if
	    ;; si la position est bien entre < et >
	    (and (re-search-backward "[<>]" beg t)
		 (looking-at "<\\sw+")
		 (progn
		   (goto-char (setq p-start (match-end 0)))
		   (re-search-forward "[<>]" end t)
		   (string= (match-string-no-properties 0) ">"))
		 (>= (setq p-end (match-beginning 0)) p1))
	    ;; alors on fait la réparation
	    (progn
	      (goto-char p-start)
	      (while
		  (progn
		    (while (looking-at "\\(?:\\s-\\|\n\\)*\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\"[^\"]*\"")
		      (goto-char (match-end 0)))
		    (cond
		     ((looking-at  "\\(?:\\s-\\|\n\\)*\\(\\sw+\\)\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([-+]?[0-9]+\\)")
		      (push (match-string-no-properties 1) added-dquote-attributes)
		      (goto-char (match-beginning 2))
		      (insert ?\")
		      (goto-char (1+ (match-end 2)))
		      (insert ?\")
		      (setq p-end (+ 2 p-end)))
		     ((looking-at "\\(?:\\s-\\|\n\\)*>")
		      (goto-char (match-end 0))
		      (insert "<!-- HTML2TEXI inserted double quotes around values for attibutes: "
			      (mapconcat (lambda (x) (concat "`" x "'"))
					 added-dquote-attributes
					 ", ")
			      " -->")
		      nil)
		     (t (html2texi-error "Attribut au format invalide: %s."
			       (buffer-substring (point) p-end)))))))
	  ;; sinon on continue à chercher un attribut potentiel dont la valeur
	  ;; n'est pas entre "..."
	  (goto-char p2))))

    ;; un peu de ménage...
    (unless (markerp end-arg)
      (set-marker end nil)) ))

;;;==========================================================================
;;; définition des gestionnaires de balise
;;;--------------------------------------------------------------------------

(defun html2texi-tag-handler-a (xml-expr)
  (let (name href text (xml-expr-length (length xml-expr)))
    (dolist (attrib (cadr xml-expr))
      (cond
       ((eq (car attrib) 'href)
	(setq href (cdr attrib)))
       ((eq (car attrib) 'name)
	(setq name (cdr attrib)))))
    (and (cddr xml-expr)
	 (setq text (if (cdddr xml-expr)
			xml-expr
		      (caddr xml-expr))))
    (cond
     (href (html2texi-process-url href text))
     ((= xml-expr-length 3)
      (cond
       ((stringp text)
	(insert (html2texi-string-escape text t)))
       ((consp text)
	(html2texi-process-xml-expr text)	)
       (t (error "Le format du text de la balise <a> était inattendu"))))
     ((> xml-expr-length 3)
      (html2texi-process-xml-expr `(div nil ,@(cddr xml-expr)))))
    (and
     name
     (progn
       (insert "\n@anchor{")
       (html2texi-insert-locator
	 (concat
	  (file-relative-name
	   (html2texi-current-file html2texi-files-to-do)
	   html2texi-directory-ref)
	  "#" name) :@anchor)
       (insert "}\n")))))

(html2texi-make-simple-markup-handler b)

(defun html2texi-flush-anchors ()
  (while html2texi-flushable-anchors
    (insert "@anchor{")
    (html2texi-insert-locator (pop html2texi-flushable-anchors) :@anchor)
    (insert "}\n")))

(defun html2texi-tag-handler-h1 (xml-expr)
  (insert "@chapter " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))


(defun html2texi-tag-handler-h2 (xml-expr)
  (insert "@section " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))

(defun html2texi-tag-handler-h3 (xml-expr)
  (insert "@subsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
    (html2texi-flush-anchors))

(defun html2texi-tag-handler-h4 (xml-expr)
  (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))

(defun html2texi-tag-handler-h5 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
     (html2texi-flush-anchors))

(defun html2texi-tag-handler-h6 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
   (html2texi-flush-anchors))

(html2texi-make-simple-markup-handler samp)


(defun html2texi-get-col-span (xml-expr)
  ;; xml-expr is <td> or <th>
  (let ((col-span (cdr-safe (assq 'colspan (nth 1 xml-expr)))))
    (setq col-span
	  (cond
	   ((integerp
	       (setq col-span
		     (if (stringp col-span)
			 (string-to-number col-span)
		       col-span)))
	      col-span)
	   ((null col-span) 1)
	   (t (error "colspan invalide"))))  ))

(html2texi-make-simple-markup-handler sub)
(html2texi-make-simple-markup-handler sup)

(html2texi-make-simple-markup-handler tt)

(defvar html2texi-table-fmt-current-ctxt nil)

(defun html2texi-tag-handler-table (xml-expr)
  (let* ((html2texi-table-fmt-current-ctxt (html2texi-table-fmt-ctxt "Table formatting context"))
	 (xml-table-info
	  (vector xml-expr;0: table items
		  nil;1: thead items
		  nil;2: tbody items
		  nil;3: tfoot items
		  0;4: bitmap champ trouvé:
					; 1 = plain table (found a tr item not a thead|tbody|tfoot)
					; 2 = thead found
					; 4 = tbody found
					; 8 = tfoot found
		  0;5: bitmap traité
		  1;6: en cours de traitement
		  ))
	 (xml-items (cddr xml-expr)))

    ;; tout d'abord on analyse la table pour trouver le nombre de colonne
    (while (or xml-items (/= (aref xml-table-info 4)  (aref xml-table-info 5)))
      (if xml-items
	  (let ((xml-expr (pop xml-items)))
	    (cond
	     ((and (consp xml-expr)
		   (eq (car xml-expr) 'tr))
	      (when (= (aref xml-table-info 6) 1)
		;; cas d'une table avec les lignes directement sous <table> ... </table>
		(and (/= (logand (aref xml-table-info 4)
				 14) 0)
		     (html2texi-error "Table avec à la fois des lignes directement sous <table> ... </table>\
 et des lignes sous une balise <X>...</X> avec X dans {thead, tbody, tfoot}" xml-expr))
		(aset xml-table-info 4 (logior (aref xml-table-info 4) 1)))
	      ;; plus besoin de chercher une ligne: on compte les colonnes sur la
	      ;; première ligne trouvée
	      (setq xml-items nil)
	      (dolist  (xml-expr (cddr xml-expr))
		(cond
		 ((consp xml-expr)
		  (if (memq  (car xml-expr) '(th td))
		      (progn
			(oset html2texi-table-fmt-current-ctxt :col-count
			      (+ (oref html2texi-table-fmt-current-ctxt :col-count)
				 (html2texi-get-col-span xml-expr)))
			(when (> (oref html2texi-table-fmt-current-ctxt :col-count)
				 (oref html2texi-table-fmt-current-ctxt :col-info-length))
			  (let ((l (make-list (- (oref html2texi-table-fmt-current-ctxt :col-count)
						 (oref html2texi-table-fmt-current-ctxt :col-info-length))
					      '(abs 1))))
			    (setcdr (oref html2texi-table-fmt-current-ctxt :col-info-last) l)
			    (oset html2texi-table-fmt-current-ctxt :col-info-last (last l))
			    (oset html2texi-table-fmt-current-ctxt :col-info-length
				  (oref html2texi-table-fmt-current-ctxt :col-count)))))
		    (html2texi-error "balise inattendu dans une table" xml-expr)))
		 ((stringp xml-expr)
		  (unless (string-match
			   "\\`\\s-*\\(\n\\s-*\\)*\\'"
			   xml-expr)
		    (html2texi-error "Chaîne inattendue" xml-expr)))
		 (t (html2texi-error "Élément inattendu" xml-expr)))))

	     ;; la table est organisé en thead/tbody/tfoot
	     ((and (consp xml-expr)
		   (memq (car xml-expr) '(thead tbody tfoot)))
	      (let* ((thead 1) (tbody 2) (tfoot 3) (index (symbol-value (car xml-expr))))
		(and (/= (logand (aref xml-table-info 4)
				 (lsh 1 index)) 0)
		     (html2texi-error "Balise `%s' en double dans la table"
				      (aref xml-table-info 0)
				      (symbol-name (car xml-expr))))
		(aset xml-table-info 4 (logior  (aref xml-table-info 4) (lsh 1 index)))
		(aset xml-table-info index xml-expr)))

	     ;; chaîne qui n'est pas un blanc au beau milieu de la table...
	     ((stringp xml-expr)
	      (unless (string-match
		       "\\`\\s-*\\(\n\\s-*\\)*\\'"
		       xml-expr)
		(html2texi-error "Chaîne inattendue" xml-expr)))
	     (t (html2texi-error "Élément inattendu" xml-expr))))
	;; xml-items est nil

	;; on marque le champ courant (c.-à-d. table | thead | tbody | tfoot)
	;; comme ayant été traité
	(aset xml-table-info 5 (logior
				(aref xml-table-info 5)
				(logand
				 (aref xml-table-info 4)
				 (aref xml-table-info 6))))
	;; maintenant on cherche s'il en est un champ restant à parcourir
	(let ((index 0)
	      (to-be-processed (logxor  (aref xml-table-info 4)
					(aref xml-table-info 5))))
	  (while (and (/= to-be-processed 0)
		      (= (logand to-be-processed 1) 0))
	    (setq index (1+ index)
		  to-be-processed (lsh to-be-processed -1)))
	  (when (/= to-be-processed 0)
	    (setq xml-items (cdr-safe (cdr-safe (aref xml-table-info index))))
	    (aset xml-table-info 6 (lsh 1 index))) )))


    ;; maintenant qu'on a fini d'analyser la table, on peut la traiter.
    (if (or (> (oref html2texi-table-fmt-current-ctxt :col-count) 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(progn
	  (insert "@multitable @columnfractions ")
	  (let ((total-weight
		 (math-reduce-vec
		  (lambda (r x)
		    (+ r
		       (cond
			((eq (car x) 'abs) (cadr x))
			((eq (car x) 'rel)
			 (setcar x 'abs)
			 (setcar (cdr x)
				 (* (cadr x)
				    (oref html2texi-table-fmt-current-ctxt :col-info-length))) (cadr x)))))
		  (cons 'vec (oref html2texi-table-fmt-current-ctxt :col-info)))))
	    (insert
	     (mapconcat
	      (lambda (x)
		(number-to-string
		 (/ (float (cadr x)) (oref html2texi-table-fmt-current-ctxt :col-info-length))))
	      (cdr (oref html2texi-table-fmt-current-ctxt :col-info))
	      " ")))
	  (insert "\n"))
      (insert "@table\n"))

    (dotimes (i 4)
      (when (/= 0 (logand (aref xml-table-info 4) (lsh 1 i)))
	(if (/= i 2)
	    (html2texi-process-xml-expr  (aref xml-table-info i))
	  (oset html2texi-table-fmt-current-ctxt :force-head t)
	  (html2texi-process-xml-expr  (aref xml-table-info 2))
	  (oset html2texi-table-fmt-current-ctxt :force-head nil))))

    (if (or (> (oref html2texi-table-fmt-current-ctxt :col-count) 2)
	    (null html2texi-handle-two-columns-table-as-@table))
	(insert "@end multitable\n")
      (insert "@end table\n"))))


(defun html2texi-tag-handler-tr (xml-expr)
  (oset html2texi-table-fmt-current-ctxt :col-number 0)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n")
  (oset html2texi-table-fmt-current-ctxt :row-number
	(1+ (oref html2texi-table-fmt-current-ctxt :row-number))))

(defun html2texi-tag-handler-th (xml-expr)
  (if   (= 0 (oref html2texi-table-fmt-current-ctxt :col-number))
      (if (and (= 0 (oref html2texi-table-fmt-current-ctxt :row-number))
	       (null html2texi-handle-two-columns-table-as-@table))
	  (progn
	    (oset html2texi-table-fmt-current-ctxt :head-on-row-0 t)
	    (insert "@headitem ")
	    (html2texi-process-xml-expr xml-expr))
	(insert "@item ")
	(html2texi-process-xml-expr xml-expr))
    (when (or (> (oref html2texi-table-fmt-current-ctxt :col-count) 2)
	      (null html2texi-handle-two-columns-table-as-@table))
      (insert "@tab "))
    (html2texi-process-xml-expr xml-expr)
    (unless (and  (= 0 (oref html2texi-table-fmt-current-ctxt :row-number))
		  (oref html2texi-table-fmt-current-ctxt :head-on-row-0))
	(insert "\n")))
  (oset html2texi-table-fmt-current-ctxt :col-number
	(1+ (oref html2texi-table-fmt-current-ctxt :col-number))))

(defun html2texi-tag-handler-td (xml-expr)
  (if  (oref html2texi-table-fmt-current-ctxt :force-head)
      (html2texi-tag-handler-th xml-expr)
    (if (= 0 (oref html2texi-table-fmt-current-ctxt :col-number))
	(insert "@item ")
      (if (or (> (oref html2texi-table-fmt-current-ctxt :col-count) 2)
	      (null html2texi-handle-two-columns-table-as-@table))
	  (insert "@tab ")))
    (html2texi-process-xml-expr xml-expr)
    (insert "\n")
    (oset html2texi-table-fmt-current-ctxt :col-number
	  (1+ (oref html2texi-table-fmt-current-ctxt :col-number)))))

(defun html2texi-cur-dir ()
  "Détermine le répertoire courant relativement au répertoire du
HTML racine de départ. La valeur retournée se termine par une oblique `/'"
  (let ((cur-dir  (nreverse (split-string (cdar html2texi-directory-stack) "/")))
	(ref-dir  (nreverse (split-string html2texi-directory-ref "/"))))
    (unless (and (string= (car cur-dir) "")
		 (string= (car ref-dir) ""))
      (error "Format invalide de répertoire"))
    (setq cur-dir (nreverse (cdr cur-dir))
	  ref-dir (cdr ref-dir))
    (if (or (string= (car cur-dir) "")
	    (string-match "\\`[a-z]:" (car cur-dir)))
	;; cur-dir est un chemin absolu
	(progn
	  (setq ref-dir (nreverse ref-dir))
	  (while (and cur-dir ref-dir (string= (car cur-dir) (car ref-dir)))
	    (setq cur-dir (cdr cur-dir)
		  ref-dir (cdr ref-dir)))
	  (while ref-dir
	    (push ".." cur-dir)
	    (setq ref-dir (cdr ref-dir)))
	  (concat (mapconcat 'identity cur-dir "/") "/"))
      (while (and cur-dir
		  (cond
		   ((string= (car cur-dir) "..")
		    (unless ref-dir
		      (error "Chemin invalide"))
		    (setq ref-dir (cdr ref-dir)
			  cur-dir (cdr cur-dir)))
		   ((string= (car cur-dir) ".")
		    (setq cur-dir (cdr cur-dir)))
		   (t nil))))
      (dolist (e cur-dir)
	(push e ref-dir))
      (mapconcat 'identity  (nreverse (cons "" ref-dir)) "/") )))

(defun html2texi-anchor-escape (anchor)
  (let (ret)
    (setq anchor
	  (mapconcat
	   'identity
	   (split-string anchor "-") "--"))
    (mapc
     (lambda (x)
       (if
	(or (and (>= x ?a) (<= x ?z))
	     (and (>= x ?A) (<= x ?Z))
	     (and (>= x ?0) (<= x ?9))
	     (member x '(?_ ?- ?/)))
	   (push (string x) ret)
	 (push (format "-%04x" x) ret)))
     anchor)
    (apply 'concat (nreverse ret))))

(defun html2texi-make-anchor (name &optional escape-function)
  (let* ((anchor (expand-file-name (concat (html2texi-cur-dir) name)))
	 (l-a (length anchor))
	 (l-r (length html2texi-directory-ref))
	 (l (min l-a l-r))
	 (start 0)
	 (i -1))
    (while (and
	    (< (setq i (1+ i)) l)
	    (prog1
		(= (aref anchor i) (aref html2texi-directory-ref i))
	      (and (= (aref anchor i) ?/)
		   (setq start (1+ i))))))
    (setq anchor (list (substring anchor start)))
    (dotimes (i (length (split-string (substring html2texi-directory-ref start))))
      (push "../" anchor))
    (setq anchor (apply 'concat anchor))
    (html2texi-string-escape (funcall (or escape-function 'html2texi-anchor-escape) anchor))))

(defun html2texi-insert-locator (name type &optional escape-function)
  (let ((locator (html2texi-make-anchor name  escape-function)))
    (html2texi-add-locator
     html2texi-locator-list
     (make-instance
      'html2texi-locator-info
      :id locator
      :type type
      :position (point)
      :size (length locator)))
    (insert locator)))

(defun html2texi-simple-markup-handle (xml-expr class-alist preamble postamble)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe
			(and class-attribute
			     (assoc-string (cdr class-attribute) class-alist)))
		      (list preamble postamble))))
    (insert (car pre-post))
   (html2texi-process-xml-expr xml-expr)
   (insert (cadr pre-post))))

(defun html2texi-tag-handler-body (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))


(html2texi-make-simple-markup-handler code)

(defun html2texi-tag-handler-br (xml-expr)
  (insert "@*\n"))

(defun html2texi-tag-handler-div (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(html2texi-make-simple-markup-handler dfn)

(defun html2texi-tag-handler-dl (xml-expr)
  (insert "@table @asis\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "@end table\n"))

(defun html2texi-tag-handler-dt (xml-expr)
  (insert "@item ")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(defun html2texi-tag-handler-dd (xml-expr)
  (html2texi-process-xml-expr xml-expr)
  (insert "\n"))

(html2texi-make-simple-markup-handler em)

(defun html2texi-tag-handler-frameset (xml-expr)
  (insert "\n@menu\n")
  (html2texi-with-restrictions
   (:frameset)
   (html2texi-process-xml-expr xml-expr))
  (insert "@end menu\n"))

(defun html2texi-tag-handler-frame (xml-expr)
  (unless (html2texi-has-restrictions-p html2texi-convert-restrictions-object :framset)
    (html2texi-error "<frame> hors d'un <frameset> !" xml-expr))
  (let (url text)
    (dolist (x (cadr xml-expr))
      (cond
       ((eq (car x) 'src)
	(setq url (cdr x)))
       ((eq (car x) 'name)
	(setq text (cdr x)))))
    (when url
      (html2texi-process-url url text :@menu-item))))

(defun html2texi-tag-handler-hr (xml-expr)
  (insert "@c <hr/>\n"))

(html2texi-make-simple-markup-handler kbd)

(defun html2texi-tag-handler-html (xml-expr)
  "\
Traitement de la balise html."
  (let* ((attributes (nth 1 xml-expr))
	 (lang (assq 'lang attributes)))
    (when lang
      	(oset html2texi-document-information-object :language (cdr lang))))
    (html2texi-process-xml-expr xml-expr))

(html2texi-make-simple-markup-handler strong)

(defun html2texi-handle-string (str)
  (let (ret (pos0 0) pos1 (len (length str)))
    (while (and
	    (< pos0 len)
	    (setq pos1 (string-match "[{}@]" str pos0)))
      (push (substring str pos0 pos1) ret)
      (push (concat "@" (match-string-no-properties 0 str)) ret)
      (setq pos0 (1+ pos1)))
    (when (< pos0 len)
      (push (substring str pos0 pos1) ret))
    (apply 'concat (nreverse ret))))

(defun html2texi-generate-or-reuse-log-buffer ()
  (if (buffer-live-p html2texi-reusable-log-buffer)
	(with-current-buffer html2texi-reusable-log-buffer
	 (let ((inhibit-read-only t))
	   (erase-buffer)
	   html2texi-reusable-log-buffer))
    (setq html2texi-reusable-log-buffer
	  (let* ((compilation-error-regexp-alist
		  '(html-to-texinfo-error
		    html-to-texinfo-warning
		    html-to-texinfo-info))
		 (b (generate-new-buffer html2texi-log-buffer-name)))
	    (with-current-buffer b
	      (compilation-mode)
	      b)))))

(defun html2texi-fatal-error (format-str xml-expr &rest args)
  (html2texi-with-log
   (insert (aref html2texi-log-error-names 0) ":"
	   (html2texi-current-file html2texi-files-to-do) ":"
	   (if (eq xml-expr :html2texi-generic-error)
	       ""
	     (format "%d:" (+ line-number html2texi-line-delta)))
	   (apply
	    'format
	    (concat format-str
		    "\n"
		    (aref html2texi-log-error-names 3)
		    ": <<<-----------\n"
		    (aref html2texi-log-error-names 3)
		    ": xml-expr=%S\n"
		    (aref html2texi-log-error-names 3)
		    ": xml-stack=%S\nInfo: ----------->>>\n")
	    `( ,@args ,xml-expr ,html2texi-xml-stack)) ?\n))
  (apply 'error format-str args))

(defmacro html2texi-with-log (&rest body)
  `(progn
     (setq html2texi-log-buffer (html2texi-generate-or-reuse-log-buffer))
     (display-buffer html2texi-log-buffer)
     (let ((line-number (line-number-at-pos)))
       (with-current-buffer html2texi-log-buffer
	 (let ((inhibit-read-only t))
	   ,@body)))))


(defun html2texi-error (format-str xml-expr &rest args)
  (html2texi-with-log
   (insert (aref html2texi-log-error-names 1) ":"
	   (html2texi-current-file html2texi-files-to-do) ":"
	   (if (eq xml-expr :html2texi-generic-error)
	       ""
	     (format "%d:" (+ line-number html2texi-line-delta)))
	   " "
	   (apply 'format format-str args) ?\n)))

(defun html2texi-warning (format-str xml-expr &rest args)
  (html2texi-with-log
   (insert (aref html2texi-log-error-names 2) ":"
	   (html2texi-current-file html2texi-files-to-do)":"
	   (if (eq xml-expr :html2texi-generic-error)
	       ""
	     (format "%d:" (+  line-number html2texi-line-delta)))
	   (apply 'format format-str args) ?\n)))

(defun html2texi-info (format-str xml-expr &rest args)
  (html2texi-with-log
   (insert (aref html2texi-log-error-names 3) ":"
	   (html2texi-current-file html2texi-files-to-do)":"
	   (if (eq xml-expr :html2texi-generic-error)
	       ""
	     (format "%d:" (+  line-number html2texi-line-delta)))
	   (apply 'format format-str args) ?\n)))

(defun html2texi-decode-url (url)
  "Décode les `%20' et autres séquences hexadécimale"
  (with-temp-buffer
    (insert url)
    (goto-char (point-min))
    (while (re-search-forward "%\\([[:xdigit:]]\\{2\\}\\)" nil t)
      (replace-match (string (math-read-radix
			       (match-string-no-properties 1) 16)) t t))
    (when (eq html2texi-url-encoding :html2texi-utf-8)
      (accents-de-utf-8))
    (buffer-substring (point-min) (point-max))))

(defun html2texi-process-url (url xml-expr &optional type)
  (when (html2texi-has-restrictions-p html2texi-convert-restrictions-object :ref)
    (html2texi-error "Référence recursive" xml-expr))

  (html2texi-with-restrictions
   (:ref)

   (let* ((parsed-url (url-generic-parse-url (html2texi-decode-url url)))
	  (delimiters (case type
			((:@menu-item)  ["* " ":: " ".\n"])
			(t  ["@ref{" "," "}"])))
	  url-list
	  i
	  absolute-file-name
	  locator
	  relative-file-name
	  qualified-locator)
     ;; petit hack parce que url-generic-parse-url ne fait pas complètement le
     ;; boulot
     (when (and
	    (null  (aref parsed-url 1))
	    (setq i (string-match "#" (aref parsed-url 6)))
	    (null (aref parsed-url 7)))
       (aset parsed-url 7 (substring (aref parsed-url 6) (1+ i)))
       (aset parsed-url 6 (substring (aref parsed-url 6) 0 i)))

     ;; Analyse des nom de fichiers
     (setq absolute-file-name
	   (expand-file-name (aref parsed-url 6)
			     (file-name-directory (html2texi-current-file html2texi-files-to-do)))
	   relative-file-name (file-relative-name absolute-file-name html2texi-directory-ref))

     (push "@uref{" url-list) ; ça peut être défait ensuite
     ;; URL
     (if (and (eq (aref parsed-url 0)
		  'cl-struct-url)
	      (null (aref parsed-url 1)))
	 ;; cas où il n'y a pas de protocole
	 (cond
	  ;; on pointe vers un fichier HTML, ce n'est donc pas forcément une URL interne
	  ;; => cas suspect
	  ((member (file-name-extension absolute-file-name)
		   '("html" "htm"))
	   (html2texi-add-file-to-do html2texi-files-to-do absolute-file-name)
	   (setq locator (aref parsed-url 7)
		 qualified-locator (if locator (concat relative-file-name "#" locator) relative-file-name))

	   (if (and (file-exists-p absolute-file-name)
		    (null (file-name-absolute-p relative-file-name)))
	       (setq
		url-list (list
			  (setq qualified-locator (html2texi-make-anchor qualified-locator))
			  (aref delimiters 0)))
	     (push (html2texi-string-escape qualified-locator) url-list)))

	  ;; cas d'une URL interne
	  ((and (string= "" (aref parsed-url 6))
		(setq locator (aref parsed-url 7)))
	   (setq qualified-locator
		 (concat
		  (file-relative-name
		   (html2texi-current-file html2texi-files-to-do)
		   html2texi-directory-ref)
		  "#" locator)
		 url-list
		 (list
		  (setq qualified-locator (html2texi-make-anchor qualified-locator))
		  (aref delimiters 0))))

	  ;; cas d'une URL dont on est sûr quelle est externe.
	  (t
	   (push (setq qualified-locator (html2texi-string-escape url)) url-list)))
       ;; cas où il y a un protocol
       (if (and (string= (aref parsed-url 1) "file")
		(file-exists-p absolute-file-name)
		(null (file-name-absolute-p relative-file-name))
		(member (file-name-extension absolute-file-name) '("html" "htm")))
	   ;; cas d'une URL interne
	   (setq 
	    locator (aref parsed-url 7)
	    qualified-locator (if locator (concat relative-file-name "#" locator) relative-file-name)
	    url-list (list
		      (setq qualified-locator (html2texi-make-anchor qualified-locator))
		      (aref delimiters 0)))
	 (push  (setq qualified-locator (html2texi-string-escape url)) url-list)))
     ;; Text
     (when xml-expr
       (push (aref delimiters 1) url-list)
       (push xml-expr url-list))
     (push (aref delimiters 2) url-list)
     (dolist (v (nreverse url-list))
       (when (eq qualified-locator v)
	 (html2texi-add-locator
	  html2texi-locator-list
	  (make-instance
	   'html2texi-locator-info
	   :id qualified-locator
	   :type type
	   :position (point)
	   :size (length qualified-locator)))
	 (when (eq type :@menu-item)
	   (html2texi-add-menu-reference html2texi-files-to-do 
					 absolute-file-name
					 qualified-locator)))
       (cond
	((stringp v) (insert v))
	((consp v) (html2texi-process-xml-expr v))) ))))

(defun html2texi-tag-handler-center (xml-expr)
  (let ((start-point (point))
	(start-ln (line-number-at-pos))
	end-mark)
    (html2texi-process-xml-expr xml-expr)
    (when (and (<= (point) (+ start-point html2texi-@center-max-size))
	       (> (point) start-point)
	       ;; test histoire que le code soit à l'épreuve du temps : il se
	       ;; pourrait qu'on soit déjà centré pour une autre raison.
	       (null (save-excursion
		       (goto-char start-point)
		       (looking-at "\\(\n\\|\\s-\\)*@center\\>")))
	       (let (to-do
		     (ok t)
		     xml-expr
		     (l (cdr-safe (cdr-safe xml-expr))))
		 (while (and ok (or to-do l))
		   (if l
		       (progn
			 (setq xml-expr (pop l))
			 (cond
			  ((stringp xml-expr))
			  ((and (consp xml-expr)
				(memq (car xml-expr) html2texi-allowed-markup-in-@center))
			   (push xml-expr to-do))
			  (t (setq ok nil))))
		     (setq l (cdr-safe (cdr-safe (pop to-do))))))
		 (when ok
		   (setq end-mark (point-marker))
		   (goto-char start-point)
		   (insert "\n@center ")
		   (while (search-forward "\n" end-mark t)
		     (delete-char -1)
		     (insert 32))
		   (goto-char end-mark)
		   (set-marker end-mark nil)))))))

(html2texi-make-simple-markup-handler i)

(defun html2texi-tag-handler-li (xml-expr)
  (insert "\n@item\n")
  (unless (memq (caadr html2texi-xml-stack) '(ol ul))
    (html2texi-fatal-error "<li> était inattendu." xml-expr ))
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-link (xml-expr)
  )

(defun html2texi-tag-handler-ol (xml-expr)
  (insert "\n@enumerate")
   (html2texi-process-xml-expr xml-expr)
  (insert "\n@end enumerate\n"))

(defun html2texi-tag-handler-p (xml-expr)
  (insert "\n\n")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n\n"))

(defun html2texi-tag-handler-tbody (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-thead (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-tfoot (xml-expr)
  (html2texi-process-xml-expr xml-expr))

(defun html2texi-tag-handler-ul (xml-expr)
  (insert "\n@itemize")
  (html2texi-process-xml-expr xml-expr)
  (insert "\n@end itemize\n"))

(defun html2texi-tag-handler-span (xml-expr)
  (insert "@c span: (<span #1>#2</span> => #2.")
  (html2texi-default-handling xml-expr "span: ")
  (html2texi-process-xml-expr xml-expr)
  (insert "@c span: )\n"))

(defun html2texi-tag-handler-style (xml-expr)
  )

(defun html2texi-tag-handler-meta (xml-expr)
  (unless (and (nth 1 html2texi-xml-stack)
	       (eq (caadr html2texi-xml-stack) 'head))
    (html2texi-fatal-error "<meta> inattendu." xml-expr))
  ;; traitement du meta...
  (let* ((attribute-list (nth 1 xml-expr))
	 (http-equiv (assq 'http-equiv attribute-list))
	 (name (assq 'name attribute-list))
	 (content (assq 'content attribute-list)))
    (cond
     ((and (consp name)
	   (consp content)
	   (progn
	     (setq name (cdr name)
		   content (cdr content))
	     (stringp name))
	   (stringp content))
      (cond
       ((string= name "author")
	(oset html2texi-document-information-object :author content))
       ((string= name "language")
	(when (string-match "\\`\\([a-z]\\{2\\}\\(-[A-Z]\\{2\\}\\)?\\)\\'" content)
	  (let ((language (match-string-no-properties 1 content)))
	    (when (= (length language) 5)
	      (aset language 2 ?_))
	    (oset html2texi-document-information-object :language language))))))
     ((and (consp http-equiv)
	   (consp content)
	   (progn (setq http-equiv (cdr http-equiv))
		  (stringp http-equiv))
	   (progn (setq content (cdr content))
		  (stringp content)))
      (setq http-equiv (downcase http-equiv))
      (cond
       ((and (string= http-equiv "content-type")
	     (string-match "charset\\s-*=\\s-*\\([-a-z0-9]+\\)" content))
	(oset html2texi-document-information-object
	      :encoding
	      (match-string-no-properties 1 content)));
       )))))

(defun html2texi-tag-handler-pre (xml-expr)
  (let ((kes html2texi-keep-empty-strings))
    (setq html2texi-keep-empty-strings t)
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-keep-empty-strings kes)))

(defun hmtl2texi-to-plain-text (xml-expr &rest flags)
  (let (ret anchor)
    (dolist (xml-expr (cddr xml-expr))
      (cond
       ((stringp xml-expr)
	(push xml-expr ret))
       ((consp xml-expr)
	(push xml-expr html2texi-xml-stack)
	(cond
	 ((and (eq (car xml-expr) 'a)
	       (setq anchor (assq 'name (nth 1 xml-expr))))
	  (push (concat
		 (file-relative-name
		  (html2texi-current-file html2texi-files-to-do)
		   html2texi-directory-ref)
		 "#" (cdr anchor))
		html2texi-flushable-anchors) ))
	(let ((str  (hmtl2texi-to-plain-text xml-expr)))
	  (and (null (string= str ""))
	       (push str ret)))
	(pop html2texi-xml-stack))
       (t (html2texi-fatal-error "Expression XML inattendue." xml-expr))))
    (setq  ret (mapconcat 'identity (nreverse ret) " "))
    (if (memq :one-line flags)
	(mapconcat 'identity (split-string ret "\n") " ")
      ret)))


(defun html2texi-tag-handler-title (xml-expr)
  (unless (and  (nth 1 html2texi-xml-stack)
		(eq  (caadr html2texi-xml-stack) 'head))
    (html2texi-fatal-error "<title> inattendu." xml-expr))
  (setq xml-expr (cddr xml-expr))
  (let ((str  (hmtl2texi-to-plain-text xml-expr)))
    (setq str (split-string str "\n")
	  str (mapconcat 'identity str " "))
    (unless (string= str "")
      (oset html2texi-document-information-object :title str))))

(defun html2texi-string-escape (str &optional flatten)
  (cond
   ((stringp str)
    (with-temp-buffer
      (insert str)
      (goto-char (point-min))
      (while (re-search-forward "[,@{}]" nil t)
	(cond
	 ((string= (match-string-no-properties 0) ",")
	  (replace-match "@comma{}"))
	 ((member (match-string-no-properties 0) '("@" "{" "}"))
	  (replace-match (concat "@" (match-string-no-properties 0))))))
      (when flatten
	(goto-char (point-min))
	(while (re-search-forward "\n\\(\\s-*\\)" nil t)
	  (replace-match (if (> 0 (length (match-string 1))) " " "") t t)))
      (buffer-substring (point-min) (point-max))))
   ((and (consp str) (car-safe str))
    (cond
     ((eq (car str) 'span)
      (with-temp-buffer
	(insert "@c span: (<span #1>#2</span> => string-escape of #2.")
	(html2texi-default-handling str "span: ")
	(insert (html2texi-string-escape  (nth 2 str) flatten))
	(insert "@c span: )\n")
	(buffer-substring (point-min) (point-max))))
     (t (html2texi-fatal-error "Une chaîne était attendue" :html2texi-generic-error str))))
   (t  (html2texi-fatal-error "Une chaîne était attendue" :html2texi-generic-error str))))

(defun html2texi-tag-handler-img (xml-expr)
  (let (filename width height alttext extension)
    (dolist (x (cadr xml-expr))
      (cond
       ((eq (car x) 'src)
	(setq filename (cdr x)))
       ((eq (car x) 'alt)
	(setq alttext (cdr x)))))
    (unless filename
      (html2texi-fatal-error "src=... était attendu" xml-expr))
    (setq filename (html2texi-decode-url filename))
    (setq extension (file-name-extension filename)
	  filename (file-name-sans-extension filename))
    (when (member extension '("png" "jpg" "jpeg" "eps" "txt"))
      (setq extension nil))
    (insert "@image{" (html2texi-make-anchor filename (symbol-function 'identity)))
    (let ((remainder (list width height alttext extension)))
	(while remainder
	  (if (let (non-empty)
		(mapc (lambda (x) (setq non-empty (or non-empty (stringp x))))
		      remainder)
		non-empty)
	      (insert "," (or (pop remainder) "") )
	    (setq remainder nil); rompt la boucle (while remainder...)
	    ))
	(insert "}"))))

(defun html2texi-tag-handler-head (xml-expr)
  (unless html2texi-ignore-head
    (html2texi-process-xml-expr xml-expr)
    (setq html2texi-ignore-head t)))

(defun html2texi-tag-handler-noframes (xml-expr)
  )

(if (boundp 'html2texi-handler-hash-table)
    (makunbound 'html2texi-handler-hash-table))

(defconst html2texi-handler-hash-table
  (let ((ht (make-hash-table)))
    (dolist (v '(a b body center code dfn dl dt dd em i kbd li p
    hr div ol ul pre head meta title frameset frame noframes span
    strong table tbody thead tfoot th tr td h1 h2 h3 h4 h5 h5
    html link br img samp style sup sub tt))
      (puthash v (symbol-function (intern (concat "html2texi-tag-handler-" (symbol-name v))))
	       ht))
    ht)
  "Table de hashage des traitements associés à chaque balise HTML"
  )

(defun html2texi-remove-empty-strings (xml-expr)
  (setq xml-expr (cdr xml-expr))
  (save-match-data
  (while (cdr xml-expr)
    (if (and (stringp (cadr xml-expr))
	     (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'" (cadr xml-expr)))
	(setcdr xml-expr (cddr xml-expr))
      (setq xml-expr (cdr xml-expr))))))

(defun html2texi-process-xml-expr (xml-expr)
  (push xml-expr html2texi-xml-stack)
  (dolist (xml-expr (cddr xml-expr))
    (cond
     ((consp xml-expr)
      (push xml-expr html2texi-xml-stack)
      (let ((handler (gethash (intern (downcase (symbol-name (car xml-expr))))
			      html2texi-handler-hash-table)))
	(if handler
	    (funcall handler  xml-expr)
	  (html2texi-default-handling xml-expr)))
      (pop html2texi-xml-stack))
     ((stringp xml-expr)
      (and (or html2texi-keep-empty-strings
	       (null (string-match "\\`\\([\n\r]\\|\\s-\\)*\\'"  xml-expr)))
	   (insert (html2texi-handle-string xml-expr))))
     (t (html2texi-fatal-error "Expression XML inattendue %S" xml-expr))))
  (pop html2texi-xml-stack))

(defun html2texi-default-handling (xml-expr &optional prompt)
  (let ((str (split-string (prin1-to-string xml-expr) "\n")))
    (dolist (str-line str)
      (insert "\n@c " (or prompt "") str-line)))
    (insert "\n"))

(defun html2texi-process-region (beg end)
  (goto-char end)
  (let ((end (point-marker))
	is-xhtml
	re-do
	xml-expr)

    ;; Suppression de tout ce qui est en dehors des balise <html> ... </html>
    (goto-char beg)
    (setq html2texi-line-delta (line-number-at-pos))
    (setq is-xhtml
	  (looking-at "[ \t\n\r]*<!DOCTYPE[ \t\n\r]+html[ \t\n\r]+PUBLIC[ \t\n\r]+\"-//W3C//DTD XHTML"))
    (unless (re-search-forward "<html" end t)
      (html2texi-fatal-error "Balise <html> non trouvée" xml-expr))
    (setq html2texi-line-delta (- (line-number-at-pos) (* 2 html2texi-line-delta)))
    (delete-region beg (match-beginning 0))
    (unless (re-search-forward ">" end t)
      (html2texi-fatal-error "Clôture de la balise <html> trouvée" xml-expr))
    (unless  (re-search-forward "</html" end t)
      (html2texi-fatal-error "Balise </html> non trouvée trouvée" xml-expr))
    (unless (re-search-forward ">" end t)
      (html2texi-fatal-error "Clôture de la balise </html> trouvée" xml-expr))
    (delete-region (match-end 0) end)

    (or is-xhtml
	(html2texi-make-html-clean-xml beg end))

    (setq xml-expr
	  (condition-case
	      sig
	      (xml-parse-region beg end)
	    (error
	     (if (consp sig)
		 (html2texi-warning "File is XHTML but xml-parser reported error `%S'"
				 :html2texi-generic-error
				 (cdr sig))
	       (html2texi-warning "File is XHTML but xml-parser reported errors"
				  :html2texi-generic-error))
		  (if is-xhtml :html2texi-redo nil)))
	  xml-expr
	  (if (eq xml-expr :html2texi-redo)
	       (progn
		 (html2texi-make-html-clean-xml beg end)
		 (xml-parse-region beg end))
	     xml-expr))

    (delete-region beg end)
    (set-marker end nil)
    xml-expr))

(if t
;; plus partique pour déboguer qu'un vrai tampon temporaire
    (defmacro html2texi-with-temp-buffer (&rest body)
      (let ((cur-buff (make-symbol "cur-buff")))
	`(with-current-buffer
	       (let (( ,cur-buff (get-buffer "*HTML2TEXI Temp*")))
		 (and ,cur-buff (kill-buffer ,cur-buff))
		 (get-buffer-create "*HTML2TEXI Temp*"))
       (erase-buffer)
       ,@body)))
  ;;
  (defmacro html2texi-with-temp-buffer (&rest body)
    `(with-temp-buffer ,@body)))

(defun html2texi-make-texi-buffer (&optional buffer )
  (let* ((start-buffer (or buffer (current-buffer)))
	 xml-expr
	 (start-filename  (or (buffer-file-name start-buffer) (buffer-name)))
	 (start-filename-ext (file-name-extension start-filename))
	 done-links-list
	 texi-buffer)
    (setq html2texi-texi-buffer-name
	  (concat (concat  (file-name-sans-extension   (file-name-nondirectory start-filename))
			   ".texi")))

    (unless (or (member start-filename-ext '("html" "htm"))
		(y-or-n-p (format "le tampon %s n'a pas une extension html, continuer?"
				  start-filename)))
      (html2texi-fatal-error "Fichier `%s' sans extension html" :html2texi-generic-error start-filename))
    (setq texi-buffer (get-buffer-create html2texi-texi-buffer-name))
    (set-buffer texi-buffer)
    (erase-buffer)
    (dolist (v html2texi-texi-buffer-local-variables)
      (set (make-local-variable v) nil))
    (push (cons default-directory "./") html2texi-directory-stack)
    (setq html2texi-directory-ref default-directory)
    (html2texi-add-file-to-do html2texi-files-to-do start-filename)
    (let ((in-menu (oref html2texi-files-to-do :in-menu)))
      (puthash start-filename 
	       (make-instance 'html2texi-node-info :locator "Top")
	       in-menu))
    (while (html2texi-files-has-to-do html2texi-files-to-do)
      (let ((file-name (html2texi-get-next-file-next-to-do html2texi-files-to-do)))
	(if (file-exists-p file-name)
	    (progn
	      (let* ((dir (file-name-as-directory
			   (file-name-directory file-name)))
		     (rel-file-name (file-relative-name file-name html2texi-directory-ref))
		     (rel-dir   (let ((d (file-name-directory rel-file-name )))
				  (if d (file-name-as-directory d)
				    "./"))))
		(push (cons dir rel-dir) html2texi-directory-stack)
		(if (= (oref html2texi-files-to-do :added-file-count) 1)
		    (progn
		      ;; premier fichier traité
		      (insert "@anchor{")
		      (html2texi-insert-locator rel-file-name :@anchor)
		      (insert "}\n"))
		  ;; fichier suivant traité
		  (insert "\n@node ")
		  (html2texi-insert-locator rel-file-name :@node)
		  (insert "\n"))
		(html2texi-with-temp-buffer
		 (insert-file-contents file-name)
		 (accents-de-html)
		 (html2texi-make-html-clean-xml (point-min) (point-max))
		 (setq xml-expr (html2texi-process-region (point-min) (point-max))))
		(unless (eq 'html (caar xml-expr))
		  (html2texi-fatal-error "Résultat d'analyse XML inattendu" xml-expr))
		(setq xml-expr (car xml-expr))
		(html2texi-process-xml-expr xml-expr)
		(html2texi-files-make-menu-maybe html2texi-files-to-do)
		(pop html2texi-directory-stack)	))
	  (html2texi-warning "Le fichier `%s' n'existe pas!" :html2texi-generic-error file-name))))))

(defun html2texi-insert-doc-info ()
  (let ((author
	 (html2texi-string-escape
	  (if (slot-boundp html2texi-document-information-object :author)
	      (oref  html2texi-document-information-object :author)
	    "AUTHOR")))
	(title 	 (html2texi-string-escape
		  (if (slot-boundp html2texi-document-information-object :title)
		      (oref  html2texi-document-information-object :title)
		    "TITLE")))
	(language (if (slot-boundp html2texi-document-information-object :language)
		       (cons "" (html2texi-string-escape (oref html2texi-document-information-object
							       :language)))
		    (cons "@c " "LANGUAGE")))
	(encoding  (html2texi-string-escape
		  (if (slot-boundp html2texi-document-information-object :encoding)
		      (oref  html2texi-document-information-object :encoding)
		    "iso-8859-1"))))

    (goto-char (point-min))
    (insert "\\input texinfo   @c -*-mode:texinfo; coding:" (downcase encoding) "-*-
@setfilename " (file-name-sans-extension (buffer-name)) ".info
" (car language) "@documentlanguage " (cdr language) "
@documentencoding "  (if (let ((case-fold-search t))
			   (string-match "\\`\\(us\\|utf\\|iso\\)" encoding))
			 (upcase encoding) encoding) "
@copying
This manual is for PROGRAM, version VERSION.

Copyright @copyright{} YEARS COPYRIGHT-OWNER.

@quotation
Permission is granted to ...
@end quotation
@end copying

@titlepage
@title " title "@c NAME-OF-MANUAL-WHEN-PRINTED
@c @subtitle SUBTITLE-IF-ANY
@c @subtitle SECOND-SUBTITLE
@author " author "

@c  The following two commands
@c  start the copyright page.
@page
@vskip 0pt plus 1filll
@insertcopying

Published by ...
@end titlepage

@c So the toc is printed at the start.
@contents

@ifnottex
@node Top
@top TITLE

This manual is for PROGRAM, version VERSION.
@end ifnottex
")
    (oset html2texi-document-information-object :header-size (- (point) (point-min)))
    (goto-char (point-max))
    (insert "
@bye") ))

(defun html2texi-beautify-locator (locator)
  (with-temp-buffer
    (insert locator)
    (goto-char (point-min))
    (when (re-search-forward "-002ehtml?\\(-0023\\)?" nil t)
      (if
	  (match-string 1)
	  (replace-match "_" t t)
	(replace-match "" t t)))
    (goto-char (point-min))
    (while (re-search-forward "-[[:xdigit:]]\\{4\\}" nil t)
      (replace-match "-" t t))
    (buffer-substring (point-min) (point-max))))

(defun html2texi-post-process ()
  "Embellit les identificateur de localisation selon
`html2texi-beautify-locators'. Puis pemplace les double lignes
vides en ligne vides simples."
  ;; embellissement des indentificateurs de localisateur
  (when html2texi-beautify-locators
    (html2texi-info "Embellissement des localisateurs..." :html2texi-generic-error )
    (let ((offset (oref html2texi-document-information-object :header-size)))
      (doli2->-dolist (v html2texi-locator-list)
		      (oset v :position (+ offset (oref v :position)))))
    (let ((dummy-tail (html2texi-locator-info "Factice"))
	  key-val-pairs
	  (table (oref html2texi-locator-list :hash-table)))
      (doli2-add-last html2texi-locator-list dummy-tail)
      (maphash
       #'(lambda (key val)
	   (push (cons key val) key-val-pairs))
       table)
      (dolist (key-val key-val-pairs)
	(let* ((key (car key-val))
	      (val (cdr key-val))
	      (beautiful-key (html2texi-beautify-locator key))
	      delta-pos-inc delta-pos locator-list
	      (key-length (length key))
	      cur next)
	  (if (string= beautiful-key key)
	      (puthash key nil table)
	    (setq delta-pos-inc (- (length beautiful-key) key-length)
		  delta-pos 0
		  locator-list (reverse (cons dummy-tail val))
		       next (pop locator-list))
	    (save-excursion
	      (while (null (eq next dummy-tail))
		(setq cur next
		      next (pop locator-list))
		(goto-char (+ (oref cur :position) delta-pos))
		(let* ((from (point))
		       (to (+ from key-length)))
		  (unless (string= (buffer-substring-no-properties from to) key)
		    (html2texi-fatal-error "Tampon corrompu: trouvé `%s' et attendait `%s'"
					   :html2texi-generic-error
					   (buffer-substring-no-properties from to)
					   key))
		  (delete-region from to))
		(insert beautiful-key)
		(setq delta-pos (+ delta-pos delta-pos-inc))
		(doli2-x>x-dolist
		 (v cur next)
		 (oset v :position (+ (oref v :position) delta-pos)))
		(doli2-remove html2texi-locator-list cur)))
	    (remhash key table)
	    (puthash beautiful-key t table))))
      (doli2-remove-last  html2texi-locator-list)))

  ;; suppression des doubles lignes en trop
  (goto-char (point-min))
  (while (re-search-forward "\\(^[ \t]*\n\\)\\{2,\\}" nil t)
    (replace-match "\n"))
  (normal-mode))

(defun html2texi-save-texi-buffer-maybe ()
  "Sauvegarde le tampon avec le fichier Texinfo."
  (if
      (buffer-file-name) ; le tampon visite déjà un fichier
      (basic-save-buffer)
   (write-file (buffer-name) html2texi-save-texi-buffer-confirm-p)))

;;;###autoload
(defun html2texi ()
  (interactive)
  (let (html2texi-keep-empty-strings
	html2texi-xml-stack
	html2texi-texi-buffer-name
	(html2texi-line-delta 0)
	html2texi-ignore-head
	html2texi-directory-stack
	html2texi-flushable-anchors
	html2texi-directory-ref
	(html2texi-locator-list (html2texi-locator-listing "À embellir"))
	(html2texi-files-to-do (html2texi-files-to-do-listing "À traiter"))
	(html2texi-document-information-object (html2texi-document-information "Info doc"))
	(html2texi-log-buffer (and html2texi-reuse-log-buffer html2texi-log-buffer))
	(html2texi-convert-restrictions-object (html2texi-convert-restrictions "Restrictions de conversion")))
  (html2texi-make-texi-buffer)
  (html2texi-insert-doc-info)
  (html2texi-post-process)
  (html2texi-info "Fin de la conversion en HTML !" :html2texi-generic-error )
  (html2texi-save-texi-buffer-maybe)))

;; Log compilation mode stuff
(defun html2texi-define-error-regexps ()
  (dolist (v `(
	       (html-to-texinfo-error
		.
		(
		 ,(concat "^" (regexp-opt (list (aref html2texi-log-error-names 0)
						(aref html2texi-log-error-names 1)))
			  ":\\(" html2texi-filepath-re
			  "\\):\\(?:\\([0-9]+\\):\\)?.*$")
		 1; File
		 2; Line
		 0; Error
		 ))
	       (html-to-texinfo-warning
		.
		(
		 ,(concat "^" (aref html2texi-log-error-names 2)
			  ":\\(" html2texi-filepath-re
			  "\\):\\(?:\\([0-9]+\\):\\)?.*$")
		 1; File
		 2; Line
		 1; Warning
		 ))
	       (html-to-texinfo-info
		.
		(
		 ,(concat "^" (aref html2texi-log-error-names 3)
			  ":")
		 nil; File
		 nil; Line
		 2; Warning
		 ))))
    (add-to-list 'compilation-error-regexp-alist (car v))
    (let ((cell (or (assq (car v) compilation-error-regexp-alist-alist)
		    (car (push (cons  (car v) nil) compilation-error-regexp-alist-alist)))))
      (setcdr cell (cdr v))  )))
(html2texi-define-error-regexps)

;;; html-to-texinfo.el ends here

Revision-number: 31
Prop-content-length: 137
Content-length: 137

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2012-11-29T20:29:00.000000Z
K 7
svn:log
V 35
Suppression typage second argument

PROPS-END

Node-path: trunk/lisp/doubly-linked-list.el
Node-kind: file
Node-action: change
Text-content-length: 8704
Text-content-md5: 1bd79de6c9a6671eb677bdd277e74695
Content-length: 8704

;;; doubly-linked-list.el --- -*- coding: iso-8859-1 -*-
;; Copyright 2012 Vincent Belaïche
;;
;; Author: Vincent Belaïche <vincentb1@users.sourceforge.net>
;; Version: $Id: doubly-linked-list.el,v 1.4 2012-11-29 20:29:00 Vincent Exp $
;; Keywords:
;; X-URL: not distributed yet

;;
;; This software is governed by the CeCILL license under French law and abiding
;; by the rules of distribution of free software.  You can use, modify and/ or
;; redistribute the software under the terms of the CeCILL license as circulated
;; by CEA, CNRS and INRIA at the following URL "http://www.cecill.info".
;;
;; As a counterpart to the access to the source code and rights to copy, modify
;; and redistribute granted by the license, users are provided only with a
;; limited warranty and the software's author, the holder of the economic
;; rights, and the successive licensors have only limited liability.
;;
;; In this respect, the user's attention is drawn to the risks associated with
;; loading, using, modifying and/or developing or reproducing the software by
;; the user in light of its specific status of free software, that may mean that
;; it is complicated to manipulate, and that also therefore means that it is
;; reserved for developers and experienced professionals having in-depth
;; computer knowledge. Users are therefore encouraged to load and test the
;; software's suitability as regards their requirements in conditions enabling
;; the security of their systems and/or data to be ensured and, more generally,
;; to use and operate it in the same conditions as regards security.
;;
;; The fact that you are presently reading this means that you have had
;; knowledge of the CeCILL license and that you accept its terms.
;;
;;; Commentary:

;;

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'doubly-linked-list)

;;; Code:
(require 'eieio)
(eval-when-compile
  (require 'cl))



;;;;##########################################################################
;;;;  User Options, Variables
;;;;##########################################################################

(defclass doli2-list ()
  ((head
    :initarg :head
    :initform nil
    :documentation "Pointe sur le premier élément de la liste si
   la liste est non-vide.")
   (tail
    :initarg :tail
    :initform nil
    :documentation "Pointe sur le dernier élément de la liste si
    la liste est non vide.")
   (size
    :initarg :size
    :initform 0
    :documentation "Nombre d'éléments de la liste."))
  :documentation "Liste doublement chaînée.")

(defclass doli2-element ()
  ((next
    :initarg :next
    :initform nil
    :type (or null doli2-element)
    :documentation "Élément suivant dans la liste, `nil' pour le
    dernier élément.")
   (previous
    :initarg :previous
    :initform nil
    :type (or null doli2-element)
    :documentation "Élément précédent dans la liste, `nil'
    pour le dernier élément."  ))
  :abstract t
  :documention "Classe de base pour les éléments d'objets de classe
  `doli2-list'.")

(defgeneric doli2-equal ((this doli2-element) (other doli2-element))
  "Comparaison de deux `doli2-element'.")

(defmethod doli2-add-first
  ((this doli2-list) elt
   ;(elt doli2-element )
   )
  "Ajoute un nouvel élément en tête de liste."
  (when
      (or (oref elt :next)
	  (oref elt :previous))
    (error "L'élément est déjà dans une liste"))
  (let ((size (oref this :size)))
    (if (= 0 size)
	(oset this :tail elt)
      (let ((head  (oref this :head)))
	(oset elt :next head)
	(oset head :previous elt)))
    (oset this :head elt)
    (oset this :size (1+ size))))

(defmethod doli2-add-last
  ((this doli2-list) elt
   ;(elt doli2-element)
   )
  "Ajoute un nouvel élément en queue de liste."
  (when
      (or (oref elt :next)
	  (oref elt :previous))
    (error "L'élément est déjà dans une liste"))
  (let ((size (oref this :size)))
    (if (= 0 size)
	  (oset this :head elt)
      (let ((tail  (oref this :tail)))
	(oset elt :previous tail)
	(oset tail :next elt)))
    (oset this :tail elt)
    (oset this :size (1+ size))))

(defmethod doli2-remove
  ((this doli2-list)
   elt;(elt doli2-element)
   )
  "Retranche `elt' de la liste `this'."
  (let ((size (oref this :size)))
    (cond
     ((>= 0 size)
      (error "Liste vide %S" this))
     ((= 1 size)
      (oset this :head nil)
      (oset this :tail nil)
      (oset this :size 0))
     ((eq (oref this :head) elt)
      (let ((next (oref elt :next)))
	(oset this :head next)
	(oset next :previous nil)
	(oset this :size (1- size))
	(oset elt :previous nil)
	(oset elt :next nil)))
     ((eq (oref this :tail) elt)
      (let ((previous (oref elt :previous)))
	(oset this :tail previous)
	(oset previous :next nil)
	(oset this :size (1- size))
	(oset elt :previous nil)
	(oset elt :next nil)))
     (t
      (let ((next (oref elt :next))
	    (previous (oref elt :previous)))
	(oset next :previous previous)
	(oset previous :next next)
	(oset this :size (1- size))
	(oset elt :previous nil)
	(oset elt :next nil))))))

(defmethod doli2-remove-first
  ((this doli2-list))
  "Retranche le premier élément de la liste THIS. Génère une
erreur si la liste est vide."
  (let ((ret (oref this :head))
	(size (1- (oref this :size))))
    (if (> 0 size)
	(error "Liste vide")
      (oset this :size size)
      (if (< 0  size)
	  (let ((next (oref ret :next)))
	    (oset this :head next)
	    (when next (oset next :previous nil)))
	(oset this :head nil)
	(oset this :tail nil)))
     (oset ret :next nil)
     ret))

(defmethod doli2-remove-last
  ((this doli2-list))
  "Retranche le dernier élément de la liste THIS. Génère une
erreur si la liste est vide."
  (let ((ret (oref this :tail))
	(size (1- (oref this :size))))
    (if (> 0 size)
	(error "Liste vide")
      (oset this :size size)
      (if (< 0  size)
	 (let ((previous  (oref ret :previous)))
	  (oset this :tail previous)
	  (when previous (oset previous :next nil)))
	(oset this :tail nil)
	(oset this :head nil)))
     (oset ret :previous nil)
     ret))

(defmacro doli2-.>x-dolist (spec &rest body)
  "(doli2-.>x-dolist (V FROM TO) BODY) itère V sur BODY depuis FROM
inclus, jusqu'à TO exclus en parcourant la liste dans le sens normal."
  `(let ((,(car spec) ,(cadr spec)))
     (while (null (eq ,(car spec) ,(caddr spec)))
       ,@body
       (setq ,(car spec) (oref ,(car spec) :next)))))

(defmacro doli2-x>x-dolist (spec &rest body)
  "(doli2-x>x-dolist (V FROM TO) BODY) itère V sur BODY depuis FROM
exclus, jusqu'à TO exclus en parcourant la liste dans le sens normal."
  `(let ((,(car spec) (oref ,(cadr spec) :next)))
     (unless (eq ,(car spec) ,(caddr spec))
       (while
	   (progn
	     ,@body
	     (setq ,(car spec) (oref ,(car spec) :next))
	     (null (eq ,(car spec) ,(caddr spec))))))))

(defmacro doli2-.>-dolist (spec &rest body)
  "(doli2-.>-dolist (V FROM) BODY) itère sur BODY depuis FROM inclus,
jusqu'à la fin inculse de la liste en parcourant la liste dans le
sens normal."
  `(let ((,(car spec) ,(cadr spec)))
     (while
       (progn
	 ,@body
	 (setq ,(car spec) (oref ,(car spec) :next))))))

(defmacro doli2-x>-dolist (spec &rest body)
  "(doli2-x>-dolist (V FROM) BODY) itère sur BODY depuis FROM exclus,
jusqu'à la fin inculse de la liste en parcourant la liste dans le
sens normal."
  `(let ((,(car spec) (oref ,(cadr spec) :next)))
     (when ,(car spec)
       (while
	   (progn
	     ,@body
	     (setq ,(car spec) (oref ,(car spec) :next)))))))

(defmacro doli2-x<.-dolist (args &rest body)
  "(doli2-.>x-dolist (V FROM TO) BODY) itère sur BODY depuis FROM
inclus, jusqu'à TO exclus dans le sens inverse."
  `(let ((,(car spec) ,(cadr spec)))
     (while (null (eq ,(car spec) ,(caddr spec)))
      ,@body
      (setq ,(car spec) (oref ,(car spec) :previous)))))


(defmacro doli2-<.-dolist (spec &rest body)
  "(doli2-<.-dolist (V FROM) BODY) itère V sur BODY depuis FROM
inclus, jusqu'au début inclus de la liste en parcourant la
liste dans le sens inverse."
  `(while
       (progn
	 ,@body
	 (setq ,from (oref ,from :previous)))))

(defmacro doli2->-dolist (spec &rest body)
  "(doli2->-dolist (V LIST) BODY). Itère sur BODY avec V qui
parcourt LIST dans le sens normal."
  `(let ((,(car spec) (oref ,(cadr spec) :head)))
     (while ,(car spec)
       ,@body
       (setq ,(car spec) (oref ,(car spec) :next)))))

(defmacro doli2-<-dolist (spec &rest body)
  "(doli2->-dolist (V LIST) BODY). Itère sur BODY avec V qui
parcourt LIST dans le sens inverse."
  `(let ((,(car spec) (oref ,(cadr spec) :tail)))
     (while ,(car spec)
       ,@body
       (setq ,(car spec) (oref ,(car spec) :previous)))))

(provide 'doubly-linked-list)

;;; doubly-linked-list.el ends here


Revision-number: 32
Prop-content-length: 1118
Content-length: 1118

K 10
svn:author
V 7
Vincent
K 8
svn:date
V 27
2012-11-29T20:51:25.000000Z
K 7
svn:log
V 1014
* html-to-texinfo.el (html2texi-node-info): Ajout des slots menu-entry-text & in-menu-p.
(html2texi-node-info): Typage du slot prev en string.
(html2texi-files-to-do-listing, + initialize-instance, +
html2texi-files-make-menu-maybe): Remplacement  du slot in-menu par un slot
in-menu-table.
(html2texi-files-make-menu-maybe): Initialisation de prev à la
même valeur que up. Utilisation du slot menu-entry-text du slot
retiré depuis la table de hashage du slot in-menu-table pour la
fabrication de l'url. Ajout de next ou prev au node-info,
seulement s'ils sont disponibles.
(html2texi-add-menu-reference): Renommage du slot in-menu en
in-menu-table. Ajout d'un argument in-menu-p.
(html2texi-tag-handler-frame): Correction typo dans symbol :framset -> :frameset.
(html2texi-process-url): Appel de html2texi-add-menu-reference avec argument in-menu-p à t.
(html2texi-tag-handler-img): Échappement des virgules dans le texte alternatif.
(html2texi-make-texi-buffer): Renommage du slot in-menu en in-menu-table.

PROPS-END

Node-path: trunk/lisp/html-to-texinfo.el
Node-kind: file
Node-action: change
Text-content-length: 76235
Text-content-md5: 85052b4b3f26e643d29f32f3aa1c22f5
Content-length: 76235

;;; html-to-texinfo.el --- -*- coding: iso-8859-15 -*-
;; Copyright 2010/2012 Vincent Belaïche
;;
;; Author: Vincent Belaïche <vincent.b.1@hotmail.fr>
;; Version: $Id: html-to-texinfo.el,v 1.16 2012-11-29 20:51:25 Vincent Exp $
;; Keywords: Texinfo, HTML, conversion
;; X-URL: not distributed yet
;;
;; This software is governed by the CeCILL license under French law and abiding
;; by the rules of distribution of free software.  You can use, modify and/ or
;; redistribute the software under the terms of the CeCILL license as circulated
;; by CEA, CNRS and INRIA at the following URL "http://www.cecill.info".
;;
;; As a counterpart to the access to the source code and rights to copy, modify
;; and redistribute granted by the license, users are provided only with a
;; limited warranty and the software's author, the holder of the economic
;; rights, and the successive licensors have only limited liability.
;;
;; In this respect, the user's attention is drawn to the risks associated with
;; loading, using, modifying and/or developing or reproducing the software by
;; the user in light of its specific status of free software, that may mean that
;; it is complicated to manipulate, and that also therefore means that it is
;; reserved for developers and experienced professionals having in-depth
;; computer knowledge. Users are therefore encouraged to load and test the
;; software's suitability as regards their requirements in conditions enabling
;; the security of their systems and/or data to be ensured and, more generally,
;; to use and operate it in the same conditions as regards security.
;;
;; The fact that you are presently reading this means that you have had
;; knowledge of the CeCILL license and that you accept its terms.
;;
;;; Commentary:

;;

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'html-to-texinfo)

;;; Code:

(provide 'html-to-texinfo)
(eval-when-compile
  (require 'cl))
(require 'eieio)
(require 'calc-ext)
(require 'accents-ascii)
(require 'doubly-linked-list)
(require 'compile)

;;;;##########################################################################
;;;;  User Options, Variables
;;;;##########################################################################

(defconst html2texi-suspicious-html-tags
  '("meta" "br" "hr" "link" "img" "frame")
"Liste des balises pour lesquelles le HTML ne suit pas une
syntaxe strictement XML. Par exemple `<br>' est utilisé au lieu
de `<br/>'."  )

(defconst html2texi-suspicious-html-tags-re
  (regexp-opt html2texi-suspicious-html-tags))

(defconst html2texi-non-recursive-tags
  '("p" "li"))

(defconst html2texi-hierarchy-list
  '(
    (li (ul ol))
    (tr (table))
    (th (tr))
    (td (tr))
    (dd (dl))
    (dt (dl))  ))

(defconst html2texi-non-recursive-tags-re
  (regexp-opt html2texi-non-recursive-tags))

(defconst html2texi-filepath-re
  "\\(?:[A-Za-z]:\\)?[- ~+A-Za-z_0-9./\\]+")

(defconst html2texi-texi-buffer-local-variables
  '(html2texi-document-information)
    "Liste des variables déclarées localement au tampon Texinfo.")

(defconst html2texi-allowed-markup-in-@center
  '(img b i em tt strong dfn code)
  "Liste des balises autorisées pour @center.")

(defconst html2texi-@center-max-size 1000)

(defclass html2texi-simple-markup ()
  ((class-dependant
    :initarg :class-dependant
    :initform nil
    :custom '(repeat
	  (list
	   (regexp :tag "clef")
	   (string :tag "prologue")
	   (string :tag "épilogue")
	   (boolean :tag "conserver les espaces et retours chariot")
	   ))
    :documentation "\
Liste d'association dont les éléments sont de la forme
 (CLEF PROLOGUE ÉPILOGUE)

Supposons que l'objet décrit le traitement de la balise TAG,
alors lorsque le code HTML `<TAG class=\"CLEF\">CONTENU</TAG>'
est rencontré, alors il est convertie en le code Texinfo
`PROLOGUE TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU.")
   (preamble
    :initarg :preamble
    :type string
    :documentation "\
Prologue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (postamble
    :initarg :postamble
    :type string
    :documentation "\
Épilogue par défault à utiliser lorsque la balise TAG auquel
l'objet correspond ne comprend pas d'attribut nommé `class' dont
la valeur est une clef de la liste d'association de la case `:class-depedent'.")
   (space-verb
    :initarg :space-verb
    :initform nil
    :type boolean
    :documentation "\
Vrai lorsque les espaces et retours chariot sont à conserver tels quels."
    ))
  :documentation "\
Un object de type `html2texi-simple-markup'
décrit le traitement d'une balise simple comme par exemple
<code>.")

(defclass html2texi-convert-restrictions ()
  ((current-restrictions
    :initarg :current-restrictions
    :initform nil
    :documentation "Liste des restrictions de conversion
    courantes. Par exemple dans un @ref les @table sont
    interdite.")
   (stack
    :initform nil
    :documentation "Pile pour ajouter des restrictions, et les ôter ensuite."))
  :documentation "Contexte des restrictions de conversions courantes.")

(defmethod html2texi-push-restrictions
  ((this html2texi-convert-restrictions) &rest restrictions)
  "Ajoute les restrictions de conversion RESTRICTIONS."
  (let ((current-restrictions (oref this :current-restrictions))
	new-restrictions)
    (dolist (v restrictions)
      (unless (memq v current-restrictions)
	(push v new-restrictions)))
    (oset this :current-restrictions (append new-restrictions
					    (oref this :current-restrictions)))
    (oset this stack (cons new-restrictions (oref this stack)))))

(defmethod html2texi-pop-restrictions
  ((this html2texi-convert-restrictions))
  "Restaure les restrictions d'avant l'appel à `html2texi-push-restrictions'."
  (let* ((new-stack (oref this stack))
	 (latest (pop new-stack))
	 (current (oref this :current-restrictions)))
    (oset this stack new-stack)
    (dotimes (i (length latest))
      (pop current))
    (oset this :current-restrictions current)))

(defmethod html2texi-has-restrictions-p
  ((this html2texi-convert-restrictions) &rest restrictions)
  "Teste si l'une des restrictions dans RESTRICTIONS est en vigueur."
  (let ((current-restrictions (oref this :current-restrictions))
	ret restriction)
    (while restrictions
      (setq restriction (pop restrictions)
	    ret (memq restriction current-restrictions)
	    restrictions (if ret nil restrictions)))
    ret))

(defmacro html2texi-with-restrictions (restrictions &rest body)
  "Effectue BODY avec les restrictions dans la liste RESTRICTIONS."
 `(progn
    (html2texi-push-restrictions html2texi-convert-restrictions-object ,@restrictions)
    (unwind-protect
	(progn ,@body)
      (html2texi-pop-restrictions html2texi-convert-restrictions-object))))

(defclass html2texi-locator-info (doli2-element)
 ((id
   :initarg :id
   :type string
   :documentation "Identifiant d'ancre.")
  (type
   :initarg :type
   :type symbol
   :documentation "Soit `:@anchor', `:@ref',
    `:@node', soit `:@menu-item'."  )
  (position
   :initarg :position
   :type integer
   :documention "Point dans le tampon Texinfo où l'ancre est utilisée.")
  (size
   :initarg :size
   :type integer
   :documentation "Nombre de caractères dans le localisateur."))
:documentation "Détient l'information concernant une ancre
utilisée soit par un `@anchor', soit un `@node', soit un
`@ref'.")

(defclass html2texi-locator-listing (doli2-list)
  ((hash-table
    :initarg :hash-table))
  :documentation "Liste de `html2texi-locator-info', c'est à dire
    de pointeurs sur des `@node', `@ref' ou `@anchor', ou des
    entrée de `@menu', de sorte à embellir les noms de localisateurs a
    postériori."  )

(defmethod initialize-instance ((this html2texi-locator-listing) &rest fields)
  (call-next-method)
  (oset this :hash-table (make-hash-table)))

(defmethod html2texi-add-locator ((this html2texi-locator-listing) locator-info)
  (let* ((locator-id (oref locator-info :id))
	 (table (oref this :hash-table)))
    (doli2-add-last this locator-info)
    (puthash
     locator-id
     (cons locator-info (gethash locator-id table))
     table)))

(defclass html2texi-node-info ()
  ((up
    :initarg :up
    :type string
    :documentation "Identifiant du n½ud supérieur.")
   (next
    :initarg :next
    :type string
    :documentation "Identifiant du n½ud suivant.")
   (prev
    :initarg :prev
    :type string
    :documentation "Identifiant du n½ud précédent.")
   (menu-entry-text
    :initarg :menu-entry-text
    :type string
    :documentation "Texte de l'article de @menu pointant vers le n½ud considéré." )
   (in-menu-p
    :initarg :in-menu-p
    :type boolean
    :initform nil
    :documentation "`t' si le node est déjà référencé dans un menu, `nil' sinon.")
   (locator
    :initarg :locator
    :documentation "Localisateur pour le n½ud que cet objet décrit."))
  :documentation "Objet décriant les liaison d'un n½ud avec les autres n½uds.")


(defclass html2texi-files-to-do-listing ()
  ((already-to-do
   :initarg :already-to-do
   :initform nil
   :documentation "Liste des fichiers qui ont été trouvés comme
   étant à traiter lors du traitement d'un fichier qui a déjà été
   complètement traité.")
   (doing-or-done
    :initarg :doing-or-done
    :initform nil
    :documentation "Liste des fichiers qui ont déjà été traités, le
    premier de la liste est le fichier en cours de traitement."
    )
   (added-file-count
    :initarg :added-file-count
    :initform 0
    :documentation "Nombre de fichier qui est été ajouté à la
  liste des fichiers à traiter.")
   (soon-to-do
   :initarg :soon-to-do
   :initform nil
   :documentation "Liste des fichiers qui sont trouvés comme
   étant à traiter lors du traitement du fichier en cours de
   traitement.")
   (in-menu-table
    :initarg :in-menu-table
    :documentation "Table de hashage contenant tous les fichiers
    qui sont référencés dans un `@menu'. La clef d'indexation est
    le chemin complet du fichier. La valeur d'indexée est un
    `html2texi-node-info'."))
  :documentation "Objet servant à lister les fichiers à
  traiter. Il comprend deux listes: `already-to-do' et
  `soon-to-do' parce que lors du traitement d'un fichier TOTO les
  nouveaux fichiers à traiter sont mis dans `soon-to-do' dans
  l'ordre où ils sont rencontrés, du coup une fois que le fichier
  TOTO a complètement été traité, on inverse cet ordre en
  transvasant le contenu de `soon-to-do' dans `already-to-do'.")

(defclass html2texi-table-fmt-ctxt ()
  ((col-number
    :initarg :col-number
    :initform 0
    :type integer)
   (row-number
    :initarg :row-number
    :initform 0
    :type integer)
   (head-on-row-0
    :initarg :head-on-row-0
    :initform nil
    :type boolean)
   (force-head
    :initarg :force-head
    :initform nil
    :type boolean)
   (col-count
    :initarg :col-count
    :initform 0
    :type integer
    :documentation
    "Nombre de colonnes dans le tableau.")
   (col-info
    :initarg :col-info
    :documentation
    "Liste d'information sur chaque colonne. Le premier élément
    est factice est ne correspond à aucune colonne.")
   (col-info-last
    :initarg :col-info-last
    :documentation
    "Pointe sur la dernière cons-cell de l'attribut `:col-info'.")
   (col-info-length
    :initarg :col-info-length
    :initform 0
    :type integer))
  :documentation "Contexte de formattage d'une table.")

(defmethod initialize-instance ((this html2texi-table-fmt-ctxt) &rest fields)
  (call-next-method)
  (let ((ci (list 0)))
    ;; le premier élément ne correspond pas à une colonne mais servira à
    ;; reduire le vecteur des informations sur chaque colonne
    (oset this :col-info ci)
    (oset this :col-info-last ci)))


(defmethod initialize-instance ((this html2texi-files-to-do-listing) &rest fields)
  (call-next-method)
  (oset this :in-menu-table  (make-hash-table)))

(defmethod html2texi-files-make-menu-maybe ((this html2texi-files-to-do-listing))
  (let* ((soon-to-do (oref this :soon-to-do))
	(in-menu-table (oref this :in-menu-table))
	(up (html2texi-current-file this))
	prev 
	menu-files)
    (dolist (f soon-to-do)
      (let ((node-info (gethash f in-menu-table)))
	(when (and (null  (and node-info
			       (oref node-info :in-menu-p)))
		   (file-exists-p f))
	  (unless node-info
	    (puthash f 
		     (make-instance 
		      'html2texi-node-info
		      :locator (concat "file:" f)) 
		     in-menu-table))
	  (push f menu-files))))
    (when menu-files
      (insert "\n@menu\n")
      (while menu-files
	(let* ((f (pop menu-files))
	       (next (and (cdr menu-files) (cadr menu-files)))
	       (node-info (gethash f in-menu-table))
	       (menu-entry-text (if (and node-info (slot-boundp node-info :menu-entry-text))
				    (oref  node-info :menu-entry-text) "")))
	  (html2texi-process-url (concat "file:" f) menu-entry-text :@menu-item)
	  (oset node-info :up up)
	  (when next
	    (oset node-info :next next))
	  (when prev
	    (oset node-info :prev prev))
	  (setq prev f)))
      (insert "@end menu\n"))))

(defmethod html2texi-files-has-to-do ((this html2texi-files-to-do-listing))
  (or (oref this :already-to-do)
      (oref this :soon-to-do))  )

(defmethod html2texi-current-file ((this html2texi-files-to-do-listing))
  (car (oref this :doing-or-done)))

(defmethod html2texi-get-next-file-next-to-do  ((this html2texi-files-to-do-listing))
  "Récupère le prochain fichier à traiter. L'appel de cette
méthode si aucun fichier n'est à traiter génère une erreur."
  (let ((soon-to-do (oref this :soon-to-do))
	(already-to-do (oref this :already-to-do)))
    (when soon-to-do
      (while soon-to-do (push (pop soon-to-do) already-to-do))
      (oset this :soon-to-do nil))
    (let ((next (pop already-to-do)))
      (oset this :already-to-do already-to-do)
      (oset this :doing-or-done (cons next (oref this :doing-or-done)))
      next)))

(defmethod html2texi-add-file-to-do   ((this html2texi-files-to-do-listing) next)
  "Ajoute le fichier dont le nom absolu est NEXT à la liste des
fichier à traiter. Renvoie `nil' si le fichier était déjà
connu, non-`nil' sinon."
  (unless (or (member next (oref this :already-to-do))
	      (member next (oref this :doing-or-done))
	      (member next (oref this :soon-to-do)))
    (oset this :soon-to-do (cons next (oref this :soon-to-do)))
    (oset this :added-file-count (1+ (oref this :added-file-count)))))

(defmethod html2texi-add-menu-reference  ((this html2texi-files-to-do-listing) file locator &optional in-menu-p)
  (let ((in-menu-table (oref this :in-menu-table)))
    (if (gethash file in-menu-table)
	(html2texi-fatal-error "Double référence au fichier `%s'" :html2texi-generic-error file)
      (puthash file (make-instance 'html2texi-node-info
				   :locator locator
				   :in-menu-p in-menu-p) in-menu-table))))

(defclass html2texi-document-information ()
  ((author
    :initarg :author
    :type string)
   (title
    :initarg :title
    :type string)
   (language
    :initarg :language
    :type string)
   (encoding
    :initarg :encoding
    :type string)
   (header-size
    :initarg :header-size
    :type integer)
   )
  :documentation "Information sur le document Texinfo")

(defun html2texi-texinfo-inside-comment-p ()
  "Renvoie non nil lorsque le point est dans un commentaire Texinfo."
  (save-match-data
    (save-excursion
      (let ((cur (point))
	    (end (progn (end-of-line) (point))))
	(beginning-of-line)
	(and (re-search-forward "\\(^\\|[^@]\\)@c\\(omment\\)\\_>" end t)
	     (<= (match-beginning 0) cur))))))

(defmethod html2texi-handle-simple-markup
  ((this html2texi-simple-markup) xml-expr)
  "\
Traitement d'un balisage simple en insérant le contenue entre un
prologue et un épilogue. Si la l'attribut `class' a une valeur,
et que cette valeur est trouvé dans CLASS-ALIST alors le prologue
et l'épilogue en sont déduit par association, sinon PREAMBLE et
POSTAMBLE sont respectivement utilisé."
  (let* ((class-attribute (assq 'class (nth 1 xml-expr)))
	 (pre-post (or (cdr-safe
			(and class-attribute
			     (assoc-string (cdr class-attribute)
					   (oref this :class-dependant))))
		      (list (oref this :preamble)
			    (oref this :postamble)))))
    (insert (car pre-post))
    (let ((beg (point))
	  end)
      (html2texi-process-xml-expr xml-expr)
      (unless (oref this :space-verb)
	(setq end (point-marker))
	(goto-char beg)
	(while (re-search-forward "[\n\r]\\s-*" nil end)
	  (let ((replace-str " "))
	    (save-match-data
	      (cond
	       ((html2texi-texinfo-inside-comment-p)
		(setq replace-str nil))))
	      (and replace-str (replace-match replace-str t t)))))
	(goto-char end)
	(set-marker end nil))
    (insert (cadr pre-post))))


(defcustom html2texi-save-texi-buffer-confirm-p
  t
  "`nil' pour sauvegarder sans confirmation le tampon Texinfo
après la conversion, `t' sinon."
  :type '(radio
	  (const :tag "Sans confirmation" nil)
	  (const :tag "Demander confirmation" t))
  :group 'html2texi)

(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-reuse-log-buffer t
  "Mettre à `nil' pour que le tampon de sortie des erreurs &
avertissement soit re-généré avec un nom unique à chaque
traitement."
  :type  '(radio
	  (const :tag "Créer un nouveau tampon d'erreurs à chaque conversion." nil)
	  (const :tag "Réutiliser le tampon d'erreurs s'il existe déjà." t))
  :group 'html2texi)

(defcustom html2texi-url-encoding
  :html2texi-utf-8
  "Sélectionne le codage des URL."
  :type '(radio
	  (symbol :tag "UTF-8" :html2texi-utf-8)
	  (symbol :tag "ISO-8859-1" :html2texi-latin-1))
  :group 'html2texi)

(defcustom html2texi-i-simple-markup
  (html2texi-simple-markup "html2texi-i-simple-markup"
   :preamble "@i{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-b-simple-markup
  (html2texi-simple-markup "html2texi-b-simple-markup"
   :preamble "@b{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-code-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :class-dependant '(("file" "@file{" "}"))
   :preamble "@code{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-kbd-simple-markup
  (html2texi-simple-markup "html2texi-code-simple-markup"
   :preamble "@kbd{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-dfn-simple-markup
  (html2texi-simple-markup "html2texi-dfn-simple-markup"
   :preamble "@dfn{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<kbd class=\"CLEF\">CONTENU</kbd>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-em-simple-markup
  (html2texi-simple-markup "html2texi-em-simple-markup"
   :preamble "@emph{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<code class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-sub-simple-markup
  (html2texi-simple-markup "html2texi-sub-simple-markup"
   :preamble ""
   :postamble "")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<sub class=\"CLEF\">CONTENU</sub>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-sup-simple-markup
  (html2texi-simple-markup "html2texi-sup-simple-markup"
   :preamble ""
   :postamble "")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<sup class=\"CLEF\">CONTENU</sup>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-samp-simple-markup
  (html2texi-simple-markup "html2texi-samp-simple-markup"
   :preamble "@samp{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<samp class=\"CLEF\">CONTENU</code>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)

(defcustom html2texi-strong-simple-markup
  (html2texi-simple-markup "html2texi-strong-simple-markup"
   :preamble "@strong{"
   :postamble "}")
  "Liste d'association dont les éléments (CLEF PROLOGUE ÉPILOGUE) comprend.

Lorsque le code HTML `<b class=\"CLEF\">CONTENU</b>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-tt-simple-markup
  (html2texi-simple-markup "html2texi-tt-simple-markup"
   :preamble "@t{"
   :postamble "}")
  "Liste d'association dont les éléments sont de la forme (CLEF PROLOGUE ÉPILOGUE).

Lorsque le code HTML `<tt class=\"CLEF\">CONTENU</tt>' est
rencontré, alors il est convertie en le code Texinfo `PROLOGUE
TEXI-CONTENU ÉPILOGUE', où TEXI-CONTENU est obtenu en
convertissant en Texinfo CONTENU."
  :type 'object
  :group 'html2texi)


(defcustom html2texi-handle-two-columns-table-as-@table
  t
 "Si `nil' alors une table `<table>...</table>'
avec deux colonne sera gérée en texinfo par une `@table', si non
`nil', alors elle sera gérée par une `@multitable'."
  :type
  '(choice
    (const :tag "t pour @table" t)
    (const :tag "nil pour @multitable" nil))
  :group 'html2texi)

(defcustom html2texi-log-error-names
   ["Erreur fatale" "Erreur" "Avertissement" "Info"]
   "Liste des types d'erreur préfixant les messages d'erreur dans
le tampon de sortie des erreurs & avertissement de traitement."
   :type
   '(vector
     (string :tag "Erreur fatale")
     (string :tag "Erreur")
     (string :tag "Avertissement")
     (string :tag "Info"))
   :group 'html2texi  )

(defcustom html2texi-log-buffer-name
  "*HTML2TEXI*"
  "Nom du tampon de sortie des erreurs et avertissements de traitement."
  :type 'string
  :group 'html2texi)

(defcustom html2texi-beautify-locators
  t
  "Embellit les identificateur de localisateur après génération
  du Texinfo."
  :type '(radio
	  (const :tag "Ne pas embellir les identificateurs de localisateur." nil)
	  (const :tag "Embellir les identificateurs de localisateur." t))
  :group 'html2texi )

(defvar html2texi-document-information-object nil
  "Objet de classe `html2texi-document-information' pour mémoriser les informations (titre,
  auteurs, etc...) propres à un document.")

(defvar html2texi-line-delta 0
  "Décalage entre le numéro de ligne du code XML au sein le
  tampon Texinfo en cours de traitement, et son numéro de ligne
  dans le fichier HTML source.")

(defvar html2texi-xml-stack nil
  "Pile des expressions XML")

(defvar html2texi-keep-empty-strings nil
  "Non nil si les chaînes vides sont à conserver.")

(defvar html2texi-ignore-head nil
  "Non nil si on ignore le <head> (dans un fichier HTML lié).")

(defvar html2texi-directory-stack nil
  "Pile des chemins de répertoire.")

(defvar html2texi-files-to-do nil
  "Base des fichiers non encore traités, instanciée localement
  comme un objet de class `html2texi-files-to-do-listing'.")

(defvar html2texi-flushable-anchors nil
  "Liste de nom d'ancrage de lien dont l'insertion a été remise à
  plus tard." )

(defvar html2texi-postpone-output nil
  "Non `nil' lorsque l'insertion du code est remise à plus tard.")

(defvar html2texi-directory-ref nil
  "Répertoire de référence")

(defvar html2texi-log-buffer nil
  "Tampon de sortie des erreurs et avertissements de traitement.")

(defvar html2texi-reusable-log-buffer nil
  "Quand `html2texi-reuse-log-buffer' vaut est non `nil', tampon
  qu'on essaie de reutiliser pour la sortie des erreurs..")

(defvar html2texi-texi-buffer-name nil
  "Nom du tampon Texinfo généré.")

(defvar html2texi-locator-list nil
  "Liste des localisateurs, pour post-traitement d'embellissement
  des identificateurs de localisateur.")

(defvar html2texi-convert-restrictions-object nil
  "Objet de classe `html2texi-convert-restrictions' comprenant la
  liste courante des restrictions de conversion."  )

(defmacro html2texi-make-simple-markup-handler (tag)
  `(defun ,(intern (concat "html2texi-tag-handler-" (symbol-name tag)))
     (xml-expr)
     (html2texi-handle-simple-markup
      ,(intern (concat "html2texi-"  (symbol-name tag) "-simple-markup"))
      xml-expr) ))

(defun html2texi-make-html-clean-xml (beg end)
  (let  ((end-arg end)
	 end)
    ;; initialisation de end comme un marque
    (if (markerp end-arg)
	(setq end end-arg)
      (goto-char end-arg)
      (setq end (point-marker)))

    ;; rend les balise implicitement auto-closante vraiment auto-closante
    (goto-char beg)
    (while (re-search-forward (concat "<\\(" html2texi-suspicious-html-tags-re "\\)\\>")
			      end t)
      (let ((tag (match-string-no-properties 1)))
	(unless (re-search-forward ">" nil t)
	  (html2texi-fatal-error "Clôture non trouvé pour la balise %s" nil
				 tag))
	(when (null (looking-back "/>"))
	  (backward-char)
	  (insert "/")
	  (forward-char))))

    ;; marque de paragraphe et de ligne
    (goto-char beg)
    (let (tag-stack pos-< pos->
		    tag is-closure self-closing)
      (while (re-search-forward "<\\(/\\)?\\([a-zA-Z]+\\)\\>" end t)
	(setq pos-< (match-beginning 0)
	      tag (match-string-no-properties 2)
	      is-closure (match-string-no-properties 1))
	(unless (string= tag (downcase tag))
	  (replace-match (setq tag (downcase tag)) 2))
	(unless (re-search-forward ">" end t)
	  (html2texi-fatal-error "Soufflet de clôture non trouvé pour la balise %s" nil
		 tag))

	(setq pos-> (point)
	      self-closing (looking-back "/>"))
	(cond
	 ((and self-closing  is-closure)
	  (html2texi-fatal-error "balise %s à la fois de clôture et auto-closante" nil
		 tag))

	 (self-closing
	  ;; do nothing
	  )

	 ((null is-closure)
	  (when (and
		 (string-match (concat "\\`" html2texi-non-recursive-tags-re "\\'") tag)
		 tag-stack
		 (string= tag (caar tag-stack)))
	    ;; clôture
	    (save-excursion
	      (goto-char pos-<)
	      (insert "</" tag "><!-- HTML2TEXI: repaired (1) -->")
	      (html2texi-warning "Ajout clôture `</%s>'" nil tag))
	    (pop tag-stack))
	  (push (list tag) tag-stack))

	 (is-closure
	  (if (and tag-stack
		   (string= (caar tag-stack) tag))
	      (pop tag-stack)
	    (let ((first (assoc-string tag tag-stack)) rev)
	      (if first
		  (progn
		    (while (and tag-stack (null (eq (car tag-stack) first)))
		      (push (pop tag-stack) rev))
		    (pop tag-stack)
		    (save-excursion
		      (goto-char pos-<)
		      (dolist (c rev)
			(insert  "</" (car c) "><!-- HTML2TEXI: repaired (2) -->" )
			(html2texi-warning "Ajout clôture `</%s>'" nil tag))))

		(save-excursion
		  (goto-char pos->)
		  (insert "-->")
		  (goto-char pos-<)
		  (insert "<!-- HTML2TEXI: repaired (3). "))
		(html2texi-warning "Clôture de %s ne correspondant à aucune ouverture" nil tag)))))))


      (let (p-pos li-pos markup poss pos)
	(while (re-search-forward "<\\(/\\)?\\(p\\|li\\)\\>[^>]*>" end t)
	  (setq markup (match-string-no-properties 2)
		poss (intern (concat markup "-pos"))
		pos (symbol-value poss))
	  (if (match-string-no-properties 1)
	      (if  pos
		  (if (= pos (match-beginning 0))
		      (set poss nil)
		    (html2texi-fatal-error "Clôture de balise %s ne correspondant à aucune ouverture" nil
					   (match-string-no-properties 0)))
		(save-excursion
		  (save-match-data
		    (unless  (re-search-forward
			      (format "<\\(/\\)?\\(%s\\)\\>[^>]+>" markup)
			      end t)
		      (html2texi-fatal-error "Ouverture de balise <%s> sans clôture" nil
					     markup))
		    (set poss (match-beginning 0))
		    (unless (match-string-no-properties 1)
		      (goto-char (match-beginning 0))
		      (insert (format "</%s>" markup))
		      (dolist (symb '(p-pos li-pos))
			(unless (or (null (symbol-value symb))
				    (eq symb poss))
			  (set symb (+ (length markup) 3 (symbol-value symb)))))))))))
	))

    ;; mise entre guillemets anglais des attributs entier sans guillemets
    (goto-char beg)
    (let (p1 p2 added-dquote-attributes p-start p-end)
      ;; tant qu'on trouve potentiellement un attribut sans "..."
      (while (re-search-forward "\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([-+]?[0-9]+\\)"
				nil end)
	(setq p1 (match-beginning 1)
	      p2 (match-end 0))
	(if
	    ;; si la position est bien entre < et >
	    (and (re-search-backward "[<>]" beg t)
		 (looking-at "<\\sw+")
		 (progn
		   (goto-char (setq p-start (match-end 0)))
		   (re-search-forward "[<>]" end t)
		   (string= (match-string-no-properties 0) ">"))
		 (>= (setq p-end (match-beginning 0)) p1))
	    ;; alors on fait la réparation
	    (progn
	      (goto-char p-start)
	      (while
		  (progn
		    (while (looking-at "\\(?:\\s-\\|\n\\)*\\sw+\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\"[^\"]*\"")
		      (goto-char (match-end 0)))
		    (cond
		     ((looking-at  "\\(?:\\s-\\|\n\\)*\\(\\sw+\\)\\(?:\\s-\\|\n\\)*=\\(?:\\s-\\|\n\\)*\\([-+]?[0-9]+\\)")
		      (push (match-string-no-properties 1) added-dquote-attributes)
		      (goto-char (match-beginning 2))
		      (insert ?\")
		      (goto-char (1+ (match-end 2)))
		      (insert ?\")
		      (setq p-end (+ 2 p-end)))
		     ((looking-at "\\(?:\\s-\\|\n\\)*>")
		      (goto-char (match-end 0))
		      (insert "<!-- HTML2TEXI inserted double quotes around values for attibutes: "
			      (mapconcat (lambda (x) (concat "`" x "'"))
					 added-dquote-attributes
					 ", ")
			      " -->")
		      nil)
		     (t (html2texi-error "Attribut au format invalide: %s."
			       (buffer-substring (point) p-end)))))))
	  ;; sinon on continue à chercher un attribut potentiel dont la valeur
	  ;; n'est pas entre "..."
	  (goto-char p2))))

    ;; un peu de ménage...
    (unless (markerp end-arg)
      (set-marker end nil)) ))

;;;==========================================================================
;;; définition des gestionnaires de balise
;;;--------------------------------------------------------------------------

(defun html2texi-tag-handler-a (xml-expr)
  (let (name href text (xml-expr-length (length xml-expr)))
    (dolist (attrib (cadr xml-expr))
      (cond
       ((eq (car attrib) 'href)
	(setq href (cdr attrib)))
       ((eq (car attrib) 'name)
	(setq name (cdr attrib)))))
    (and (cddr xml-expr)
	 (setq text (if (cdddr xml-expr)
			xml-expr
		      (caddr xml-expr))))
    (cond
     (href (html2texi-process-url href text))
     ((= xml-expr-length 3)
      (cond
       ((stringp text)
	(insert (html2texi-string-escape text t)))
       ((consp text)
	(html2texi-process-xml-expr text)	)
       (t (error "Le format du text de la balise <a> était inattendu"))))
     ((> xml-expr-length 3)
      (html2texi-process-xml-expr `(div nil ,@(cddr xml-expr)))))
    (and
     name
     (progn
       (insert "\n@anchor{")
       (html2texi-insert-locator
	 (concat
	  (file-relative-name
	   (html2texi-current-file html2texi-files-to-do)
	   html2texi-directory-ref)
	  "#" name) :@anchor)
       (insert "}\n")))))

(html2texi-make-simple-markup-handler b)

(defun html2texi-flush-anchors ()
  (while html2texi-flushable-anchors
    (insert "@anchor{")
    (html2texi-insert-locator (pop html2texi-flushable-anchors) :@anchor)
    (insert "}\n")))

(defun html2texi-tag-handler-h1 (xml-expr)
  (insert "@chapter " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))


(defun html2texi-tag-handler-h2 (xml-expr)
  (insert "@section " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))

(defun html2texi-tag-handler-h3 (xml-expr)
  (insert "@subsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
    (html2texi-flush-anchors))

(defun html2texi-tag-handler-h4 (xml-expr)
  (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
  (html2texi-flush-anchors))

(defun html2texi-tag-handler-h5 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
     (html2texi-flush-anchors))

(defun html2texi-tag-handler-h6 (xml-expr)
   (insert "@subsubsection " (hmtl2texi-to-plain-text xml-expr :one-line) ?\n)
   (html2texi-flush-anchors))

(html2texi-make-simple-markup-handler samp)


(defun html2texi-get-col-span (xml-expr)
  ;; xml-expr is <td> or <th>
  (let ((col-span (cdr-safe (assq 'colspan (nth 1 xml-expr)))))
    (setq col-span
	  (cond
	   ((integerp
	       (setq col-span
		     (if (stringp col-span)
			 (string-to-number col-span)
		       col-span)))
	      col-span)
	   ((null col-span) 1)
	   (t (error "colspan invalide"))))  ))

(html2texi-make-simple-markup-handler sub)
(html2texi-make-simple-markup-handler sup)

(html2texi-make-simple-markup-handler tt)

(defvar html2texi-table-fmt-current-ctxt nil)

(defun html2texi-tag-handler-table (xml-expr)
  (let* ((html2texi-table-fmt-current-ctxt (html2texi-table-fmt-ctxt "Table formatting context"))
	 (xml-table-info
	  (vector xml-expr;0: table items
		  nil;1: thead items
		  nil;2: tbody items
		  nil;3: tfoot items
		  0;4: bitmap champ trouvé:
					; 1 = plain table (found a tr item not a thead|tbody|tfoot)
					; 2 = thead found
					; 4 = tbody found
					; 8 = tfoot found
		  0;5: bitmap traité
		  1;6: en cours de traitement
		  ))
	 (xml-items (cddr xml-expr)))

    ;; tout d'abord on analyse la table pour trouver le nombre de colonne
    (while (or xml-items (/= (aref xml-table-info 4)  (aref xml-table-info 5)))
      (if xml-items
	  (let ((xml-expr (pop xml-items)))
	    (cond
	     ((and (consp xml-expr)
		   (eq (car xml-expr) 'tr))
	      (when (= (aref xml-table-info 6) 1)
		;; cas d'une table avec les lignes directement sous <table> ... </table>
		(and (/= (logand (aref xml-table-info 4)
				 14) 0)
		     (html2texi-error "Table avec à la fois des lignes directement sous <table> ... </table>\
 et des lignes sous une balise <X>...</X> avec X dans {thead, tbody, tfoot}" xml-expr))
		(aset xml-table-info 4 (logior (aref xml-table-info 4) 1)))
	      ;; plus besoin de chercher une ligne: on compte les colonnes sur la
	      ;; première ligne trouvée
	      (setq xml-items nil)
	      (dolist  (xml-expr (cddr xml-expr))
		(cond
		 ((consp xml-expr)
		  (if (memq  (car xml-expr) '(th td))
		      (progn
			(oset html2texi-table-fmt-current-ctxt :col-count
			      (+ (oref html2texi-table-fmt-current-ctxt :col-count)
				 (html2texi-get-col-span xml-expr)))
			(when (> (oref html2texi-table-fmt-current-ctxt :col-count)
				 (oref html2texi-table-fmt-current-ctxt :col-info-length))
			  (let ((l (make-list (- (oref html2texi-table-fmt-current-ctxt :col-count)
						 (oref html2texi-table-fmt-current-ctxt :col-info-length))
					      '(abs 1))))
			    (setcdr (oref html2texi-table-fmt-current-ctxt :col-info-last) l)
			    (oset html2texi-table-fmt-current-ctxt :col-info-last (last l))
			    (oset html2texi-table-fmt-current-ctxt :col-info-length
				  (oref html2texi-table-fmt-current-ctxt :col-count)))))
		    (html2texi-error "balise inattendu dans une table" xml-expr)))
		 ((stringp xml-expr)
		  (unless (string-match
			   "\\`\\s-*\\(\n\\s-*\\)*\\'"
			   xml-expr)
		    (html2texi-error "Chaîne inattendue" xml-expr)))
		 (t (h