X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/379a846b8548dc32a9019ef0a37c02f62cd9bad1..595195a10e5dd568bf249f5fb6778ae3d7037cd5:/lisp/net/shr.el

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 63e02d988e..bf05fe93ba 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -274,22 +274,19 @@ DOM should be a parse tree as generated by
     (set-window-hscroll nil 0)
     (shr-descend dom)
     (shr-fill-lines start (point))
-    (shr-remove-trailing-whitespace start (point))
+    (shr--remove-blank-lines-at-the-end start (point))
     (when shr-warning
       (message "%s" shr-warning))))
 
-(defun shr-remove-trailing-whitespace (start end)
-  (let ((width (window-width)))
-    (save-restriction
+(defun shr--remove-blank-lines-at-the-end (start end)
+  (save-restriction
+    (save-excursion
       (narrow-to-region start end)
-      (goto-char start)
-      (while (not (eobp))
-	(end-of-line)
-	(when (> (shr-previous-newline-padding-width (current-column)) width)
-	  (dolist (overlay (overlays-at (point)))
-	    (when (overlay-get overlay 'before-string)
-	      (overlay-put overlay 'before-string nil))))
-	(forward-line 1)))))
+      (goto-char end)
+      (when (and (re-search-backward "[^ \n]" nil t)
+                 (not (eobp)))
+        (forward-line 1)
+        (delete-region (point) (point-max))))))
 
 (defun shr-copy-url (&optional image-url)
   "Copy the URL under point to the kill ring.
@@ -557,6 +554,16 @@ size, and full-buffer size."
       (insert string)
       (shr-pixel-column))))
 
+(defsubst shr--translate-insertion-chars ()
+  ;; Remove soft hyphens.
+  (goto-char (point-min))
+  (while (search-forward "­" nil t)
+    (replace-match "" t t))
+  ;; Translate non-breaking spaces into real spaces.
+  (goto-char (point-min))
+  (while (search-forward " " nil t)
+    (replace-match " " t t)))
+
 (defun shr-insert (text)
   (when (and (not (bolp))
 	     (get-text-property (1- (point)) 'image-url))
@@ -567,14 +574,11 @@ size, and full-buffer size."
       (insert text)
       (save-restriction
 	(narrow-to-region start (point))
-	;; Remove soft hyphens.
-	(goto-char (point-min))
-	(while (search-forward "­" nil t)
-	  (replace-match "" t t))
+        (shr--translate-insertion-chars)
 	(goto-char (point-max)))))
    (t
     (let ((font-start (point)))
-      (when (and (string-match "\\`[ \t\n\r ]" text)
+      (when (and (string-match "\\`[ \t\n\r]" text)
 		 (not (bolp))
 		 (not (eq (char-after (1- (point))) ? )))
 	(insert " "))
@@ -584,14 +588,11 @@ size, and full-buffer size."
 	(save-restriction
 	  (narrow-to-region start (point))
 	  (goto-char start)
-	  (when (looking-at "[ \t\n\r ]+")
+	  (when (looking-at "[ \t\n\r]+")
 	    (replace-match "" t t))
-	  (while (re-search-forward "[ \t\n\r ]+" nil t)
+	  (while (re-search-forward "[ \t\n\r]+" nil t)
 	    (replace-match " " t t))
-	  ;; Remove soft hyphens.
-	  (goto-char (point-min))
-	  (while (search-forward "­" nil t)
-	    (replace-match "" t t))
+          (shr--translate-insertion-chars)
 	  (goto-char (point-max)))
 	;; We may have removed everything we inserted if if was just
 	;; spaces.
@@ -805,8 +806,13 @@ size, and full-buffer size."
 	 (url-expand-file-name url (concat (car base) (cadr base))))))
 
 (defun shr-ensure-newline ()
-  (unless (zerop (current-column))
-    (insert "\n")))
+  (unless (bobp)
+    (let ((prefix (get-text-property (line-beginning-position)
+				     'shr-prefix-length)))
+      (unless (or (zerop (current-column))
+                  (and prefix
+                       (= prefix (- (point) (line-beginning-position)))))
+        (insert "\n")))))
 
 (defun shr-ensure-paragraph ()
   (unless (bobp)
@@ -834,6 +840,10 @@ size, and full-buffer size."
 						    (line-end-position))
 		       (line-end-position)))))
 	(delete-region (match-beginning 0) (match-end 0)))
+       ;; We have a single blank line.
+       ((and (eolp) (bolp))
+        (insert "\n"))
+       ;; Insert new paragraph.
        (t
 	(insert "\n\n"))))))
 
@@ -937,7 +947,8 @@ If EXTERNAL, browse the URL using `shr-external-browser'."
     (let ((param (match-string 4 data))
 	  (payload (url-unhex-string (match-string 5 data))))
       (when (string-match "^.*\\(;[ \t]*base64\\)$" param)
-	(setq payload (base64-decode-string payload)))
+	(setq payload (ignore-errors
+                        (base64-decode-string payload))))
       payload)))
 
 ;; Behind display-graphic-p test.
@@ -1158,18 +1169,6 @@ ones, in case fg and bg are nil."
 				  t)))
       new-colors)))
 
-(defun shr-previous-newline-padding-width (width)
-  (let ((overlays (overlays-at (point)))
-	(previous-width 0))
-    (if (null overlays)
-	width
-      (dolist (overlay overlays)
-	(setq previous-width
-	      (+ previous-width
-		 (length (plist-get (overlay-properties overlay)
-				    'before-string)))))
-      (+ width previous-width))))
-
 ;;; Tag-specific rendering rules.
 
 (defun shr-tag-html (dom)
@@ -1178,7 +1177,9 @@ ones, in case fg and bg are nil."
      ((equal dir "ltr")
       (setq bidi-paragraph-direction 'left-to-right))
      ((equal dir "rtl")
-      (setq bidi-paragraph-direction 'right-to-left))))
+      (setq bidi-paragraph-direction 'right-to-left))
+     ((equal dir "auto")
+      (setq bidi-paragraph-direction nil))))
   (shr-generic dom))
 
 (defun shr-tag-body (dom)
@@ -1257,7 +1258,7 @@ ones, in case fg and bg are nil."
   (shr-ensure-paragraph))
 
 (defun shr-tag-div (dom)
-  (shr-ensure-paragraph)
+  (shr-ensure-newline)
   (shr-generic dom)
   (shr-ensure-newline))
 
@@ -1497,7 +1498,7 @@ The preference is a float determined from `shr-prefer-media-type'."
           (insert " ")
 	  (url-queue-retrieve
 	   (shr-encode-url url) 'shr-image-fetched
-	   (list (current-buffer) start (set-marker (make-marker) (1- (point)))
+	   (list (current-buffer) start (set-marker (make-marker) (point))
                  (list :width width :height height))
 	   t t)))
 	(when (zerop shr-table-depth) ;; We are not in a table.
@@ -1590,6 +1591,10 @@ The preference is a float determined from `shr-prefer-media-type'."
   (shr-ensure-paragraph)
   (let ((shr-list-mode 'ul))
     (shr-generic dom))
+  ;; If we end on an empty <li>, then make sure we really end on a new
+  ;; paragraph.
+  (unless (bolp)
+    (insert "\n"))
   (shr-ensure-paragraph))
 
 (defun shr-tag-ol (dom)
@@ -1616,7 +1621,9 @@ The preference is a float determined from `shr-prefer-media-type'."
 	(put-text-property start (1+ start)
 			   'shr-continuation-indentation shr-indentation)
 	(put-text-property start (1+ start) 'shr-prefix-length (length bullet))
-	(shr-generic dom)))))
+	(shr-generic dom))))
+  (unless (bolp)
+    (insert "\n")))
 
 (defun shr-mark-fill (start)
   ;; We may not have inserted any text to fill.
@@ -1679,6 +1686,24 @@ The preference is a float determined from `shr-prefer-media-type'."
       (shr-colorize-region start (point) color
 			   (cdr (assq 'background-color shr-stylesheet))))))
 
+(defun shr-tag-bdo (dom)
+  (let* ((direction (dom-attr dom 'dir))
+         (char (cond
+                ((equal direction "ltr")
+                 ?\N{LEFT-TO-RIGHT OVERRIDE})
+                ((equal direction "rtl")
+                 ?\N{RIGHT-TO-LEFT OVERRIDE}))))
+    (when char
+      (insert ?\N{FIRST STRONG ISOLATE} char))
+    (shr-generic dom)
+    (when char
+      (insert ?\N{POP DIRECTIONAL FORMATTING} ?\N{POP DIRECTIONAL ISOLATE}))))
+
+(defun shr-tag-bdi (dom)
+  (insert ?\N{FIRST STRONG ISOLATE})
+  (shr-generic dom)
+  (insert ?\N{POP DIRECTIONAL ISOLATE}))
+
 ;;; Table rendering algorithm.
 
 ;; Table rendering is the only complicated thing here.  We do this by
@@ -1911,7 +1936,8 @@ The preference is a float determined from `shr-prefer-media-type'."
            (let ((background nil))
              (dolist (elem face)
                (when (and (consp elem)
-                          (eq (car elem) :background))
+                          (eq (car elem) :background)
+                          (not background))
                  (setq background (cadr elem))))
              (and background
                   (list :background background))))))