Fix shr.el/image build problem

[gnu-emacs] / lisp / net / shr.el

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 60794158024162622b5b98a5f771ed6372830a6e..68972020db3f7de26a346a6b96da59bfa86adfff 100644 (file)
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -37,6 +37,7 @@
 (require 'dom)
 (require 'seq)
 (require 'svg)
 (require 'dom)
 (require 'seq)
 (require 'svg)

+(require 'image)

 
 (defgroup shr nil
   "Simple HTML Renderer"
 
 (defgroup shr nil
   "Simple HTML Renderer"


@@ -296,8 +297,10 @@ image under point instead.
 If called twice, then try to fetch the URL and see whether it
 redirects somewhere else."
   (interactive "P")
 If called twice, then try to fetch the URL and see whether it
 redirects somewhere else."
   (interactive "P")

-  (let ((url (or (get-text-property (point) 'shr-url)
-                (get-text-property (point) 'image-url))))
+  (let ((url (if image-url
+                 (get-text-property (point) 'image-url)
+               (or (get-text-property (point) 'shr-url)
+                   (get-text-property (point) 'image-url)))))

     (cond
      ((not url)
       (message "No URL under point"))
     (cond
      ((not url)
       (message "No URL under point"))


@@ -554,6 +557,16 @@ size, and full-buffer size."
       (insert string)
       (shr-pixel-column))))
 
       (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))
 (defun shr-insert (text)
   (when (and (not (bolp))
             (get-text-property (1- (point)) 'image-url))


@@ -564,14 +577,11 @@ size, and full-buffer size."
       (insert text)
       (save-restriction
        (narrow-to-region start (point))
       (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)))
        (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 " "))
                 (not (bolp))
                 (not (eq (char-after (1- (point))) ? )))
        (insert " "))


@@ -581,14 +591,11 @@ size, and full-buffer size."
        (save-restriction
          (narrow-to-region start (point))
          (goto-char start)
        (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))
            (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))
            (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.
          (goto-char (point-max)))
        ;; We may have removed everything we inserted if if was just
        ;; spaces.


@@ -1004,22 +1011,25 @@ element is the data blob and the second element is the content-type."
 (defun shr-rescale-image (data content-type width height)
   "Rescale DATA, if too big, to fit the current buffer.
 WIDTH and HEIGHT are the sizes given in the HTML data, if any."
 (defun shr-rescale-image (data content-type width height)
   "Rescale DATA, if too big, to fit the current buffer.
 WIDTH and HEIGHT are the sizes given in the HTML data, if any."

-  (if (not (and (fboundp 'imagemagick-types)
-                (get-buffer-window (current-buffer))))
+  (if (or (not (fboundp 'imagemagick-types))
+          (not (get-buffer-window (current-buffer))))

       (create-image data nil t :ascent 100)
     (let* ((edges (window-inside-pixel-edges
                    (get-buffer-window (current-buffer))))
            (max-width (truncate (* shr-max-image-proportion
                                    (- (nth 2 edges) (nth 0 edges)))))
            (max-height (truncate (* shr-max-image-proportion
       (create-image data nil t :ascent 100)
     (let* ((edges (window-inside-pixel-edges
                    (get-buffer-window (current-buffer))))
            (max-width (truncate (* shr-max-image-proportion
                                    (- (nth 2 edges) (nth 0 edges)))))
            (max-height (truncate (* shr-max-image-proportion

-                                    (- (nth 3 edges) (nth 1 edges))))))
+                                    (- (nth 3 edges) (nth 1 edges)))))
+           (scaling (image-compute-scaling-factor image-scaling-factor)))

       (when (or (and width
                      (> width max-width))
                 (and height
                      (> height max-height)))
         (setq width nil
               height nil))
       (when (or (and width
                      (> width max-width))
                 (and height
                      (> height max-height)))
         (setq width nil
               height nil))

-      (if (and width height)
+      (if (and width height
+               (< (* width scaling) max-width)
+               (< (* height scaling) max-height))

           (create-image
            data 'imagemagick t
            :ascent 100
           (create-image
            data 'imagemagick t
            :ascent 100


@@ -1441,13 +1451,14 @@ The preference is a float determined from `shr-prefer-media-type'."
 (defun shr-tag-img (dom &optional url)
   (when (or url
            (and dom
 (defun shr-tag-img (dom &optional url)
   (when (or url
            (and dom

-                (> (length (dom-attr dom 'src)) 0)))
+                (or (> (length (dom-attr dom 'src)) 0)
+                     (> (length (dom-attr dom 'srcset)) 0))))

     (when (> (current-column) 0)
       (insert "\n"))
     (let ((alt (dom-attr dom 'alt))
           (width (shr-string-number (dom-attr dom 'width)))
           (height (shr-string-number (dom-attr dom 'height)))
     (when (> (current-column) 0)
       (insert "\n"))
     (let ((alt (dom-attr dom 'alt))
           (width (shr-string-number (dom-attr dom 'width)))
           (height (shr-string-number (dom-attr dom 'height)))

-         (url (shr-expand-url (or url (dom-attr dom 'src)))))
+         (url (shr-expand-url (or url (shr--preferred-image dom)))))

       (let ((start (point-marker)))
        (when (zerop (length alt))
          (setq alt "*"))
       (let ((start (point-marker)))
        (when (zerop (length alt))
          (setq alt "*"))


@@ -1507,6 +1518,43 @@ The preference is a float determined from `shr-prefer-media-type'."
                             (shr-fill-text
                              (or (dom-attr dom 'title) alt))))))))
 
                             (shr-fill-text
                              (or (dom-attr dom 'title) alt))))))))
 

+(defun shr--preferred-image (dom)
+  (let ((srcset (dom-attr dom 'srcset))
+        (frame-width (frame-pixel-width))
+        (width (string-to-number (or (dom-attr dom 'width) "100")))
+        candidate)
+    (when (> (length srcset) 0)
+      ;; srcset consist of a series of URL/size specifications
+      ;; separated by the ", " string.
+      (setq srcset
+            (sort (mapcar
+                   (lambda (elem)
+                     (let ((spec (split-string elem " ")))
+                       (cond
+                        ((= (length spec) 1)
+                         ;; Make sure it's well formed.
+                         (list (car spec) 0))
+                        ((string-match "\\([0-9]+\\)x\\'" (cadr spec))
+                         ;; If we have an "x" form, then use the width
+                         ;; spec to compute the real width.
+                         (list (car spec)
+                               (* width (string-to-number
+                                         (match-string 1 (cadr spec))))))
+                        (t
+                         (list (car spec)
+                               (string-to-number (cadr spec)))))))
+                   (split-string srcset ", "))
+                  (lambda (e1 e2)
+                    (> (cadr e1) (cadr e2)))))
+      ;; Choose the smallest picture that's bigger than the current
+      ;; frame.
+      (setq candidate (caar srcset))
+      (while (and srcset
+                  (> (cadr (car srcset)) frame-width))
+        (setq candidate (caar srcset))
+        (pop srcset)))
+    (or candidate (dom-attr dom 'src))))
+

 (defun shr-string-number (string)
   (if (null string)
       nil
 (defun shr-string-number (string)
   (if (null string)
       nil


@@ -1686,19 +1734,19 @@ The preference is a float determined from `shr-prefer-media-type'."
   (let* ((direction (dom-attr dom 'dir))
          (char (cond
                 ((equal direction "ltr")
   (let* ((direction (dom-attr dom 'dir))
          (char (cond
                 ((equal direction "ltr")

-                 #x202d)                ; LRO
+                 ?\N{LEFT-TO-RIGHT OVERRIDE})

                 ((equal direction "rtl")
                 ((equal direction "rtl")

-                 #x202e))))             ; RLO
+                 ?\N{RIGHT-TO-LEFT OVERRIDE}))))

     (when char
     (when char

-      (insert #x2068 char))             ; FSI + LRO/RLO
+      (insert ?\N{FIRST STRONG ISOLATE} char))

     (shr-generic dom)
     (when char
     (shr-generic dom)
     (when char

-      (insert #x202c #x2069))))         ; PDF + PDI
+      (insert ?\N{POP DIRECTIONAL FORMATTING} ?\N{POP DIRECTIONAL ISOLATE}))))

 
 (defun shr-tag-bdi (dom)
 
 (defun shr-tag-bdi (dom)

-  (insert #x2068)                       ; FSI
+  (insert ?\N{FIRST STRONG ISOLATE})

   (shr-generic dom)
   (shr-generic dom)

-  (insert #x2069))                      ; PDI
+  (insert ?\N{POP DIRECTIONAL ISOLATE}))

 
 ;;; Table rendering algorithm.
 
 
 ;;; Table rendering algorithm.