]> code.delx.au - gnu-emacs/blobdiff - lisp/net/shr.el
Merge from origin/emacs-25
[gnu-emacs] / lisp / net / shr.el
index 4c3dfc4fdebe3f9f4418bc3643889261027a85cc..3adc57397cf4b68604961ff3926c7b4c945cd396 100644 (file)
@@ -186,7 +186,7 @@ and other things:
     (define-key map "w" 'shr-copy-url)
     (define-key map "u" 'shr-copy-url)
     (define-key map "v" 'shr-browse-url)
-    (define-key map "o" 'shr-save-contents)
+    (define-key map "O" 'shr-save-contents)
     (define-key map "\r" 'shr-browse-url)
     map))
 
@@ -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)
@@ -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")
+                 #x202d)                ; LRO
+                ((equal direction "rtl")
+                 #x202e))))             ; RLO
+    (when char
+      (insert #x2068 char))             ; FSI + LRO/RLO
+    (shr-generic dom)
+    (when char
+      (insert #x202c #x2069))))         ; PDF + PDI
+
+(defun shr-tag-bdi (dom)
+  (insert #x2068)                       ; FSI
+  (shr-generic dom)
+  (insert #x2069))                      ; PDI
+
 ;;; 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))))))