Merge branch 'feature/native-comp' into feature/native-comp-macos-fixesfeature/native-comp-macos-fixes

6 files changed, 190 insertions, 240 deletions

diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el
index 56ea033a963..bb6682520ae 100644
--- a/lisp/net/eudc-bob.el
+++ b/lisp/net/eudc-bob.el
@@ -1,4 +1,4 @@
-;;; eudc-bob.el --- Binary Objects Support for EUDC
+;;; eudc-bob.el --- Binary Objects Support for EUDC  -*- lexical-binding: t; -*-
 
 ;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
 
@@ -39,19 +39,41 @@
 
 (require 'eudc)
 
-(defvar eudc-bob-generic-keymap nil
+(defvar eudc-bob-generic-keymap
+  (let ((map (make-sparse-keymap)))
+    (define-key map "s" 'eudc-bob-save-object)
+    (define-key map "!" 'eudc-bob-pipe-object-to-external-program)
+    (define-key map [down-mouse-3] 'eudc-bob-popup-menu)
+    map)
   "Keymap for multimedia objects.")
 
-(defvar eudc-bob-image-keymap nil
+(defvar eudc-bob-image-keymap
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map eudc-bob-generic-keymap)
+    (define-key map "t" 'eudc-bob-toggle-inline-display)
+    map)
   "Keymap for inline images.")
 
-(defvar eudc-bob-sound-keymap nil
+(defvar eudc-bob-sound-keymap
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map eudc-bob-generic-keymap)
+    (define-key map (kbd "RET") 'eudc-bob-play-sound-at-point)
+    (define-key map [down-mouse-2] 'eudc-bob-play-sound-at-mouse)
+    map)
   "Keymap for inline sounds.")
 
-(defvar eudc-bob-url-keymap nil
+(defvar eudc-bob-url-keymap
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "RET") 'browse-url-at-point)
+    (define-key map [down-mouse-2] 'browse-url-at-mouse)
+    map)
   "Keymap for inline urls.")
 
-(defvar eudc-bob-mail-keymap nil
+(defvar eudc-bob-mail-keymap
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "RET") 'goto-address-at-point)
+    (define-key map [down-mouse-2] 'goto-address-at-point)
+    map)
   "Keymap for inline e-mail addresses.")
 
 (defvar eudc-bob-generic-menu
@@ -74,13 +96,6 @@
      (fboundp 'play-sound-internal)]
     ,@(cdr (cdr eudc-bob-generic-menu))))
 
-(defun eudc-jump-to-event (event)
-  "Jump to the window and point where EVENT occurred."
-  (if (fboundp 'event-closest-point)
-      (goto-char (event-closest-point event))
-    (set-buffer (window-buffer (posn-window (event-start event))))
-    (goto-char (posn-point (event-start event)))))
-
 (defun eudc-bob-get-overlay-prop (prop)
   "Get property PROP from one of the overlays around."
   (let ((overlays (append (overlays-at (1- (point)))
@@ -205,42 +220,30 @@ display a button."
   "Play the sound data contained in the button where EVENT occurred."
   (interactive "e")
   (save-excursion
-    (eudc-jump-to-event event)
+    (mouse-set-point event)
     (eudc-bob-play-sound-at-point)))
 
-(defun eudc-bob-save-object ()
+(defun eudc-bob-save-object (filename)
   "Save the object data of the button at point."
-  (interactive)
+  (interactive "fWrite file: ")
   (let ((data (eudc-bob-get-overlay-prop 'object-data))
-	(buffer (generate-new-buffer "*eudc-tmp*")))
-    (save-excursion
-      (set-buffer-file-coding-system 'binary)
-      (set-buffer buffer)
-      (set-buffer-multibyte nil)
-      (insert data)
-      (save-buffer))
-    (kill-buffer buffer)))
+	(coding-system-for-write 'binary)) ;Inhibit EOL conversion.
+    (write-region data nil filename)))
 
-(defun eudc-bob-pipe-object-to-external-program ()
+(defun eudc-bob-pipe-object-to-external-program (program)
   "Pipe the object data of the button at point to an external program."
-  (interactive)
+  (interactive (list (completing-read "Viewer: " eudc-external-viewers)))
   (let ((data (eudc-bob-get-overlay-prop 'object-data))
-	(buffer (generate-new-buffer "*eudc-tmp*"))
-	program
-	viewer)
-    (condition-case nil
-	(save-excursion
-	  (set-buffer-file-coding-system 'binary)
-	  (set-buffer buffer)
-	  (insert data)
-	  (setq program (completing-read "Viewer: " eudc-external-viewers))
-	  (if (setq viewer (assoc program eudc-external-viewers))
-	      (call-process-region (point-min) (point-max)
-				   (car (cdr viewer))
-				   (cdr (cdr viewer)))
-	    (call-process-region (point-min) (point-max) program)))
-      (error
-       (kill-buffer buffer)))))
+	(viewer (assoc program eudc-external-viewers)))
+    (with-temp-buffer
+      (set-buffer-multibyte nil)
+      (insert data)
+      (let ((coding-system-for-write 'binary)) ;Inhibit EOL conversion
+	(if viewer
+	    (call-process-region (point-min) (point-max)
+			         (car (cdr viewer))
+			         (cdr (cdr viewer)))
+	  (call-process-region (point-min) (point-max) program))))))
 
 (defun eudc-bob-menu ()
   "Retrieve the menu attached to a binary object."
@@ -250,47 +253,8 @@ display a button."
   "Pop-up a menu of EUDC multimedia commands."
   (interactive "@e")
   (run-hooks 'activate-menubar-hook)
-  (eudc-jump-to-event event)
-  (let ((result (x-popup-menu t (eudc-bob-menu)))
-	command)
-    (if result
-	(progn
-	  (setq command (lookup-key (eudc-bob-menu)
-				    (apply 'vector result)))
-	  (command-execute command)))))
-
-(setq eudc-bob-generic-keymap
-      (let ((map (make-sparse-keymap)))
-	(define-key map "s" 'eudc-bob-save-object)
-	(define-key map "!" 'eudc-bob-pipe-object-to-external-program)
-	(define-key map [down-mouse-3] 'eudc-bob-popup-menu)
-	map))
-
-(setq eudc-bob-image-keymap
-      (let ((map (make-sparse-keymap)))
-	(define-key map "t" 'eudc-bob-toggle-inline-display)
-	map))
-
-(setq eudc-bob-sound-keymap
-      (let ((map (make-sparse-keymap)))
-	(define-key map [return] 'eudc-bob-play-sound-at-point)
-	(define-key map [down-mouse-2] 'eudc-bob-play-sound-at-mouse)
-	map))
-
-(setq eudc-bob-url-keymap
-      (let ((map (make-sparse-keymap)))
-	(define-key map [return] 'browse-url-at-point)
-	(define-key map [down-mouse-2] 'browse-url-at-mouse)
-	map))
-
-(setq eudc-bob-mail-keymap
-      (let ((map (make-sparse-keymap)))
-	(define-key map [return] 'goto-address-at-point)
-	(define-key map [down-mouse-2] 'goto-address-at-point)
-	map))
-
-(set-keymap-parent eudc-bob-image-keymap eudc-bob-generic-keymap)
-(set-keymap-parent eudc-bob-sound-keymap eudc-bob-generic-keymap)
+  (mouse-set-point event)
+  (popup-menu (eudc-bob-menu) event))
 
 ;; If the first arguments can be nil here, then these 3 can be
 ;; defconsts once more.
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index e7170b3e6d1..04deb5bee05 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -672,9 +672,30 @@ Currently this means either text/html or application/xhtml+xml."
   (setq header-line-format
 	(and eww-header-line-format
 	     (let ((title (plist-get eww-data :title))
-		   (peer (plist-get eww-data :peer)))
+		   (peer (plist-get eww-data :peer))
+                   (url (plist-get eww-data :url)))
 	       (when (zerop (length title))
 		 (setq title "[untitled]"))
+               ;; Limit the length of the title so that the host name
+               ;; of the URL is always visible.
+               (when url
+                 (let* ((parsed (url-generic-parse-url url))
+                        (host-length (length (format "%s://%s"
+                                                     (url-type parsed)
+                                                     (url-host parsed))))
+                        (width (window-width)))
+                   (cond
+                    ;; The host bit is wider than the window, so nix
+                    ;; the title.
+                    ((> (+ host-length 5) width)
+                     (setq title ""))
+                    ;; Trim the title.
+                    ((> (+ (length title) host-length 2) width)
+                     (setq title (concat
+                                  (substring title 0 (- width
+                                                        host-length
+                                                        5))
+                                  "..."))))))
 	       ;; This connection has is https.
 	       (when peer
 		 (setq title
@@ -686,7 +707,7 @@ Currently this means either text/html or application/xhtml+xml."
 		"%" "%%"
 		(format-spec
 		 eww-header-line-format
-		 `((?u . ,(or (plist-get eww-data :url) ""))
+		 `((?u . ,(or url ""))
 		   (?t . ,title))))))))
 
 (defun eww-tag-title (dom)
diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el
index 1bed61f3e7d..ff8a447c7c1 100644
--- a/lisp/net/newst-treeview.el
+++ b/lisp/net/newst-treeview.el
@@ -131,14 +131,6 @@ groupcontent := feedname | groupdefinition)
 Example: (\"Topmost group\" \"feed1\" (\"subgroup1\" \"feed 2\")
 \"feed3\")")
 
-(defcustom newsticker-groups-filename
-  nil
-  "Name of the newsticker groups settings file."
-  :version "25.1"                       ; changed default value to nil
-  :type '(choice (const nil) string)
-  :group 'newsticker-treeview)
-(make-obsolete-variable 'newsticker-groups-filename 'newsticker-dir "23.1")
-
 ;; ======================================================================
 ;;; internal variables
 ;; ======================================================================
@@ -1265,29 +1257,9 @@ Note: does not update the layout."
 (defun newsticker--treeview-load ()
   "Load treeview settings."
   (let* ((coding-system-for-read 'utf-8)
-         (filename
-          (or (and newsticker-groups-filename
-                   (not (string=
-                         (expand-file-name newsticker-groups-filename)
-                         (expand-file-name (concat newsticker-dir "/groups"))))
-                   (file-exists-p newsticker-groups-filename)
-                   (y-or-n-p
-                    (format-message
-                     (concat "Obsolete variable `newsticker-groups-filename' "
-                             "points to existing file \"%s\".\n"
-                             "Read it? ")
-                     newsticker-groups-filename))
-                   newsticker-groups-filename)
-              (concat newsticker-dir "/groups")))
+         (filename (concat newsticker-dir "/groups"))
          (buf (and (file-exists-p filename)
                    (find-file-noselect filename))))
-    (and newsticker-groups-filename
-         (file-exists-p newsticker-groups-filename)
-	 (y-or-n-p (format-message
-                    (concat "Delete the file \"%s\",\nto which the obsolete "
-                            "variable `newsticker-groups-filename' points ? ")
-                    newsticker-groups-filename))
-	 (delete-file newsticker-groups-filename))
     (when buf
       (set-buffer buf)
       (goto-char (point-min))
diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el
index ebcd21948bf..9401430799c 100644
--- a/lisp/net/ntlm.el
+++ b/lisp/net/ntlm.el
@@ -69,7 +69,6 @@
 
 (require 'md4)
 (require 'hmac-md5)
-(require 'calc)
 
 (defgroup ntlm nil
   "NTLM (NT LanManager) authentication."
@@ -133,32 +132,27 @@ is not given."
 	    domain				;buffer field
 	    ))))
 
-(defun ntlm-compute-timestamp ()
-  "Compute an NTLMv2 timestamp.
+(defun ntlm--time-to-timestamp (time)
+  "Convert TIME to an NTLMv2 timestamp.
 Return a unibyte string representing the number of tenths of a
 microsecond since January 1, 1601 as a 64-bit little-endian
-signed integer."
-  ;; FIXME: This can likely be significantly simplified using the new
-  ;; bignums support!
-  (let* ((s-to-tenths-of-us "mul(add(lsh($1,16),$2),10000000)")
-	 (us-to-tenths-of-us "mul($3,10)")
-	 (ps-to-tenths-of-us "idiv($4,100000)")
-	 (tenths-of-us-since-jan-1-1601
-	  (apply #'calc-eval (concat "add(add(add("
-				    s-to-tenths-of-us ","
-				    us-to-tenths-of-us "),"
-				    ps-to-tenths-of-us "),"
-				    ;; tenths of microseconds between
-				    ;; 1601-01-01 and 1970-01-01
-				    "116444736000000000)")
-		 'rawnum (time-convert nil 'list)))
-	 result-bytes)
-    (dotimes (_byte 8)
-      (push (calc-eval "and($1,16#FF)" 'rawnum tenths-of-us-since-jan-1-1601)
-	    result-bytes)
-      (setq tenths-of-us-since-jan-1-1601
-	    (calc-eval "rsh($1,8,64)" 'rawnum tenths-of-us-since-jan-1-1601)))
-    (apply #'unibyte-string (nreverse result-bytes))))
+signed integer.  TIME must be on the form (HIGH LOW USEC PSEC)."
+  (let* ((s (+ (ash (nth 0 time) 16) (nth 1 time)))
+         (us (nth 2 time))
+         (ps (nth 3 time))
+         (tenths-of-us-since-jan-1-1601
+          (+ (* s 10000000) (* us 10) (/ ps 100000)
+	     ;; tenths of microseconds between 1601-01-01 and 1970-01-01
+	     116444736000000000)))
+    (apply #'unibyte-string
+           (mapcar (lambda (i)
+                     (logand (ash tenths-of-us-since-jan-1-1601 (* i -8))
+                             #xff))
+                   (number-sequence 0 7)))))
+
+(defun ntlm-compute-timestamp ()
+  "Current time as an NTLMv2 timestamp, as a unibyte string."
+  (ntlm--time-to-timestamp (time-convert nil 'list)))
 
 (defun ntlm-generate-nonce ()
   "Generate a random nonce, not to be used more than once.
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index ca43475f453..fae15fe6a8e 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -4781,104 +4781,6 @@ Goes through the list `tramp-inline-compress-commands'."
 	(tramp-message
 	 vec 2 "Couldn't find an inline transfer compress command")))))
 
-;;;###tramp-autoload
-(defun tramp-multi-hop-p (vec)
-  "Whether the method of VEC is capable of multi-hops."
-  (and (tramp-sh-file-name-handler-p vec)
-       (not (tramp-get-method-parameter vec 'tramp-copy-program))))
-
-(defun tramp-compute-multi-hops (vec)
-  "Expands VEC according to `tramp-default-proxies-alist'."
-  (let ((saved-tdpa tramp-default-proxies-alist)
-	(target-alist `(,vec))
-	(hops (or (tramp-file-name-hop vec) ""))
-	(item vec)
-	choices proxy)
-
-    ;; Ad-hoc proxy definitions.
-    (dolist (proxy (reverse (split-string hops tramp-postfix-hop-regexp 'omit)))
-      (let* ((host-port (tramp-file-name-host-port item))
-	     (user-domain (tramp-file-name-user-domain item))
-	     (proxy (concat
-		     tramp-prefix-format proxy tramp-postfix-host-format))
-	     (entry
-	      (list (and (stringp host-port)
-			 (concat "^" (regexp-quote host-port) "$"))
-		    (and (stringp user-domain)
-			 (concat "^" (regexp-quote user-domain) "$"))
-		    (propertize proxy 'tramp-ad-hoc t))))
-	(tramp-message vec 5 "Add %S to `tramp-default-proxies-alist'" entry)
-	;; Add the hop.
-	(add-to-list 'tramp-default-proxies-alist entry)
-	(setq item (tramp-dissect-file-name proxy))))
-    ;; Save the new value.
-    (when (and hops tramp-save-ad-hoc-proxies)
-      (customize-save-variable
-       'tramp-default-proxies-alist tramp-default-proxies-alist))
-
-    ;; Look for proxy hosts to be passed.
-    (setq choices tramp-default-proxies-alist)
-    (while choices
-      (setq item (pop choices)
-	    proxy (eval (nth 2 item)))
-      (when (and
-	     ;; Host.
-	     (string-match-p
-	      (or (eval (nth 0 item)) "")
-	      (or (tramp-file-name-host-port (car target-alist)) ""))
-	     ;; User.
-	     (string-match-p
-	      (or (eval (nth 1 item)) "")
-	      (or (tramp-file-name-user-domain (car target-alist)) "")))
-	(if (null proxy)
-	    ;; No more hops needed.
-	    (setq choices nil)
-	  ;; Replace placeholders.
-	  (setq proxy
-		(format-spec
-		 proxy
-		 (format-spec-make
-		  ?u (or (tramp-file-name-user (car target-alist)) "")
-		  ?h (or (tramp-file-name-host (car target-alist)) ""))))
-	  (with-parsed-tramp-file-name proxy l
-	    ;; Add the hop.
-	    (push l target-alist)
-	    ;; Start next search.
-	    (setq choices tramp-default-proxies-alist)))))
-
-    ;; Foreign and out-of-band methods are not supported for multi-hops.
-    (when (cdr target-alist)
-      (setq choices target-alist)
-      (while (setq item (pop choices))
-	(unless (tramp-multi-hop-p item)
-	  (setq tramp-default-proxies-alist saved-tdpa)
-	  (tramp-user-error
-	   vec "Method `%s' is not supported for multi-hops."
-	   (tramp-file-name-method item)))))
-
-    ;; Some methods ("su", "sg", "sudo", "doas", "ksu") do not use the
-    ;; host name in their command template.  In this case, the remote
-    ;; file name must use either a local host name (first hop), or a
-    ;; host name matching the previous hop.
-    (let ((previous-host (or tramp-local-host-regexp "")))
-      (setq choices target-alist)
-      (while (setq item (pop choices))
-	(let ((host (tramp-file-name-host item)))
-	  (unless
-	      (or
-	       ;; The host name is used for the remote shell command.
-	       (member
-		'("%h") (tramp-get-method-parameter item 'tramp-login-args))
-	       ;; The host name must match previous hop.
-	       (string-match-p previous-host host))
-	    (setq tramp-default-proxies-alist saved-tdpa)
-	    (tramp-user-error
-	     vec "Host name `%s' does not match `%s'" host previous-host))
-	  (setq previous-host (concat "^" (regexp-quote host) "$")))))
-
-    ;; Result.
-    target-alist))
-
 (defun tramp-ssh-controlmaster-options (vec)
   "Return the Control* arguments of the local ssh."
   (cond
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index ab52bec39eb..83ade66ee14 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3634,12 +3634,109 @@ User is always nil."
 	      (delete-file local-copy)))))
       t)))
 
+(defun tramp-multi-hop-p (vec)
+  "Whether the method of VEC is capable of multi-hops."
+  (and (tramp-sh-file-name-handler-p vec)
+       (not (tramp-get-method-parameter vec 'tramp-copy-program))))
+
+(defun tramp-compute-multi-hops (vec)
+  "Expands VEC according to `tramp-default-proxies-alist'."
+  (let ((saved-tdpa tramp-default-proxies-alist)
+	(target-alist `(,vec))
+	(hops (or (tramp-file-name-hop vec) ""))
+	(item vec)
+	choices proxy)
+
+    ;; Ad-hoc proxy definitions.
+    (dolist (proxy (reverse (split-string hops tramp-postfix-hop-regexp 'omit)))
+      (let* ((host-port (tramp-file-name-host-port item))
+	     (user-domain (tramp-file-name-user-domain item))
+	     (proxy (concat
+		     tramp-prefix-format proxy tramp-postfix-host-format))
+	     (entry
+	      (list (and (stringp host-port)
+			 (concat "^" (regexp-quote host-port) "$"))
+		    (and (stringp user-domain)
+			 (concat "^" (regexp-quote user-domain) "$"))
+		    (propertize proxy 'tramp-ad-hoc t))))
+	(tramp-message vec 5 "Add %S to `tramp-default-proxies-alist'" entry)
+	;; Add the hop.
+	(add-to-list 'tramp-default-proxies-alist entry)
+	(setq item (tramp-dissect-file-name proxy))))
+    ;; Save the new value.
+    (when (and hops tramp-save-ad-hoc-proxies)
+      (customize-save-variable
+       'tramp-default-proxies-alist tramp-default-proxies-alist))
+
+    ;; Look for proxy hosts to be passed.
+    (setq choices tramp-default-proxies-alist)
+    (while choices
+      (setq item (pop choices)
+	    proxy (eval (nth 2 item)))
+      (when (and
+	     ;; Host.
+	     (string-match-p
+	      (or (eval (nth 0 item)) "")
+	      (or (tramp-file-name-host-port (car target-alist)) ""))
+	     ;; User.
+	     (string-match-p
+	      (or (eval (nth 1 item)) "")
+	      (or (tramp-file-name-user-domain (car target-alist)) "")))
+	(if (null proxy)
+	    ;; No more hops needed.
+	    (setq choices nil)
+	  ;; Replace placeholders.
+	  (setq proxy
+		(format-spec
+		 proxy
+		 (format-spec-make
+		  ?u (or (tramp-file-name-user (car target-alist)) "")
+		  ?h (or (tramp-file-name-host (car target-alist)) ""))))
+	  (with-parsed-tramp-file-name proxy l
+	    ;; Add the hop.
+	    (push l target-alist)
+	    ;; Start next search.
+	    (setq choices tramp-default-proxies-alist)))))
+
+    ;; Foreign and out-of-band methods are not supported for multi-hops.
+    (when (cdr target-alist)
+      (setq choices target-alist)
+      (while (setq item (pop choices))
+	(unless (tramp-multi-hop-p item)
+	  (setq tramp-default-proxies-alist saved-tdpa)
+	  (tramp-user-error
+	   vec "Method `%s' is not supported for multi-hops."
+	   (tramp-file-name-method item)))))
+
+    ;; Some methods ("su", "sg", "sudo", "doas", "ksu") do not use the
+    ;; host name in their command template.  In this case, the remote
+    ;; file name must use either a local host name (first hop), or a
+    ;; host name matching the previous hop.
+    (let ((previous-host (or tramp-local-host-regexp "")))
+      (setq choices target-alist)
+      (while (setq item (pop choices))
+	(let ((host (tramp-file-name-host item)))
+	  (unless
+	      (or
+	       ;; The host name is used for the remote shell command.
+	       (member
+		'("%h") (tramp-get-method-parameter item 'tramp-login-args))
+	       ;; The host name must match previous hop.
+	       (string-match-p previous-host host))
+	    (setq tramp-default-proxies-alist saved-tdpa)
+	    (tramp-user-error
+	     vec "Host name `%s' does not match `%s'" host previous-host))
+	  (setq previous-host (concat "^" (regexp-quote host) "$")))))
+
+    ;; Result.
+    target-alist))
+
 (defun tramp-direct-async-process-p (&rest args)
   "Whether direct async `make-process' can be called."
   (let ((v (tramp-dissect-file-name default-directory)))
-    (and (tramp-get-connection-property v"direct-async-process" nil)
-	   (not (tramp-multi-hop-p v))
-	   (not (plist-get args :stderr)))))
+    (and (tramp-get-connection-property v "direct-async-process" nil)
+	 (= (length (tramp-compute-multi-hops v)) 1)
+	 (not (plist-get args :stderr)))))
 
 ;; We use BUFFER also as connection buffer during setup. Because of
 ;; this, its original contents must be saved, and restored once