Merge emacs-26

6 files changed, 200 insertions, 23 deletions

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 7af6148e473..260ada54222 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -470,6 +470,18 @@ size, and full-buffer size."
 	(shr-insert sub)
       (shr-descend sub))))
 
+(defun shr-indirect-call (tag-name dom &rest args)
+  (let ((function (intern (concat "shr-tag-" (symbol-name tag-name)) obarray))
+	;; Allow other packages to override (or provide) rendering
+	;; of elements.
+	(external (cdr (assq tag-name shr-external-rendering-functions))))
+    (cond (external
+	   (apply external dom args))
+	  ((fboundp function)
+	   (apply function dom args))
+	  (t
+	   (apply 'shr-generic dom args)))))
+
 (defun shr-descend (dom)
   (let ((function
          (intern (concat "shr-tag-" (symbol-name (dom-tag dom))) obarray))
@@ -490,6 +502,11 @@ size, and full-buffer size."
 	  (setq style nil)))
       ;; If we have a display:none, then just ignore this part of the DOM.
       (unless (equal (cdr (assq 'display shr-stylesheet)) "none")
+        ;; We don't use shr-indirect-call here, since shr-descend is
+        ;; the central bit of shr.el, and should be as fast as
+        ;; possible.  Having one more level of indirection with its
+        ;; negative effect on performance is deemed unjustified in
+        ;; this case.
         (cond (external
                (funcall external dom))
               ((fboundp function)
@@ -1404,7 +1421,7 @@ ones, in case fg and bg are nil."
       (when url
 	(cond
 	 (image
-	  (shr-tag-img dom url)
+	  (shr-indirect-call 'img dom url)
 	  (setq dom nil))
 	 (multimedia
 	  (shr-insert " [multimedia] ")
@@ -1469,7 +1486,7 @@ The preference is a float determined from `shr-prefer-media-type'."
     (unless url
       (setq url (car (shr--extract-best-source dom))))
     (if (> (length image) 0)
-        (shr-tag-img nil image)
+	(shr-indirect-call 'img nil image)
       (shr-insert " [video] "))
     (shr-urlify start (shr-expand-url url))))
 
@@ -1964,9 +1981,9 @@ flags that control whether to collect or render objects."
 	     do (setq tag (dom-tag child)) and
 	     unless (memq tag '(comment style))
 	       if (eq tag 'img)
-		 do (shr-tag-img child)
+		 do (shr-indirect-call 'img child)
 	       else if (eq tag 'object)
-		 do (shr-tag-object child)
+		 do (shr-indirect-call 'object child)
 	       else
 		 do (setq recurse t) and
 		 if (eq tag 'tr)
@@ -1980,7 +1997,7 @@ flags that control whether to collect or render objects."
 		     do (setq flags nil)
 		   else if (car flags)
 		     do (setq recurse nil)
-			(shr-tag-table child)
+			(shr-indirect-call 'table child)
 		   end end end end end end end end end end
 	   when recurse
 	     append (shr-collect-extra-strings-in-table child flags)))
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 760d020f672..5268e80a33d 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -139,6 +139,7 @@ It is used for TCP/IP devices."
     (file-remote-p . tramp-handle-file-remote-p)
     (file-selinux-context . ignore)
     (file-symlink-p . tramp-handle-file-symlink-p)
+    (file-system-info . tramp-adb-handle-file-system-info)
     (file-truename . tramp-adb-handle-file-truename)
     (file-writable-p . tramp-adb-handle-file-writable-p)
     (find-backup-file-name . tramp-handle-find-backup-file-name)
@@ -255,6 +256,30 @@ pass to the OPERATION."
        (file-attributes (file-truename filename)))
       t))
 
+(defun tramp-adb-handle-file-system-info (filename)
+  "Like `file-system-info' for Tramp files."
+  (ignore-errors
+    (with-parsed-tramp-file-name (expand-file-name filename) nil
+      (tramp-message v 5 "file system info: %s" localname)
+      (tramp-adb-send-command
+       v (format "df -k %s" (tramp-shell-quote-argument localname)))
+      (with-current-buffer (tramp-get-connection-buffer v)
+	(goto-char (point-min))
+	(forward-line)
+	(when (looking-at
+	       (concat "[[:space:]]*[^[:space:]]+"
+		       "[[:space:]]+\\([[:digit:]]+\\)"
+		       "[[:space:]]+\\([[:digit:]]+\\)"
+		       "[[:space:]]+\\([[:digit:]]+\\)"))
+	  ;; The values are given as 1k numbers, so we must change
+	  ;; them to number of bytes.
+	  (list (* 1024 (string-to-number (concat (match-string 1) "e0")))
+		;; The second value is the used size.  We need the
+		;; free size.
+		(* 1024 (- (string-to-number (concat (match-string 1) "e0"))
+			   (string-to-number (concat (match-string 2) "e0"))))
+		(* 1024 (string-to-number (concat (match-string 3) "e0")))))))))
+
 ;; This is derived from `tramp-sh-handle-file-truename'.  Maybe the
 ;; code could be shared?
 (defun tramp-adb-handle-file-truename (filename)
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index e55dd1178d2..237d6896e2a 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -448,6 +448,18 @@ Every entry is a list (NAME ADDRESS).")
 	  ":[[:blank:]]+\\(.*\\)$")
   "Regexp to parse GVFS file attributes with `gvfs-info'.")
 
+(defconst tramp-gvfs-file-system-attributes
+  '("filesystem::free"
+    "filesystem::size"
+    "filesystem::used")
+  "GVFS file system attributes.")
+
+(defconst tramp-gvfs-file-system-attributes-regexp
+  (concat "^[[:blank:]]*"
+	  (regexp-opt tramp-gvfs-file-system-attributes t)
+	  ":[[:blank:]]+\\(.*\\)$")
+  "Regexp to parse GVFS file system attributes with `gvfs-info'.")
+
 
 ;; New handlers should be added here.
 ;;;###tramp-autoload
@@ -494,6 +506,7 @@ Every entry is a list (NAME ADDRESS).")
     (file-remote-p . tramp-handle-file-remote-p)
     (file-selinux-context . ignore)
     (file-symlink-p . tramp-handle-file-symlink-p)
+    (file-system-info . tramp-gvfs-handle-file-system-info)
     (file-truename . tramp-handle-file-truename)
     (file-writable-p . tramp-gvfs-handle-file-writable-p)
     (find-backup-file-name . tramp-handle-find-backup-file-name)
@@ -825,7 +838,7 @@ file names."
     (let ((last-coding-system-used last-coding-system-used)
 	  result)
       (with-parsed-tramp-file-name directory nil
-	(with-tramp-file-property v localname "directory-gvfs-attributes"
+	(with-tramp-file-property v localname "directory-attributes"
 	  (tramp-message v 5 "directory gvfs attributes: %s" localname)
 	  ;; Send command.
 	  (tramp-gvfs-send-command
@@ -860,23 +873,34 @@ file names."
 	      (forward-line)))
 	  result)))))
 
-(defun tramp-gvfs-get-root-attributes (filename)
-  "Return GVFS attributes association list of FILENAME."
+(defun tramp-gvfs-get-root-attributes (filename &optional file-system)
+  "Return GVFS attributes association list of FILENAME.
+If FILE-SYSTEM is non-nil, return file system attributes."
   (ignore-errors
     ;; Don't modify `last-coding-system-used' by accident.
     (let ((last-coding-system-used last-coding-system-used)
 	  result)
       (with-parsed-tramp-file-name filename nil
-	(with-tramp-file-property v localname "file-gvfs-attributes"
-	  (tramp-message v 5 "file gvfs attributes: %s" localname)
+	(with-tramp-file-property
+	    v localname
+	    (if file-system "file-system-attributes" "file-attributes")
+	  (tramp-message
+	   v 5 "file%s gvfs attributes: %s"
+	   (if file-system " system" "") localname)
 	  ;; Send command.
-	  (tramp-gvfs-send-command
-	   v "gvfs-info" (tramp-gvfs-url-file-name filename))
+	  (if file-system
+	      (tramp-gvfs-send-command
+	       v "gvfs-info" "--filesystem" (tramp-gvfs-url-file-name filename))
+	    (tramp-gvfs-send-command
+	     v "gvfs-info" (tramp-gvfs-url-file-name filename)))
 	  ;; Parse output.
 	  (with-current-buffer (tramp-get-connection-buffer v)
 	    (goto-char (point-min))
 	    (while (re-search-forward
-		    tramp-gvfs-file-attributes-with-gvfs-info-regexp nil t)
+		    (if file-system
+			tramp-gvfs-file-system-attributes-regexp
+		      tramp-gvfs-file-attributes-with-gvfs-info-regexp)
+		    nil t)
 	      (push (cons (match-string 1) (match-string 2)) result))
 	    result))))))
 
@@ -1127,6 +1151,22 @@ file-notify events."
     (with-tramp-file-property v localname "file-readable-p"
       (tramp-check-cached-permissions v ?r))))
 
+(defun tramp-gvfs-handle-file-system-info (filename)
+  "Like `file-system-info' for Tramp files."
+  (setq filename (directory-file-name (expand-file-name filename)))
+  (with-parsed-tramp-file-name filename nil
+    ;; We don't use cached values.
+    (tramp-set-file-property v localname "file-system-attributes" 'undef)
+    (let* ((attr (tramp-gvfs-get-root-attributes filename 'file-system))
+	   (size (cdr (assoc "filesystem::size" attr)))
+	   (used (cdr (assoc "filesystem::used" attr)))
+	   (free (cdr (assoc "filesystem::free" attr))))
+      (when (and (stringp size) (stringp used) (stringp free))
+	(list (string-to-number (concat size "e0"))
+	      (- (string-to-number (concat size "e0"))
+		 (string-to-number (concat used "e0")))
+	      (string-to-number (concat free "e0")))))))
+
 (defun tramp-gvfs-handle-file-writable-p (filename)
   "Like `file-writable-p' for Tramp files."
   (with-parsed-tramp-file-name filename nil
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index a744a53ca42..bdb7a132408 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1020,6 +1020,7 @@ of command line.")
     (file-remote-p . tramp-handle-file-remote-p)
     (file-selinux-context . tramp-sh-handle-file-selinux-context)
     (file-symlink-p . tramp-handle-file-symlink-p)
+    (file-system-info . tramp-sh-handle-file-system-info)
     (file-truename . tramp-sh-handle-file-truename)
     (file-writable-p . tramp-sh-handle-file-writable-p)
     (find-backup-file-name . tramp-handle-find-backup-file-name)
@@ -2739,6 +2740,17 @@ The method used must be an out-of-band method."
 	     beg 'noerror)
 	    (replace-match (file-relative-name filename) t))
 
+	  ;; Try to insert the amount of free space.
+	  (goto-char (point-min))
+	  ;; First find the line to put it on.
+	  (when (re-search-forward "^\\([[:space:]]*total\\)" nil t)
+	    (let ((available (get-free-disk-space ".")))
+	      (when available
+		;; Replace "total" with "total used", to avoid confusion.
+		(replace-match "\\1 used in directory")
+		(end-of-line)
+		(insert " available " available))))
+
 	  (goto-char (point-max)))))))
 
 ;; Canonicalization of file names.
@@ -3701,6 +3713,30 @@ file-notify events."
 	   'file-notify-handle-event
 	   `(file-notify ,object file-notify-callback)))))))
 
+(defun tramp-sh-handle-file-system-info (filename)
+  "Like `file-system-info' for Tramp files."
+  (ignore-errors
+    (with-parsed-tramp-file-name (expand-file-name filename) nil
+      (when (tramp-get-remote-df v)
+	(tramp-message v 5 "file system info: %s" localname)
+	(tramp-send-command
+	 v (format
+	    "%s --block-size=1 --output=size,used,avail %s"
+	    (tramp-get-remote-df v) (tramp-shell-quote-argument localname)))
+	(with-current-buffer (tramp-get-connection-buffer v)
+	  (goto-char (point-min))
+	  (forward-line)
+	  (when (looking-at
+		 (concat "[[:space:]]*\\([[:digit:]]+\\)"
+			 "[[:space:]]+\\([[:digit:]]+\\)"
+			 "[[:space:]]+\\([[:digit:]]+\\)"))
+	    (list (string-to-number (concat (match-string 1) "e0"))
+		  ;; The second value is the used size.  We need the
+		  ;; free size.
+		  (- (string-to-number (concat (match-string 1) "e0"))
+		     (string-to-number (concat (match-string 2) "e0")))
+		  (string-to-number (concat (match-string 3) "e0")))))))))
+
 ;;; Internal Functions:
 
 (defun tramp-maybe-send-script (vec script name)
@@ -5404,6 +5440,17 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil."
 	(delete-file tmpfile))
       result)))
 
+(defun tramp-get-remote-df (vec)
+  "Determine remote `df' command."
+  (with-tramp-connection-property vec "df"
+    (tramp-message vec 5 "Finding a suitable `df' command")
+    (let ((result (tramp-find-executable vec "df" (tramp-get-remote-path vec))))
+      (and
+       result
+       (tramp-send-command-and-check
+	vec (format "%s --block-size=1 --output=size,used,avail /" result))
+       result))))
+
 (defun tramp-get-remote-gvfs-monitor-dir (vec)
   "Determine remote `gvfs-monitor-dir' command."
   (with-tramp-connection-property vec "gvfs-monitor-dir"
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 35aa8110946..620c93828da 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -255,6 +255,7 @@ See `tramp-actions-before-shell' for more info.")
     (file-remote-p . tramp-handle-file-remote-p)
     ;; `file-selinux-context' performed by default handler.
     (file-symlink-p . tramp-handle-file-symlink-p)
+    (file-system-info . tramp-smb-handle-file-system-info)
     (file-truename . tramp-handle-file-truename)
     (file-writable-p . tramp-smb-handle-file-writable-p)
     (find-backup-file-name . tramp-handle-find-backup-file-name)
@@ -954,6 +955,38 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
 		(nth 0 x))))
 	   (tramp-smb-get-file-entries directory))))))))
 
+(defun tramp-smb-handle-file-system-info (filename)
+  "Like `file-system-info' for Tramp files."
+  (ignore-errors
+    (unless (file-directory-p filename)
+      (setq filename (file-name-directory filename)))
+    (with-parsed-tramp-file-name (expand-file-name filename) nil
+      (tramp-message v 5 "file system info: %s" localname)
+      (tramp-smb-send-command v (format "du %s/*" (tramp-smb-get-localname v)))
+      (with-current-buffer (tramp-get-connection-buffer v)
+	(let (total avail blocksize)
+	  (goto-char (point-min))
+	  (forward-line)
+	  (when (looking-at
+		 (concat "[[:space:]]*\\([[:digit:]]+\\)"
+			 " blocks of size \\([[:digit:]]+\\)"
+			 "\\. \\([[:digit:]]+\\) blocks available"))
+	    (setq blocksize (string-to-number (concat (match-string 2) "e0"))
+		  total (* blocksize
+			   (string-to-number (concat (match-string 1) "e0")))
+		  avail (* blocksize
+			   (string-to-number (concat (match-string 3) "e0")))))
+	  (forward-line)
+	  (when (looking-at "Total number of bytes: \\([[:digit:]]+\\)")
+	    ;; The used number of bytes is not part of the result.  As
+	    ;; side effect, we store it as file property.
+	    (tramp-set-file-property
+	     v localname "used-bytes"
+	     (string-to-number (concat (match-string 1) "e0"))))
+	  ;; Result.
+	  (when (and total avail)
+	    (list total (- total avail) avail)))))))
+
 (defun tramp-smb-handle-file-writable-p (filename)
   "Like `file-writable-p' for Tramp files."
   (if (file-exists-p filename)
@@ -984,7 +1017,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
 	      ;; We should not destroy the cache entry.
 	      (entries (copy-sequence
 			(tramp-smb-get-file-entries
-			 (file-name-directory filename)))))
+			 (file-name-directory filename))))
+	      (avail (get-free-disk-space filename))
+	      ;; `get-free-disk-space' calls `file-system-info', which
+	      ;; sets file property "used-bytes" as side effect.
+	      (used
+	       (format
+		"%.0f"
+		(/ (tramp-get-file-property v localname "used-bytes" 0) 1024))))
 
 	  (when wildcard
 	    (string-match "\\." base)
@@ -1032,6 +1072,12 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
 		   (setcar x (concat (car x) "*"))))))
 	     entries))
 
+	  ;; Insert size information.
+	  (insert
+	   (if avail
+	       (format "total used in directory %s available %s\n" used avail)
+	     (format "total %s\n" used)))
+
 	  ;; Print entries.
 	  (mapc
 	   (lambda (x)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index e253db0883c..c8b6e68f719 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1269,14 +1269,14 @@ entry does not exist, return nil."
 ;;;###tramp-autoload
 (defun tramp-tramp-file-p (name)
   "Return t if NAME is a string with Tramp file name syntax."
-  (save-match-data
-    (and (stringp name)
-	 ;; No "/:" and "/c:".  This is not covered by `tramp-file-name-regexp'.
-	 (not (string-match
-	       (if (memq system-type '(cygwin windows-nt))
-		   "^/[[:alpha:]]?:" "^/:")
-	       name))
-	 (string-match tramp-file-name-regexp name))))
+  (and (stringp name)
+       ;; No "/:" and "/c:".  This is not covered by `tramp-file-name-regexp'.
+       (not (string-match-p
+	     (if (memq system-type '(cygwin windows-nt))
+		 "^/[[:alpha:]]?:" "^/:")
+	     name))
+       (string-match-p tramp-file-name-regexp name)
+       t))
 
 (defun tramp-find-method (method user host)
   "Return the right method string to use.
@@ -2079,7 +2079,9 @@ ARGS are the arguments OPERATION has been called with."
 	      substitute-in-file-name unhandled-file-name-directory
 	      vc-registered
 	      ;; Emacs 26+ only.
-	      file-name-case-insensitive-p))
+	      file-name-case-insensitive-p
+	      ;; Emacs 27+ only.
+	      file-system-info))
     (if (file-name-absolute-p (nth 0 args))
 	(nth 0 args)
       default-directory))