html2text.el (html2text-get-attr): Rewrite to handle spaces in quoted attribute value...

[gnus] / lisp / html2text.el

diff --git a/lisp/html2text.el b/lisp/html2text.el
index 7c2d504..22ee1c3 100644 (file)
--- a/lisp/html2text.el
+++ b/lisp/html2text.el
@@ -1,25 +1,23 @@
-;;; html2text.el --- a simple html to plain text converter
+;;; html2text.el --- a simple html to plain text converter -*- coding: utf-8 -*-

 
 

-;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2014 Free Software Foundation, Inc.

 
 ;; Author: Joakim Hove <hove@phys.ntnu.no>
 
 ;; This file is part of GNU Emacs.
 
 
 ;; Author: Joakim Hove <hove@phys.ntnu.no>
 
 ;; This file is part of GNU Emacs.
 

-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify

 ;; it under the terms of the GNU General Public License as published by
 ;; it under the terms of the GNU General Public License as published by

-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.

 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of

-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.         See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License

-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 


@@ -67,14 +65,14 @@
     ("&ndash;" . "-")
     ("&permil;" . "%%")
     ("&plusmn;" . "+-")
     ("&ndash;" . "-")
     ("&permil;" . "%%")
     ("&plusmn;" . "+-")

-    ("&pound;" . "£")
+    ("&pound;" . "£")

     ("&quot;" . "\"")
     ("&raquo;" . ">>")
     ("&rdquo" . "\"")
     ("&reg;" . "(R)")
     ("&rsaquo;" . ")")
     ("&rsquo;" . "'")
     ("&quot;" . "\"")
     ("&raquo;" . ">>")
     ("&rdquo" . "\"")
     ("&reg;" . "(R)")
     ("&rsaquo;" . ")")
     ("&rsquo;" . "'")

-    ("&sect;" . "§")
+    ("&sect;" . "§")

     ("&sup1;" . "^1")
     ("&sup2;" . "^2")
     ("&sup3;" . "^3")
     ("&sup1;" . "^1")
     ("&sup2;" . "^2")
     ("&sup3;" . "^3")


@@ -125,7 +123,7 @@ If this list contains the element \"font\".")
 This is an alist where each dotted pair consists of a tag, and then
 the name of a function to be called when this tag is found.  The
 function is called with the arguments p1, p2, p3 and p4. These are
 This is an alist where each dotted pair consists of a tag, and then
 the name of a function to be called when this tag is found.  The
 function is called with the arguments p1, p2, p3 and p4. These are

-demontrated below:
+demonstrated below:

 
 \"<b> This is bold text </b>\"
  ^   ^                 ^    ^
 
 \"<b> This is bold text </b>\"
  ^   ^                 ^    ^


@@ -181,72 +179,20 @@ formatting, and then moved afterward.")
 
 (defun html2text-get-attr (p1 p2)
   (goto-char p1)
 
 (defun html2text-get-attr (p1 p2)
   (goto-char p1)

-  (re-search-forward " +[^ ]" p2 t)
-  (let* ((attr-string (buffer-substring-no-properties (1- (point)) (1- p2)))
-        (tmp-list (split-string attr-string))
-        (attr-list)
-        (counter 0)
-        (prev (car tmp-list))
-        (this (nth 1 tmp-list))
-        (next (nth 2 tmp-list))
-        (index 1))
-
-    (cond
-     ;; size=3
-     ((string-match "[^ ]=[^ ]" prev)
-      (let ((attr  (nth 0 (split-string prev "=")))
-           (value (nth 1 (split-string prev "="))))
-       (setq attr-list (cons (list attr value) attr-list))))
-     ;; size= 3
-     ((string-match "[^ ]=\\'" prev)
-      (setq attr-list (cons (list (substring prev 0 -1) this) attr-list))))
-
-    (while (< index (length tmp-list))
-      (cond
-       ;; size=3
-       ((string-match "[^ ]=[^ ]" this)
-       (let ((attr  (nth 0 (split-string this "=")))
-             (value (nth 1 (split-string this "="))))
-         (setq attr-list (cons (list attr value) attr-list))))
-       ;; size =3
-       ((string-match "\\`=[^ ]" this)
-       (setq attr-list (cons (list prev (substring this 1)) attr-list)))
-       ;; size= 3
-       ((string-match "[^ ]=\\'" this)
-       (setq attr-list (cons (list (substring this 0 -1) next) attr-list)))
-       ;; size = 3
-       ((string= "=" this)
-       (setq attr-list (cons (list prev next) attr-list))))
-      (setq index (1+ index))
-      (setq prev this)
-      (setq this next)
-      (setq next (nth (1+ index) tmp-list)))
-    ;;
-    ;; Tags with no accompanying "=" i.e. value=nil
-    ;;
-    (setq prev (car tmp-list))
-    (setq this (nth 1 tmp-list))
-    (setq next (nth 2 tmp-list))
-    (setq index 1)
-
-    (when (and (not (string-match "=" prev))
-              (not (string= (substring this 0 1) "=")))
-      (setq attr-list (cons (list prev nil) attr-list)))
-    (while (< index (1- (length tmp-list)))
-      (when (and (not (string-match "=" this))
-                (not (or (string= (substring next 0 1) "=")
-                         (string= (substring prev -1) "="))))
-       (setq attr-list (cons (list this nil) attr-list)))
-      (setq index (1+ index))
-      (setq prev this)
-      (setq this next)
-      (setq next (nth (1+ index) tmp-list)))
-
-    (when (and this
-              (not (string-match "=" this))
-              (not (string= (substring prev -1) "=")))
-      (setq attr-list (cons (list this nil) attr-list)))
-    ;; return - value
+  (re-search-forward "\\s-+" p2 t)
+  (let (attr-list)
+    (while (re-search-forward "[-a-z0-9._]+" p2 t)
+      (setq attr-list
+           (cons
+            (list (match-string 0)
+                  (when (looking-at "\\s-*=")
+                    (goto-char (match-end 0))
+                    (skip-chars-forward "[:space:]")
+                    (when (or (looking-at "\"[^\"]*\"\\|'[^']*'")
+                              (looking-at "[-a-z0-9._:]+"))
+                      (goto-char (match-end 0))
+                      (match-string 0))))
+            attr-list)))

     attr-list))
 
 ;;
     attr-list))
 
 ;;


@@ -360,7 +306,8 @@ formatting, and then moved afterward.")
     (delete-region p1 p4)
     (when href
       (goto-char p1)
     (delete-region p1 p4)
     (when href
       (goto-char p1)

-      (insert (substring href 1 -1 ))
+      (insert (if (string-match "\\`['\"].*['\"]\\'" href)
+                 (substring href 1 -1) href))

       (put-text-property p1 (point) 'face 'bold))))
 
 ;;
       (put-text-property p1 (point) 'face 'bold))))
 
 ;;


@@ -385,10 +332,10 @@ formatting, and then moved afterward.")
        (setq refill-start (point))
        (goto-char p2)
        (re-search-backward ".+[^<][^b][^r][^>]$" refill-start t)
        (setq refill-start (point))
        (goto-char p2)
        (re-search-backward ".+[^<][^b][^r][^>]$" refill-start t)

-       (next-line 1)
+       (forward-line 1)

        (end-of-line)
        ;; refill-stop should ideally be adjusted to
        (end-of-line)
        ;; refill-stop should ideally be adjusted to

-       ;; accomodate the "<br>" strings which are removed
+       ;; accommodate the "<br>" strings which are removed

        ;; between refill-start and refill-stop.  Can simply
        ;; be returned from my-replace-string
        (setq refill-stop (+ (point)
        ;; between refill-start and refill-stop.  Can simply
        ;; be returned from my-replace-string
        (setq refill-stop (+ (point)


@@ -411,7 +358,7 @@ fashion, quite close to pure guess-work. It does work in some cases though."
   (while (re-search-forward "^<br>$" nil t)
     (delete-region (match-beginning 0) (match-end 0)))
   ;; Removing lonely <br> on a single line, if they are left intact we
   (while (re-search-forward "^<br>$" nil t)
     (delete-region (match-beginning 0) (match-end 0)))
   ;; Removing lonely <br> on a single line, if they are left intact we

-  ;; dont have any paragraphs at all.
+  ;; don't have any paragraphs at all.

   (goto-char (point-min))
   (while (not (eobp))
     (let ((p1 (point)))
   (goto-char (point-min))
   (while (not (eobp))
     (let ((p1 (point)))


@@ -510,5 +457,5 @@ See the documentation for that variable."
 ;; </Interactive functions>
 ;;
 (provide 'html2text)
 ;; </Interactive functions>
 ;;
 (provide 'html2text)

-;;; arch-tag: e9e57b79-35d4-4de1-a647-e7e01fe56d1e
+

 ;;; html2text.el ends here
 ;;; html2text.el ends here