Merge branch 'master' into comment-cachecomment-cache

5 files changed, 97 insertions, 46 deletions

diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index d42180719dc..f7e06341443 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -59,7 +59,7 @@
   "Directory where files will downloaded."
   :version "24.4"
   :group 'eww
-  :type 'string)
+  :type 'directory)
 
 ;;;###autoload
 (defcustom eww-suggest-uris
@@ -81,7 +81,7 @@ duplicate entries (if any) removed."
   "Directory where bookmark files will be stored."
   :version "25.1"
   :group 'eww
-  :type 'string)
+  :type 'directory)
 
 (defcustom eww-desktop-remove-duplicates t
   "Whether to remove duplicates from the history when saving desktop data.
@@ -251,6 +251,29 @@ word(s) will be searched for via `eww-search-prefix'."
                           (if uris (format " (default %s)" (car uris)) "")
                           ": ")))
      (list (read-string prompt nil nil uris))))
+  (setq url (eww--dwim-expand-url url))
+  (pop-to-buffer-same-window
+   (if (eq major-mode 'eww-mode)
+       (current-buffer)
+     (get-buffer-create "*eww*")))
+  (eww-setup-buffer)
+  ;; Check whether the domain only uses "Highly Restricted" Unicode
+  ;; IDNA characters.  If not, transform to punycode to indicate that
+  ;; there may be funny business going on.
+  (let ((parsed (url-generic-parse-url url)))
+    (unless (puny-highly-restrictive-domain-p (url-host parsed))
+      (setf (url-host parsed) (puny-encode-domain (url-host parsed)))
+      (setq url (url-recreate-url parsed))))
+  (plist-put eww-data :url url)
+  (plist-put eww-data :title "")
+  (eww-update-header-line-format)
+  (let ((inhibit-read-only t))
+    (insert (format "Loading %s..." url))
+    (goto-char (point-min)))
+  (url-retrieve url 'eww-render
+                (list url nil (current-buffer))))
+
+(defun eww--dwim-expand-url (url)
   (setq url (string-trim url))
   (cond ((string-match-p "\\`file:/" url))
         ;; Don't mangle file: URLs at all.
@@ -275,26 +298,7 @@ word(s) will be searched for via `eww-search-prefix'."
                  (setq url (concat url "/"))))
            (setq url (concat eww-search-prefix
                              (replace-regexp-in-string " " "+" url))))))
-  (pop-to-buffer-same-window
-   (if (eq major-mode 'eww-mode)
-       (current-buffer)
-     (get-buffer-create "*eww*")))
-  (eww-setup-buffer)
-  ;; Check whether the domain only uses "Highly Restricted" Unicode
-  ;; IDNA characters.  If not, transform to punycode to indicate that
-  ;; there may be funny business going on.
-  (let ((parsed (url-generic-parse-url url)))
-    (unless (puny-highly-restrictive-domain-p (url-host parsed))
-      (setf (url-host parsed) (puny-encode-domain (url-host parsed)))
-      (setq url (url-recreate-url parsed))))
-  (plist-put eww-data :url url)
-  (plist-put eww-data :title "")
-  (eww-update-header-line-format)
-  (let ((inhibit-read-only t))
-    (insert (format "Loading %s..." url))
-    (goto-char (point-min)))
-  (url-retrieve url 'eww-render
-                (list url nil (current-buffer))))
+  url)
 
 ;;;###autoload (defalias 'browse-web 'eww)
 
@@ -351,16 +355,25 @@ Currently this means either text/html or application/xhtml+xml."
                         "utf-8"))))
          (data-buffer (current-buffer))
          last-coding-system-used)
-    ;; Save the https peer status.
     (with-current-buffer buffer
-      (plist-put eww-data :peer (plist-get status :peer)))
+      ;; Save the https peer status.
+      (plist-put eww-data :peer (plist-get status :peer))
+      ;; Make buffer listings more informative.
+      (setq list-buffers-directory url))
     (unwind-protect
         (progn
           (cond
            ((and eww-use-external-browser-for-content-type
                  (string-match-p eww-use-external-browser-for-content-type
                                  (car content-type)))
-            (eww-browse-with-external-browser url))
+            (erase-buffer)
+            (insert "<title>Unsupported content type</title>")
+            (insert (format "<h1>Content-type %s is unsupported</h1>"
+                            (car content-type)))
+            (insert (format "<a href=%S>Direct link to the document</a>"
+                            url))
+            (goto-char (point-min))
+            (eww-display-html charset url nil point buffer encode))
            ((eww-html-p (car content-type))
             (eww-display-html charset url nil point buffer encode))
            ((equal (car content-type) "application/pdf")
@@ -804,7 +817,10 @@ the like."
 ;;;###autoload
 (defun eww-browse-url (url &optional new-window)
   (when new-window
-    (pop-to-buffer-same-window (generate-new-buffer "*eww*"))
+    (pop-to-buffer-same-window
+     (generate-new-buffer
+      (format "*eww-%s*" (url-host (url-generic-parse-url
+                                    (eww--dwim-expand-url url))))))
     (eww-mode))
   (eww url))
 
@@ -835,6 +851,8 @@ the like."
       (erase-buffer)
       (insert text)
       (goto-char (plist-get elem :point))
+      ;; Make buffer listings more informative.
+      (setq list-buffers-directory (plist-get elem :url))
       (eww-update-header-line-format))))
 
 (defun eww-next-url ()
@@ -1483,6 +1501,7 @@ Differences in #targets are ignored."
 (defun eww-download ()
   "Download URL under point to `eww-download-directory'."
   (interactive)
+  (access-file eww-download-directory "Download failed")
   (let ((url (get-text-property (point) 'shr-url)))
     (if (not url)
         (message "No URL under point")
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index 93e1bae5fc2..bf60eee673c 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -139,6 +139,10 @@ a greeting from the server.
 :nowait, if non-nil, says the connection should be made
 asynchronously, if possible.
 
+:shell-command is a format-spec string that can be used if :type
+is `shell'.  It has two specs, %s for host and %p for port
+number.  Example: \"ssh gateway nc %s %p\".
+
 :tls-parameters is a list that should be supplied if you're
 opening a TLS connection.  The first element is the TLS
 type (either `gnutls-x509pki' or `gnutls-anon'), and the
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index e0bb3dbb2b7..b7c48288494 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -96,8 +96,9 @@ If nil, don't draw horizontal table lines."
 (defcustom shr-width nil
   "Frame width to use for rendering.
 May either be an integer specifying a fixed width in characters,
-or nil, meaning that the full width of the window should be
-used."
+or nil, meaning that the full width of the window should be used.
+If `shr-use-fonts' is set, the mean character width is used to
+compute the pixel width, which is used instead."
   :version "25.1"
   :type '(choice (integer :tag "Fixed width in characters")
                  (const   :tag "Use the width of the window" nil))
@@ -978,7 +979,7 @@ element is the data blob and the second element is the content-type."
                       (create-image data nil t :ascent 100
                                     :format content-type))
                      ((eq content-type 'image/svg+xml)
-                      (create-image data 'svg t :ascent 100))
+                      (create-image data 'imagemagick t :ascent 100))
                      ((eq size 'full)
                       (ignore-errors
                         (shr-rescale-image data content-type
@@ -1011,18 +1012,25 @@ element is the data blob and the second element is the content-type."
         image)
     (insert (or alt ""))))
 
-(defun shr-rescale-image (data content-type width height)
+(defun shr-rescale-image (data content-type width height
+                               &optional max-width max-height)
   "Rescale DATA, if too big, to fit the current buffer.
-WIDTH and HEIGHT are the sizes given in the HTML data, if any."
+WIDTH and HEIGHT are the sizes given in the HTML data, if any.
+
+The size of the displayed image will not exceed
+MAX-WIDTH/MAX-HEIGHT.  If not given, use the current window
+width/height instead."
   (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)))))
+                                   (or max-width
+                                       (- (nth 2 edges) (nth 0 edges))))))
            (max-height (truncate (* shr-max-image-proportion
-                                    (- (nth 3 edges) (nth 1 edges)))))
+                                    (or max-height
+                                        (- (nth 3 edges) (nth 1 edges))))))
            (scaling (image-compute-scaling-factor image-scaling-factor)))
       (when (or (and width
                      (> width max-width))
@@ -1059,8 +1067,7 @@ Return a string with image data."
     (when (ignore-errors
             (url-cache-extract (url-cache-create-filename (shr-encode-url url)))
             t)
-      (when (or (search-forward "\n\n" nil t)
-                (search-forward "\r\n\r\n" nil t))
+      (when (re-search-forward "\r?\n\r?\n" nil t)
         (shr-parse-image-data)))))
 
 (declare-function libxml-parse-xml-region "xml.c"
@@ -1079,9 +1086,12 @@ Return a string with image data."
                             obarray)))))))
     ;; SVG images may contain references to further images that we may
     ;; want to block.  So special-case these by parsing the XML data
-    ;; and remove the blocked bits.
-    (when (eq content-type 'image/svg+xml)
+    ;; and remove anything that looks like a blocked bit.
+    (when (and shr-blocked-images
+               (eq content-type 'image/svg+xml))
       (setq data
+            ;; Note that libxml2 doesn't parse everything perfectly,
+            ;; so glitches may occur during this transformation.
             (shr-dom-to-xml
              (libxml-parse-xml-region (point) (point-max)))))
     (list data content-type)))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index fc7fdd30850..48dcd5edd11 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3614,18 +3614,36 @@ connection buffer."
 
 ;;; Utility functions:
 
-(defun tramp-accept-process-output (&optional proc timeout timeout-msecs)
+(defun tramp-accept-process-output (proc timeout)
   "Like `accept-process-output' for Tramp processes.
 This is needed in order to hide `last-coding-system-used', which is set
 for process communication also."
+  ;; FIXME: There are problems, when an asynchronous process runs in
+  ;; parallel, and also timers are active.  See
+  ;; <http://lists.gnu.org/archive/html/tramp-devel/2017-01/msg00010.html>.
+  (when (and timer-event-last
+             (string-prefix-p "*tramp/" (process-name proc))
+             (let (result)
+               (maphash
+                (lambda (key _value)
+                  (and (processp key)
+                       (not (string-prefix-p "*tramp/" (process-name key)))
+                       (tramp-compat-process-live-p key)
+                       (setq result t)))
+                tramp-cache-data)
+               result))
+    (sit-for 0.01 'nodisp))
   (with-current-buffer (process-buffer proc)
     (let (buffer-read-only last-coding-system-used)
       ;; Under Windows XP, accept-process-output doesn't return
-      ;; sometimes.  So we add an additional timeout.
-      (with-timeout ((or timeout 1))
-        (accept-process-output proc timeout timeout-msecs (and proc t)))
-      (tramp-message proc 10 "%s %s\n%s"
-                     proc (process-status proc) (buffer-string)))))
+      ;; sometimes.  So we add an additional timeout.  JUST-THIS-ONE
+      ;; is set due to Bug#12145.
+      (tramp-message
+       proc 10 "%s %s %s\n%s"
+       proc (process-status proc)
+       (with-timeout (timeout)
+         (accept-process-output proc timeout nil t))
+       (buffer-string)))))
 
 (defun tramp-check-for-regexp (proc regexp)
   "Check, whether REGEXP is contained in process buffer of PROC.
diff --git a/lisp/net/zeroconf.el b/lisp/net/zeroconf.el
index 37816bb8881..393f3a549f9 100644
--- a/lisp/net/zeroconf.el
+++ b/lisp/net/zeroconf.el
@@ -256,7 +256,7 @@ supported keys depend on the service type.")
   "Returns all discovered Avahi service names as list."
   (let (result)
     (maphash
-     (lambda (key value) (add-to-list 'result (zeroconf-service-name value)))
+     (lambda (_key value) (add-to-list 'result (zeroconf-service-name value)))
      zeroconf-services-hash)
     result))
 
@@ -264,7 +264,7 @@ supported keys depend on the service type.")
   "Returns all discovered Avahi service types as list."
   (let (result)
     (maphash
-     (lambda (key value) (add-to-list 'result (zeroconf-service-type value)))
+     (lambda (_key value) (add-to-list 'result (zeroconf-service-type value)))
      zeroconf-services-hash)
     result))
 
@@ -276,7 +276,7 @@ The service type is one of the returned values of
 format of SERVICE."
   (let (result)
     (maphash
-     (lambda (key value)
+     (lambda (_key value)
        (when (equal type (zeroconf-service-type value))
          (add-to-list 'result value)))
      zeroconf-services-hash)