commit 261b060f12234baa6912ef40a9ce1a054f583ad0 (HEAD, refs/remotes/origin/master) Author: Martin Rudalics Date: Tue Nov 26 10:13:12 2019 +0100 2019-11-26 Martin Rudalics * lisp/window.el (switch-to-visible-buffer): Declare obsolete. (switch-to-prev-buffer-skip): New option. (switch-to-prev-buffer, switch-to-next-buffer): Obey 'switch-to-prev-buffer-skip'. * doc/lispref/windows.texi (Window History): Remove description of 'switch-to-visible-buffer'. Describe new option 'switch-to-prev-buffer-skip' * etc/NEWS: Mention switch from 'switch-to-visible-buffer' to 'switch-to-prev-buffer-skip'. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index f05a6db176..fdba259bf7 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -3920,8 +3920,13 @@ or killed, or has been already shown by a recent invocation of If repeated invocations of this command have already shown all buffers previously shown in @var{window}, further invocations will show buffers from the buffer list of the frame @var{window} appears on (@pxref{Buffer -List}), trying to skip buffers that are already shown in another window -on that frame. +List}). + +The option @code{switch-to-prev-buffer-skip} described below can be +used to inhibit switching to certain buffers, for example, to those +already shown in another window. Also, if @var{window}'s frame has a +@code{buffer-predicate} parameter (@pxref{Buffer Parameters}), that +predicate may inhibit switching to certain buffers. @end deffn @deffn Command switch-to-next-buffer &optional window @@ -3933,20 +3938,65 @@ defaults to the selected one. If there is no recent invocation of @code{switch-to-prev-buffer} that can be undone, this function tries to show a buffer from the buffer list of the frame @var{window} appears on (@pxref{Buffer List}). + +The option @code{switch-to-prev-buffer-skip} and the +@code{buffer-predicate} (@pxref{Buffer Parameters}) of @var{window}'s +frame affect this command as they do for @code{switch-to-prev-buffer}. @end deffn -By default @code{switch-to-prev-buffer} and @code{switch-to-next-buffer} -can switch to a buffer that is already shown in another window on the -same frame. The following option can be used to override this behavior. - -@defopt switch-to-visible-buffer -If this variable is non-@code{nil}, @code{switch-to-prev-buffer} and -@code{switch-to-next-buffer} may switch to a buffer that is already -visible on the same frame, provided the buffer was shown in the -relevant window before. If it is @code{nil}, -@code{switch-to-prev-buffer} and @code{switch-to-next-buffer} always -try to avoid switching to a buffer that is already visible in another -window on the same frame. The default is @code{t}. +By default @code{switch-to-prev-buffer} and +@code{switch-to-next-buffer} can switch to a buffer that is already +shown in another window. The following option can be used to override +this behavior. + +@defopt switch-to-prev-buffer-skip +If this variable is @code{nil}, @code{switch-to-prev-buffer} may +switch to any buffer, including those already shown in other windows. + +If this variable is non-@code{nil}, @code{switch-to-prev-buffer} will +refrain from switching to certain buffers. The following values can +be used: + +@itemize @bullet +@item +@code{this} means do not switch to a buffer shown on the frame that +hosts the window @code{switch-to-prev-buffer} is acting upon. + +@item +@code{visible} means do not switch to a buffer shown on any visible +frame. + +@item +0 (the number zero) means do not switch to a buffer shown on any +visible or iconified frame. + +@item +@code{t} means do not switch to a buffer shown on any live frame. + +@item +A function that takes three arguments---the @var{window} argument of +@code{switch-to-prev-buffer}, a buffer @code{switch-to-prev-buffer} +intends to switch to and the @var{bury-or-kill} argument of +@code{switch-to-prev-buffer}. If that function returns +non-@code{nil}, @code{switch-to-prev-buffer} will refrain from +switching to the buffer specified by the second argument. +@end itemize + +The command @code{switch-to-next-buffer} obeys this option in a +similar way. If this option specifies a function, +@code{switch-to-next-buffer} will call that function with the third +argument always @code{nil}. + +Note that since @code{switch-to-prev-buffer} is called by +@code{bury-buffer}, @code{replace-buffer-in-windows} and +@code{quit-restore-window} as well, customizing this option may also +affect the behavior of Emacs when a window is quit or a buffer gets +buried or killed. + +Note also that under certain circumstances +@code{switch-to-prev-buffer} and @code{switch-to-next-buffer} may +ignore this option, for example, when there is only one buffer left +these functions can switch to. @end defopt diff --git a/etc/NEWS b/etc/NEWS index a97cf20ea7..2a14eb2ecf 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -414,6 +414,16 @@ When non-nil, 'switch-to-buffer' uses 'pop-to-buffer-same-window' that respects display actions specified by 'display-buffer-alist' and 'display-buffer-overriding-action'. ++++ +** The option 'switch-to-visible-buffer' is now obsolete. +Customize 'switch-to-prev-buffer-skip' instead. + ++++ +** New option 'switch-to-prev-buffer-skip'. +This option allows to specify the set of buffers that may be shown by +'switch-to-prev-buffer' and 'switch-to-next-buffer' more stringently +than the now obsolete 'switch-to-visible-buffer'. + ** New 'flex' completion style An implementation of popular "flex/fuzzy/scatter" completion which matches strings where the pattern appears as a subsequence. Put diff --git a/lisp/window.el b/lisp/window.el index 7478047939..49fad75d3c 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -4409,6 +4409,68 @@ that is already visible in another window on the same frame." :version "24.1" :group 'windows) +(make-obsolete-variable 'switch-to-visible-buffer + 'switch-to-prev-buffer-skip "27.1") + +(defcustom switch-to-prev-buffer-skip nil + "Buffers `switch-to-prev-buffer' should skip. +If this variable is nil, `switch-to-prev-buffer' may switch to +any buffer, including those already shown in other windows. + +If this variable is non-nil, `switch-to-prev-buffer' will refrain +from switching to certain buffers according to the value of this +variable: + +- `this' means do not switch to a buffer shown on the frame that + hosts the window `switch-to-prev-buffer' is acting upon. + +- `visible' means do not switch to a buffer shown on any visible + frame. + +- 0 (the number zero) means do not switch to a buffer shown on + any visible or iconified frame. + +- t means do not switch to a buffer shown on any live frame. + +If this option specifies a function, that function is called with +three arguments - the WINDOW argument of `switch-to-prev-buffer', +a buffer `switch-to-prev-buffer' intends to switch to and the +BURY-OR-KILL argument of `switch-to-prev-buffer'. If that +function returns non-nil, `switch-to-prev-buffer' will not switch +to that buffer. + +Since `switch-to-prev-buffer' is called by `bury-buffer', +`replace-buffer-in-windows' and `quit-restore-window' among +others, customizing this option may also affect the behavior of +Emacs when a window is quit or a buffer gets buried or killed. + +The value of this option is consulted by `switch-to-next-buffer' +as well. In that case, if this option specifies a function, it +will be called with the third argument nil. + +Under certain circumstances `switch-to-prev-buffer' may ignore +this option, for example, when there is only one buffer left." + :type + '(choice (const :tag "Never" nil) + (const :tag "This frame" this) + (const :tag "Visible frames" visible) + (const :tag "Visible and iconified frames" 0) + (const :tag "Any frame" t) + (function :tag "Function")) + :version "27.1" + :group 'windows) + +(defun switch-to-prev-buffer-skip-p (skip window buffer &optional bury-or-kill) + "Return non-nil if `switch-to-prev-buffer' should skip BUFFER. +SKIP is a value derived from `switch-to-prev-buffer-skip', WINDOW +the window `switch-to-prev-buffer' acts upon. Optional argument +BURY-OR-KILL is passed unchanged by `switch-to-prev-buffer' and +omitted in calls from `switch-to-next-buffer'." + (when skip + (if (functionp skip) + (funcall skip window buffer bury-or-kill) + (get-buffer-window buffer skip)))) + (defun switch-to-prev-buffer (&optional window bury-or-kill) "In WINDOW switch to previous buffer. WINDOW must be a live window and defaults to the selected one. @@ -4424,6 +4486,12 @@ move the buffer to the end of WINDOW's previous buffers list so a future invocation of `switch-to-prev-buffer' less likely switches to it. +The option `switch-to-prev-buffer-skip' can be used to not switch +to certain buffers, for example, to those already shown in +another window. Also, if WINDOW's frame has a `buffer-predicate' +parameter, that predicate may inhibit switching to certain +buffers. + This function is called by `prev-buffer'." (interactive) (let* ((window (window-normalize-window window t)) @@ -4433,7 +4501,15 @@ This function is called by `prev-buffer'." ;; Save this since it's destroyed by `set-window-buffer'. (next-buffers (window-next-buffers window)) (pred (frame-parameter frame 'buffer-predicate)) - entry new-buffer killed-buffers visible) + (skip + (cond + ((or (functionp switch-to-prev-buffer-skip) + (memq switch-to-prev-buffer-skip '(t visible 0))) + switch-to-prev-buffer-skip) + ((or switch-to-prev-buffer-skip + (not switch-to-visible-buffer)) + frame))) + entry new-buffer killed-buffers skipped) (when (window-minibuffer-p window) ;; Don't switch in minibuffer window. (unless (setq window (minibuffer-selected-window)) @@ -4456,11 +4532,8 @@ This function is called by `prev-buffer'." ;; When BURY-OR-KILL is nil, avoid switching to a ;; buffer in WINDOW's next buffers list. (or bury-or-kill (not (memq new-buffer next-buffers)))) - (if (and (not switch-to-visible-buffer) - (get-buffer-window new-buffer frame)) - ;; Try to avoid showing a buffer visible in some other - ;; window. - (setq visible new-buffer) + (if (switch-to-prev-buffer-skip-p skip window new-buffer bury-or-kill) + (setq skipped new-buffer) (set-window-buffer-start-and-point window new-buffer (nth 1 entry) (nth 2 entry)) (throw 'found t)))) @@ -4478,18 +4551,17 @@ This function is called by `prev-buffer'." (when (and (buffer-live-p buffer) (not (eq buffer old-buffer)) (or (null pred) (funcall pred buffer)) + ;; Skip buffers whose names start with a space. (not (eq (aref (buffer-name buffer) 0) ?\s)) - ;; Don't show a buffer shown in a side window before. + ;; Skip buffers shown in a side window before. (not (buffer-local-value 'window--sides-shown buffer)) (or bury-or-kill (not (memq buffer next-buffers)))) - (if (and (not switch-to-visible-buffer) - (get-buffer-window buffer frame)) - ;; Try to avoid showing a buffer visible in some other window. - (unless visible - (setq visible buffer)) + (if (switch-to-prev-buffer-skip-p skip window buffer bury-or-kill) + (setq skipped (or skipped buffer)) (setq new-buffer buffer) (set-window-buffer-start-and-point window new-buffer) (throw 'found t))))) + (unless bury-or-kill ;; Scan reverted next buffers last (must not use nreverse ;; here!). @@ -4502,14 +4574,16 @@ This function is called by `prev-buffer'." (not (eq buffer old-buffer)) (or (null pred) (funcall pred buffer)) (setq entry (assq buffer (window-prev-buffers window)))) - (setq new-buffer buffer) - (set-window-buffer-start-and-point - window new-buffer (nth 1 entry) (nth 2 entry)) - (throw 'found t)))) - - ;; Show a buffer visible in another window. - (when visible - (setq new-buffer visible) + (if (switch-to-prev-buffer-skip-p skip window buffer bury-or-kill) + (setq skipped (or skipped buffer)) + (setq new-buffer buffer) + (set-window-buffer-start-and-point + window new-buffer (nth 1 entry) (nth 2 entry)) + (throw 'found t))))) + + (when skipped + ;; Show first skipped buffer. + (setq new-buffer skipped) (set-window-buffer-start-and-point window new-buffer))) (if bury-or-kill @@ -4547,7 +4621,15 @@ This function is called by `prev-buffer'." "In WINDOW switch to next buffer. WINDOW must be a live window and defaults to the selected one. Return the buffer switched to, nil if no suitable buffer could be -found. This function is called by `next-buffer'." +found. + +The option `switch-to-prev-buffer-skip' can be used to not switch +to certain buffers, for example, to those already shown in +another window. Also, if WINDOW's frame has a `buffer-predicate' +parameter, that predicate may inhibit switching to certain +buffers. + +This function is called by `next-buffer'." (interactive) (let* ((window (window-normalize-window window t)) (frame (window-frame window)) @@ -4555,7 +4637,15 @@ found. This function is called by `next-buffer'." (old-buffer (window-buffer window)) (next-buffers (window-next-buffers window)) (pred (frame-parameter frame 'buffer-predicate)) - new-buffer entry killed-buffers visible) + (skip + (cond + ((or (functionp switch-to-prev-buffer-skip) + (memq switch-to-prev-buffer-skip '(t visible 0))) + switch-to-prev-buffer-skip) + ((or switch-to-prev-buffer-skip + (not switch-to-visible-buffer)) + frame))) + new-buffer entry killed-buffers skipped) (when (window-minibuffer-p window) ;; Don't switch in minibuffer window. (unless (setq window (minibuffer-selected-window)) @@ -4574,10 +4664,12 @@ found. This function is called by `next-buffer'." (not (eq buffer old-buffer)) (or (null pred) (funcall pred buffer)) (setq entry (assq buffer (window-prev-buffers window)))) - (setq new-buffer buffer) - (set-window-buffer-start-and-point - window new-buffer (nth 1 entry) (nth 2 entry)) - (throw 'found t))) + (if (switch-to-prev-buffer-skip-p skip window buffer) + (setq skipped buffer) + (setq new-buffer buffer) + (set-window-buffer-start-and-point + window new-buffer (nth 1 entry) (nth 2 entry)) + (throw 'found t)))) ;; Scan the buffer list of WINDOW's frame next, skipping previous ;; buffers entries. Skip this step for side windows. (unless window-side @@ -4585,14 +4677,13 @@ found. This function is called by `next-buffer'." (when (and (buffer-live-p buffer) (not (eq buffer old-buffer)) (or (null pred) (funcall pred buffer)) + ;; Skip buffers whose names start with a space. (not (eq (aref (buffer-name buffer) 0) ?\s)) - ;; Don't show a buffer shown in a side window before. + ;; Skip buffers shown in a side window before. (not (buffer-local-value 'window--sides-shown buffer)) (not (assq buffer (window-prev-buffers window)))) - (if (and (not switch-to-visible-buffer) - (get-buffer-window buffer frame)) - ;; Try to avoid showing a buffer visible in some other window. - (setq visible buffer) + (if (switch-to-prev-buffer-skip-p skip window buffer) + (setq skipped (or skipped buffer)) (setq new-buffer buffer) (set-window-buffer-start-and-point window new-buffer) (throw 'found t))))) @@ -4605,18 +4696,15 @@ found. This function is called by `next-buffer'." (cons new-buffer killed-buffers)))) (not (eq new-buffer old-buffer)) (or (null pred) (funcall pred new-buffer))) - (if (and (not switch-to-visible-buffer) - (get-buffer-window new-buffer frame)) - ;; Try to avoid showing a buffer visible in some other window. - (unless visible - (setq visible new-buffer)) + (if (switch-to-prev-buffer-skip-p skip window new-buffer) + (setq skipped (or skipped new-buffer)) (set-window-buffer-start-and-point window new-buffer (nth 1 entry) (nth 2 entry)) (throw 'found t)))) - ;; Show a buffer visible in another window. - (when visible - (setq new-buffer visible) + (when skipped + ;; Show first skipped buffer. + (setq new-buffer skipped) (set-window-buffer-start-and-point window new-buffer))) ;; Remove `new-buffer' from and restore WINDOW's next buffers. commit b006095bc9eb1f963372cf862aa040e9a9d30331 Author: Alex Murray Date: Mon Nov 25 22:18:07 2019 +1030 Fix auth-source password lookup * lisp/net/network-stream.el (network-stream-certificate): Ensure :port is specified as a string to 'auth-source-search' (Bug#38371). Copyright-paperwork-exempt: yes diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index 1e9317bc18..b5419f1d57 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el @@ -233,7 +233,7 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." (ignore-errors (car (auth-source-search :max 1 :host host - :port service)))) + :port (format "%s" service))))) (key (plist-get auth-info :key)) (cert (plist-get auth-info :cert))) (and key cert (file-readable-p key) (file-readable-p cert) commit 650a514e996287106f9a9525b6f27068ec2a0cbf Author: Robert Pluim Date: Fri Nov 15 11:11:30 2019 +0100 Extend network-interface-list to return IPv6 and network info Bug#38218 * src/process.c (Fnetwork_interface_list): Extend argument list to allow requesting full network info and/or IPv4/IPv6 info. (network_interface_list) [HAVE_GETIFADDRS]: Use getifaddrs to retrieve interface IP addresses. * src/process.h: Update prototype of network_interface_list. * src/w32.c (g_b_init_get_adapters_addresses): New init flag. (globals_of_w32): Initialize it. (GetAdaptersAddresses_Proc): New function typedef. (get_adapters_addresses): New wrapper function. (init_winsock): Load htonl and ntohl. (sys_htonl, sys_ntohl): New wrapper functions. (network_interface_list): Implement in terms of get_adapters_addresses. * nt/inc/sys/socket.h: Add sys_htonl and sys_ntohl prototypes. * etc/NEWS: Announce IPv4/IPv6 changes in network-interface-list. * doc/lispref/processes.texi (Misc Network): Document updated arglist and return values for network-interface-list. diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index fc5832253f..e33ae287ff 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -2971,12 +2971,67 @@ non-@code{nil} if that particular network option is supported by on network connections. Note that they are supported only on some systems. -@defun network-interface-list -This function returns a list describing the network interfaces -of the machine you are using. The value is an alist whose -elements have the form @code{(@var{name} . @var{address})}. -@var{address} has the same form as the @var{local-address} -and @var{remote-address} arguments to @code{make-network-process}. +@defun network-interface-list &optional full family +This function returns a list describing the network interfaces of the +machine you are using. The value is an alist whose elements have the +form @code{(@var{ifname} . @var{address})}. @var{ifname} is a string +naming the interface, @var{address} has the same form as the +@var{local-address} and @var{remote-address} arguments to +@code{make-network-process}, i.e. a vector of integers. By default +both IPv4 and IPv6 addresses are returned if possible. + +Optional argument @var{full} non-@code{nil} means to instead return a +list of one or more elements of the form @w{@code{(@var{ifname} +@var{addr} @var{bcast} @var{netmask})}}. @var{ifname} is a non-unique +string naming the interface. @var{addr}, @var{bcast}, and +@var{netmask} are vectors of integers detailing the IP address, +broadcast address, and network mask. + +Optional argument @var{family} specified as symbol @code{ipv4} or +@code{ipv6} restricts the returned information to IPv4 and IPv6 +addresses respectively, independently of the value of @var{full}. +Speficying @code{ipv6} when IPv6 support is not available will result +in an error being signaled. + +Some examples: + +@example +(network-interface-list) @result{} +(("vmnet8" . + [172 16 76 1 0]) + ("vmnet1" . + [172 16 206 1 0]) + ("lo0" . + [65152 0 0 0 0 0 0 1 0]) + ("lo0" . + [0 0 0 0 0 0 0 1 0]) + ("lo0" . + [127 0 0 1 0])) +@end example + +@example +(network-interface-list t) @result{} +(("vmnet8" + [172 16 76 1 0] + [172 16 76 255 0] + [255 255 255 0 0]) + ("vmnet1" + [172 16 206 1 0] + [172 16 206 255 0] + [255 255 255 0 0]) + ("lo0" + [65152 0 0 0 0 0 0 1 0] + [65152 0 0 0 65535 65535 65535 65535 0] + [65535 65535 65535 65535 0 0 0 0 0]) + ("lo0" + [0 0 0 0 0 0 0 1 0] + [0 0 0 0 0 0 0 1 0] + [65535 65535 65535 65535 65535 65535 65535 65535 0]) + ("lo0" + [127 0 0 1 0] + [127 255 255 255 0] + [255 0 0 0 0])) +@end example @end defun @defun network-interface-info ifname @@ -2996,6 +3051,8 @@ The layer 2 address (Ethernet MAC address, for instance). @item flags The current flags of the interface. @end table + +Note that this function returns only IPv4 information. @end defun @defun format-network-address address &optional omit-port diff --git a/etc/NEWS b/etc/NEWS index 7e86ccc71e..a97cf20ea7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -240,6 +240,11 @@ in addition to the decimal/hex/octal representation. Default nil. ** New function 'network-lookup-address-info'. This does IPv4 and/or IPv6 address lookups on hostnames. ++++ +** 'network-interface-list' can now return IPv4 and IPv6 addresses. +IPv4 and IPv6 addresses are now returned by default if available, +optionally including netmask/broadcast address information. + --- ** Control of the threshold for using the 'distant-foreground' color. The threshold for color distance below which the 'distant-foreground' diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index 205b797488..5dc5244e6d 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -228,21 +228,22 @@ host address is a localhost address, or in the same subnet as one of the local interfaces, this function returns nil. Non-nil otherwise." (let ((addresses (network-lookup-address-info host)) - (network-interface-list (network-interface-list)) + (network-interface-list (network-interface-list t)) (off-net t)) (when (or (and (functionp nsm-trust-local-network) (funcall nsm-trust-local-network)) nsm-trust-local-network) (mapc - (lambda (address) + (lambda (ip) (mapc - (lambda (iface) - (let ((info (network-interface-info (car iface)))) + (lambda (info) + (let ((local-ip (nth 1 info)) + (mask (nth 2 info))) (when - (nsm-network-same-subnet (substring (car info) 0 -1) - (substring (car (cddr info)) 0 -1) - (substring address 0 -1)) + (nsm-network-same-subnet (substring local-ip 0 -1) + (substring mask 0 -1) + (substring ip 0 -1)) (setq off-net nil)))) network-interface-list)) addresses)) diff --git a/nt/inc/sys/socket.h b/nt/inc/sys/socket.h index 6d26ff907e..0f3943b453 100644 --- a/nt/inc/sys/socket.h +++ b/nt/inc/sys/socket.h @@ -92,6 +92,8 @@ typedef unsigned short uint16_t; #define connect sys_connect #define htons sys_htons #define ntohs sys_ntohs +#define htonl sys_htonl +#define ntohl sys_ntohl #define inet_addr sys_inet_addr #define gethostname sys_gethostname #define gethostbyname sys_gethostbyname @@ -112,6 +114,8 @@ int sys_bind (int s, const struct sockaddr *addr, int namelen); int sys_connect (int s, const struct sockaddr *addr, int namelen); u_short sys_htons (u_short hostshort); u_short sys_ntohs (u_short netshort); +u_long sys_htonl (u_long hostlong); +u_long sys_ntohl (u_long netlong); unsigned long sys_inet_addr (const char * cp); int sys_gethostname (char * name, int namelen); struct hostent * sys_gethostbyname (const char * name); diff --git a/src/process.c b/src/process.c index 9158cfd347..0f82682ae5 100644 --- a/src/process.c +++ b/src/process.c @@ -4255,73 +4255,86 @@ usage: (make-network-process &rest ARGS) */) } -#ifdef HAVE_NET_IF_H -#ifdef SIOCGIFCONF +#ifdef HAVE_GETIFADDRS static Lisp_Object -network_interface_list (void) +network_interface_list (bool full, unsigned short match) { - struct ifconf ifconf; - struct ifreq *ifreq; - void *buf = NULL; - ptrdiff_t buf_size = 512; - int s; - Lisp_Object res; - ptrdiff_t count; + Lisp_Object res = Qnil; + struct ifaddrs *ifap; - s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0); - if (s < 0) + if (getifaddrs (&ifap) == -1) return Qnil; - count = SPECPDL_INDEX (); - record_unwind_protect_int (close_file_unwind, s); - do + for (struct ifaddrs *it = ifap; it != NULL; it = it->ifa_next) { - buf = xpalloc (buf, &buf_size, 1, INT_MAX, 1); - ifconf.ifc_buf = buf; - ifconf.ifc_len = buf_size; - if (ioctl (s, SIOCGIFCONF, &ifconf)) - { - emacs_close (s); - xfree (buf); - return Qnil; - } - } - while (ifconf.ifc_len == buf_size); - - res = unbind_to (count, Qnil); - ifreq = ifconf.ifc_req; - while ((char *) ifreq < (char *) ifconf.ifc_req + ifconf.ifc_len) - { - struct ifreq *ifq = ifreq; -#ifdef HAVE_STRUCT_IFREQ_IFR_ADDR_SA_LEN -#define SIZEOF_IFREQ(sif) \ - ((sif)->ifr_addr.sa_len < sizeof (struct sockaddr) \ - ? sizeof (*(sif)) : sizeof ((sif)->ifr_name) + (sif)->ifr_addr.sa_len) + int len; + int addr_len; + uint32_t *maskp; + uint32_t *addrp; + Lisp_Object elt = Qnil; - int len = SIZEOF_IFREQ (ifq); -#else - int len = sizeof (*ifreq); + /* BSD can allegedly return interfaces with a NULL address. */ + if (it->ifa_addr == NULL) + continue; + if (match && it->ifa_addr->sa_family != match) + continue; + if (it->ifa_addr->sa_family == AF_INET) + { + DECLARE_POINTER_ALIAS (sin1, struct sockaddr_in, it->ifa_netmask); + maskp = (uint32_t *)&sin1->sin_addr; + DECLARE_POINTER_ALIAS (sin2, struct sockaddr_in, it->ifa_addr); + addrp = (uint32_t *)&sin2->sin_addr; + len = sizeof (struct sockaddr_in); + addr_len = 1; + } +#ifdef AF_INET6 + else if (it->ifa_addr->sa_family == AF_INET6) + { + DECLARE_POINTER_ALIAS (sin6_1, struct sockaddr_in6, it->ifa_netmask); + maskp = (uint32_t *) &sin6_1->sin6_addr; + DECLARE_POINTER_ALIAS (sin6_2, struct sockaddr_in6, it->ifa_addr); + addrp = (uint32_t *) &sin6_2->sin6_addr; + len = sizeof (struct sockaddr_in6); + addr_len = 4; + } #endif - char namebuf[sizeof (ifq->ifr_name) + 1]; - ifreq = (struct ifreq *) ((char *) ifreq + len); + else + continue; - if (ifq->ifr_addr.sa_family != AF_INET) - continue; + Lisp_Object addr = conv_sockaddr_to_lisp (it->ifa_addr, len); - memcpy (namebuf, ifq->ifr_name, sizeof (ifq->ifr_name)); - namebuf[sizeof (ifq->ifr_name)] = 0; - res = Fcons (Fcons (build_string (namebuf), - conv_sockaddr_to_lisp (&ifq->ifr_addr, - sizeof (struct sockaddr))), - res); + if (full) + { + elt = Fcons (conv_sockaddr_to_lisp (it->ifa_netmask, len), elt); + /* There is an it->ifa_broadaddr field, but its contents are + unreliable, so always calculate the broadcast address from + the address and the netmask. */ + int i; + uint32_t mask; + for (i = 0; i < addr_len; i++) + { + mask = maskp[i]; + maskp[i] = (addrp[i] & mask) | ~mask; + } + elt = Fcons (conv_sockaddr_to_lisp (it->ifa_netmask, len), elt); + elt = Fcons (addr, elt); + } + else + { + elt = addr; + } + res = Fcons (Fcons (build_string (it->ifa_name), elt), res); } +#ifdef HAVE_FREEIFADDRS + freeifaddrs (ifap); +#endif - xfree (buf); return res; } -#endif /* SIOCGIFCONF */ +#endif /* HAVE_GETIFADDRS */ +#ifdef HAVE_NET_IF_H #if defined (SIOCGIFADDR) || defined (SIOCGIFHWADDR) || defined (SIOCGIFFLAGS) struct ifflag_def { @@ -4550,17 +4563,46 @@ network_interface_info (Lisp_Object ifname) #endif /* defined (HAVE_NET_IF_H) */ DEFUN ("network-interface-list", Fnetwork_interface_list, - Snetwork_interface_list, 0, 0, 0, + Snetwork_interface_list, 0, 2, 0, doc: /* Return an alist of all network interfaces and their network address. -Each element is a cons, the car of which is a string containing the -interface name, and the cdr is the network address in internal -format; see the description of ADDRESS in `make-network-process'. +Each element is cons of the form (IFNAME . IP) where IFNAME is a +string containing the interface name, and IP is the network address in +internal format; see the description of ADDRESS in +`make-network-process'. The interface name is not guaranteed to be +unique. + +Optional parameter FULL non-nil means return all IP address info for +each interface. Each element is then a list of the form + (IFNAME IP BCAST MASK) +where IFNAME is the interface name, IP the IP address, +BCAST the broadcast address, and MASK the network mask. + +Optional parameter FAMILY controls the type of addresses to return. +The default of nil means both IPv4 and IPv6, symbol `ipv4' means IPv4 +only, symbol `ipv6' means IPv6 only. + +See also `network-interface-info', which is limited to IPv4 only. If the information is not available, return nil. */) - (void) + (Lisp_Object full, Lisp_Object family) { -#if (defined HAVE_NET_IF_H && defined SIOCGIFCONF) || defined WINDOWSNT - return network_interface_list (); +#if defined HAVE_GETIFADDRS || defined WINDOWSNT + unsigned short match; + bool full_info = false; + + if (! NILP (full)) + full_info = true; + if (NILP (family)) + match = 0; + else if (EQ (family, Qipv4)) + match = AF_INET; +#ifdef AF_INET6 + else if (EQ (family, Qipv6)) + match = AF_INET6; +#endif + else + error ("Unsupported address family"); + return network_interface_list (full_info, match); #else return Qnil; #endif diff --git a/src/process.h b/src/process.h index 5e957c4298..bf15317eb4 100644 --- a/src/process.h +++ b/src/process.h @@ -291,7 +291,7 @@ extern void catch_child_signal (void); extern void restore_nofile_limit (void); #ifdef WINDOWSNT -extern Lisp_Object network_interface_list (void); +extern Lisp_Object network_interface_list (bool full, unsigned short match); extern Lisp_Object network_interface_info (Lisp_Object); #endif diff --git a/src/w32.c b/src/w32.c index 26ea15d891..76c226892a 100644 --- a/src/w32.c +++ b/src/w32.c @@ -227,6 +227,8 @@ typedef struct _REPARSE_DATA_BUFFER { #undef connect #undef htons #undef ntohs +#undef htonl +#undef ntohl #undef inet_addr #undef gethostname #undef gethostbyname @@ -326,6 +328,7 @@ static BOOL g_b_init_set_file_security_a; static BOOL g_b_init_set_named_security_info_w; static BOOL g_b_init_set_named_security_info_a; static BOOL g_b_init_get_adapters_info; +static BOOL g_b_init_get_adapters_addresses; static BOOL g_b_init_reg_open_key_ex_w; static BOOL g_b_init_reg_query_value_ex_w; static BOOL g_b_init_expand_environment_strings_w; @@ -503,6 +506,12 @@ typedef BOOL (WINAPI *IsValidSecurityDescriptor_Proc) (PSECURITY_DESCRIPTOR); typedef DWORD (WINAPI *GetAdaptersInfo_Proc) ( PIP_ADAPTER_INFO pAdapterInfo, PULONG pOutBufLen); +typedef DWORD (WINAPI *GetAdaptersAddresses_Proc) ( + ULONG, + ULONG, + PVOID, + PIP_ADAPTER_ADDRESSES, + PULONG); int (WINAPI *pMultiByteToWideChar)(UINT,DWORD,LPCSTR,int,LPWSTR,int); int (WINAPI *pWideCharToMultiByte)(UINT,DWORD,LPCWSTR,int,LPSTR,int,LPCSTR,LPBOOL); @@ -1368,6 +1377,31 @@ get_adapters_info (PIP_ADAPTER_INFO pAdapterInfo, PULONG pOutBufLen) return s_pfn_Get_Adapters_Info (pAdapterInfo, pOutBufLen); } +static DWORD WINAPI +get_adapters_addresses (ULONG family, PIP_ADAPTER_ADDRESSES pAdapterAddresses, PULONG pOutBufLen) +{ + static GetAdaptersAddresses_Proc s_pfn_Get_Adapters_Addresses = NULL; + HMODULE hm_iphlpapi = NULL; + + if (is_windows_9x () == TRUE) + return ERROR_NOT_SUPPORTED; + + if (g_b_init_get_adapters_addresses == 0) + { + g_b_init_get_adapters_addresses = 1; + hm_iphlpapi = LoadLibrary ("Iphlpapi.dll"); + if (hm_iphlpapi) + s_pfn_Get_Adapters_Addresses = (GetAdaptersAddresses_Proc) + get_proc_addr (hm_iphlpapi, "GetAdaptersAddresses"); + } + if (s_pfn_Get_Adapters_Addresses == NULL) + return ERROR_NOT_SUPPORTED; + ULONG flags = GAA_FLAG_SKIP_ANYCAST + | GAA_FLAG_SKIP_MULTICAST + | GAA_FLAG_SKIP_DNS_SERVER; + return s_pfn_Get_Adapters_Addresses (family, flags, NULL, pAdapterAddresses, pOutBufLen); +} + static LONG WINAPI reg_open_key_ex_w (HKEY hkey, LPCWSTR lpSubKey, DWORD ulOptions, REGSAM samDesired, PHKEY phkResult) @@ -7414,6 +7448,8 @@ int (PASCAL *pfn_WSACleanup) (void); u_short (PASCAL *pfn_htons) (u_short hostshort); u_short (PASCAL *pfn_ntohs) (u_short netshort); +u_long (PASCAL *pfn_htonl) (u_long hostlong); +u_long (PASCAL *pfn_ntohl) (u_long netlong); unsigned long (PASCAL *pfn_inet_addr) (const char * cp); int (PASCAL *pfn_gethostname) (char * name, int namelen); struct hostent * (PASCAL *pfn_gethostbyname) (const char * name); @@ -7504,6 +7540,8 @@ init_winsock (int load_now) LOAD_PROC (shutdown); LOAD_PROC (htons); LOAD_PROC (ntohs); + LOAD_PROC (htonl); + LOAD_PROC (ntohl); LOAD_PROC (inet_addr); LOAD_PROC (gethostname); LOAD_PROC (gethostbyname); @@ -7884,6 +7922,19 @@ sys_ntohs (u_short netshort) return (winsock_lib != NULL) ? pfn_ntohs (netshort) : netshort; } +u_long +sys_htonl (u_long hostlong) +{ + return (winsock_lib != NULL) ? + pfn_htonl (hostlong) : hostlong; +} + +u_long +sys_ntohl (u_long netlong) +{ + return (winsock_lib != NULL) ? + pfn_ntohl (netlong) : netlong; +} unsigned long sys_inet_addr (const char * cp) @@ -9382,9 +9433,197 @@ network_interface_get_info (Lisp_Object ifname) } Lisp_Object -network_interface_list (void) +network_interface_list (bool full, unsigned short match) { - return network_interface_get_info (Qnil); + ULONG ainfo_len = sizeof (IP_ADAPTER_ADDRESSES); + ULONG family = match; + IP_ADAPTER_ADDRESSES *adapter, *ainfo = xmalloc (ainfo_len); + DWORD retval = get_adapters_addresses (family, ainfo, &ainfo_len); + Lisp_Object res = Qnil; + + if (retval == ERROR_BUFFER_OVERFLOW) + { + ainfo = xrealloc (ainfo, ainfo_len); + retval = get_adapters_addresses (family, ainfo, &ainfo_len); + } + + if (retval != ERROR_SUCCESS) + { + xfree (ainfo); + return res; + } + + /* For the below, we need some winsock functions, so make sure + the winsock DLL is loaded. If we cannot successfully load + it, they will have no use of the information we provide, + anyway, so punt. */ + if (!winsock_lib && !init_winsock (1)) + return res; + + int eth_count = 0, tr_count = 0, fddi_count = 0, ppp_count = 0; + int sl_count = 0, wlan_count = 0, lo_count = 0, ifx_count = 0; + int tnl_count = 0; + int if_num; + char namebuf[MAX_ADAPTER_NAME_LENGTH + 4]; + static const char *ifmt[] = { + "eth%d", "tr%d", "fddi%d", "ppp%d", "sl%d", "wlan%d", + "lo%d", "ifx%d", "tunnel%d" + }; + enum { + NONE = -1, + ETHERNET = 0, + TOKENRING = 1, + FDDI = 2, + PPP = 3, + SLIP = 4, + WLAN = 5, + LOOPBACK = 6, + OTHER_IF = 7, + TUNNEL = 8 + } ifmt_idx; + + for (adapter = ainfo; adapter; adapter = adapter->Next) + { + + /* Present Unix-compatible interface names, instead of the + Windows names, which are really GUIDs not readable by + humans. */ + + switch (adapter->IfType) + { + case IF_TYPE_ETHERNET_CSMACD: + ifmt_idx = ETHERNET; + if_num = eth_count++; + break; + case IF_TYPE_ISO88025_TOKENRING: + ifmt_idx = TOKENRING; + if_num = tr_count++; + break; + case IF_TYPE_FDDI: + ifmt_idx = FDDI; + if_num = fddi_count++; + break; + case IF_TYPE_PPP: + ifmt_idx = PPP; + if_num = ppp_count++; + break; + case IF_TYPE_SLIP: + ifmt_idx = SLIP; + if_num = sl_count++; + break; + case IF_TYPE_IEEE80211: + ifmt_idx = WLAN; + if_num = wlan_count++; + break; + case IF_TYPE_SOFTWARE_LOOPBACK: + ifmt_idx = LOOPBACK; + if_num = lo_count++; + break; + case IF_TYPE_TUNNEL: + ifmt_idx = TUNNEL; + if_num = tnl_count++; + break; + default: + ifmt_idx = OTHER_IF; + if_num = ifx_count++; + break; + } + sprintf (namebuf, ifmt[ifmt_idx], if_num); + + IP_ADAPTER_UNICAST_ADDRESS *address; + for (address = adapter->FirstUnicastAddress; address; address = address->Next) + { + int len; + int addr_len; + uint32_t *maskp; + uint32_t *addrp; + Lisp_Object elt = Qnil; + struct sockaddr *ifa_addr = address->Address.lpSockaddr; + + if (ifa_addr == NULL) + continue; + if (match && ifa_addr->sa_family != match) + continue; + + struct sockaddr_in ipv4; +#ifdef AF_INET6 + struct sockaddr_in6 ipv6; +#endif + struct sockaddr *sin; + + if (ifa_addr->sa_family == AF_INET) + { + ipv4.sin_family = AF_INET; + ipv4.sin_port = 0; + DECLARE_POINTER_ALIAS (sin_in, struct sockaddr_in, ifa_addr); + addrp = (uint32_t *)&sin_in->sin_addr; + maskp = (uint32_t *)&ipv4.sin_addr; + sin = (struct sockaddr *)&ipv4; + len = sizeof (struct sockaddr_in); + addr_len = 1; + } +#ifdef AF_INET6 + else if (ifa_addr->sa_family == AF_INET6) + { + ipv6.sin6_family = AF_INET6; + ipv6.sin6_port = 0; + DECLARE_POINTER_ALIAS (sin_in6, struct sockaddr_in6, ifa_addr); + addrp = (uint32_t *)&sin_in6->sin6_addr; + maskp = (uint32_t *)&ipv6.sin6_addr; + sin = (struct sockaddr *)&ipv6; + len = sizeof (struct sockaddr_in6); + addr_len = 4; + } +#endif + else + continue; + + Lisp_Object addr = conv_sockaddr_to_lisp (ifa_addr, len); + + if (full) + { + /* GetAdaptersAddress returns information in network + byte order, so convert from host to network order + when generating the netmask. */ + int i; + ULONG numbits = address->OnLinkPrefixLength; + for (i = 0; i < addr_len; i++) + { + if (numbits >= 32) + { + maskp[i] = -1U; + numbits -= 32; + } + else if (numbits) + { + maskp[i] = sys_htonl (-1U << (32 - numbits)); + numbits = 0; + } + else + { + maskp[i] = 0; + } + } + elt = Fcons (conv_sockaddr_to_lisp (sin, len), elt); + uint32_t mask; + for (i = 0; i < addr_len; i++) + { + mask = maskp[i]; + maskp[i] = (addrp[i] & mask) | ~mask; + + } + elt = Fcons (conv_sockaddr_to_lisp (sin, len), elt); + elt = Fcons (addr, elt); + } + else + { + elt = addr; + } + res = Fcons (Fcons (build_string (namebuf), elt), res); + } + } + xfree (ainfo); + return res; } Lisp_Object @@ -10099,6 +10338,7 @@ globals_of_w32 (void) g_b_init_set_named_security_info_w = 0; g_b_init_set_named_security_info_a = 0; g_b_init_get_adapters_info = 0; + g_b_init_get_adapters_addresses = 0; g_b_init_reg_open_key_ex_w = 0; g_b_init_reg_query_value_ex_w = 0; g_b_init_expand_environment_strings_w = 0; commit 5c3d0cf7910afa6b3fbdba24ac5c5817f268eb0e Author: Lars Ingebrigtsen Date: Tue Nov 26 02:40:59 2019 +0100 Fix previous message.el point-restoring fix * lisp/gnus/message.el (message-send-and-exit): Restore window point before burying buffer so we actually bury the buffer. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 54ab86a970..c66b551c1e 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -4138,17 +4138,16 @@ It should typically alter the sending method in some way or other." (actions message-exit-actions)) (when (and (message-send arg) (buffer-live-p buf)) - (message-bury buf) (if message-kill-buffer-on-exit - (kill-buffer buf)) + (kill-buffer buf) + ;; Restore the point in the message buffer. + (save-window-excursion + (switch-to-buffer buf) + (set-window-point nil position) + (set-marker position nil)) + (message-bury buf)) (message-do-actions actions) - t) - ;; Restore the point in the message buffer. - (when (buffer-live-p buf) - (save-window-excursion - (switch-to-buffer buf) - (set-window-point nil position) - (set-marker position nil))))) + t))) (defun message-dont-send () "Don't send the message you have been editing. commit c97c7bb222e4057beba5754bc3670fdfbd2b3c17 Author: Lars Ingebrigtsen Date: Tue Nov 26 02:36:11 2019 +0100 Remove outdated documentation * doc/misc/eieio.texi (Predicates): Remove documentation of same-class-fast-p, which was removed some years back (bug#38362). diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi index f20af3bb22..29d459f041 100644 --- a/doc/misc/eieio.texi +++ b/doc/misc/eieio.texi @@ -1102,11 +1102,6 @@ Just like @code{eieio-class-children}, but with no checks. Returns @code{t} if @var{obj}'s class is the same as @var{class}. @end defun -@defun same-class-fast-p obj class -Same as @code{same-class-p} except this is a macro and no type checking -is performed. -@end defun - @defun object-of-class-p obj class Returns @code{t} if @var{obj} inherits anything from @var{class}. This is different from @code{same-class-p} because it checks for inheritance. commit 8f89fdf7b0f346bee157f08a5e8927e91be41ab4 Author: João Távora Date: Mon Nov 25 22:45:24 2019 +0000 Fix test failures of test/lisp/auth-source-pass-tests.el Failures introduced by recent "Make auth-source-pass-search understand port lists", commit 92fda5a7f92162d610d57df14372bcfcee1f01b6. * lisp/auth-source-pass.el (auth-source-pass--generate-entry-suffixes): Fix test failures. diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index dfdb7596fa..51322e4ec1 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -277,7 +277,7 @@ PORT may be a list of ports." (seq-mapcat (lambda (p) (auth-source-pass--name-port-user-suffixes domain user p)) - (if (listp port) port (list port)))) + (if (consp port) port (list port)))) domains))) (defun auth-source-pass--domains (name-components) commit 4cb582321a2079527dbcf496763ec41cddf63b80 Author: Eli Zaretskii Date: Mon Nov 25 20:58:40 2019 +0200 ; * etc/NEWS: Elaborate the entry about ':extend' face attribute. diff --git a/etc/NEWS b/etc/NEWS index 819637b79f..7e86ccc71e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -422,8 +422,15 @@ to 'completion-styles' or 'completion-category-overrides' to use it. The new face attribute ':extend' controls whether to use the face for displaying the empty space beyond end of line (EOL) till the edge of the window. By default, this attribute is non-nil only for 'region', -'secondary-selection', 'hl-line' and diff faces; any other face that -crosses end of line will not affect the display of the empty space at EOL. +'secondary-selection', 'hl-line' and some faces of Diff and Ediff +modes; any other face that crosses end of line will not affect the +display of the empty space at EOL. This is to make Emacs behave more +like other GUI applications with respect to displaying faces that +cross line boundaries. + +Themes that redefine faces should add a non-nil ':extend' attribute to +the above-mentioned faces, to keep the behavior of the default face +definitions. ** Connection-local variables commit 1b83228cc76294a424b4e01a52c595ddc65ee7d2 Author: Filipp Gunbin Date: Mon Nov 25 21:12:46 2019 +0300 Correct small misprint in defcustom's docstring * lisp/custom.el (defcustom): Correct misprint in docstring. diff --git a/lisp/custom.el b/lisp/custom.el index 2e42ea73c1..26bdaae2c2 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -339,7 +339,7 @@ _outside_ any bindings for these variables. (`defvar' and This macro calls `custom-declare-variable'. If you want to programmatically alter a customizable variable (for instance, to write a package that extends the syntax of a variable), you can -call that functcion directly. +call that function directly. See Info node `(elisp) Customization' in the Emacs Lisp manual for more information." commit 19aecd340b7b3ab54629b790ba70a90130bad63d Author: Eli Zaretskii Date: Mon Nov 25 17:52:24 2019 +0200 Fix face merging when some have :extend non-nil and some are inherited * src/xfaces.c (face_inherited_attr): New function. (merge_named_face): Call 'face_inherited_attr' when testing whether a face that inherits from another fits the filtering criteria specified by ATTR_FILTER. (merge_face_vectors): Revert the changes made in this function for filtering by ATTR_FILTER, and remove that argument as well. These tests are now completely done by the caller, see 'merge_named_face'. (Bug#37774) diff --git a/src/xfaces.c b/src/xfaces.c index 7ca60c87b1..c3b455c928 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -2052,53 +2052,23 @@ merge_face_heights (Lisp_Object from, Lisp_Object to, Lisp_Object invalid) be 0 when called from other places. If window W is non-NULL, use W to interpret face specifications. */ static void -merge_face_vectors (struct window *w, struct frame *f, - const Lisp_Object *from, Lisp_Object *to, - struct named_merge_point *named_merge_points, - enum lface_attribute_index attr_filter) +merge_face_vectors (struct window *w, + struct frame *f, const Lisp_Object *from, Lisp_Object *to, + struct named_merge_point *named_merge_points) { int i; Lisp_Object font = Qnil; - eassert (attr_filter < LFACE_VECTOR_SIZE); - - /* When FROM sets attr_filter explicitly to nil or unspecified - without inheriting don't merge it. */ - if (attr_filter > 0 - && (NILP(from[attr_filter]) - || (UNSPECIFIEDP(from[attr_filter]) - && (NILP (from[LFACE_INHERIT_INDEX]) - || UNSPECIFIEDP (from[LFACE_INHERIT_INDEX]))))) - return; - /* If FROM inherits from some other faces, merge their attributes into TO before merging FROM's direct attributes. Note that an :inherit attribute of `unspecified' is the same as one of nil; we never merge :inherit attributes, so nil is more correct, but lots of - other code uses `unspecified' as a generic value for face - attributes. */ - if (!NILP (from[LFACE_INHERIT_INDEX]) - && !UNSPECIFIEDP (from[LFACE_INHERIT_INDEX])) - { - if (attr_filter == 0 /* No Filter */ - || !UNSPECIFIEDP (from[attr_filter])) /* FROM specifies filter */ - merge_face_ref (w, f, from[LFACE_INHERIT_INDEX], - to, false, named_merge_points, 0); - else if (UNSPECIFIEDP (from[attr_filter])) /* FROM don't specify filter */ - { - Lisp_Object tmp[LFACE_VECTOR_SIZE]; - memcpy (tmp, to, LFACE_VECTOR_SIZE * sizeof(*tmp)); - - merge_face_ref (w, f, from[LFACE_INHERIT_INDEX], - tmp, false, named_merge_points, attr_filter); - - if (NILP (tmp[attr_filter]) - || UNSPECIFIEDP (tmp[attr_filter])) - return; - - memcpy (to, tmp, LFACE_VECTOR_SIZE * sizeof *to); - } - } + other code uses `unspecified' as a generic value for face attributes. */ + if (!UNSPECIFIEDP (from[LFACE_INHERIT_INDEX]) + && !NILP (from[LFACE_INHERIT_INDEX])) + merge_face_ref (w, f, from[LFACE_INHERIT_INDEX], + to, false, named_merge_points, + 0); if (FONT_SPEC_P (from[LFACE_FONT_INDEX])) { @@ -2120,7 +2090,7 @@ merge_face_vectors (struct window *w, struct frame *f, else if (i != LFACE_FONT_INDEX && ! EQ (to[i], from[i])) { to[i] = from[i]; - if (i >= LFACE_FAMILY_INDEX && i <=LFACE_SLANT_INDEX) + if (i >= LFACE_FAMILY_INDEX && i <= LFACE_SLANT_INDEX) font_clear_prop (to, (i == LFACE_FAMILY_INDEX ? FONT_FAMILY_INDEX : i == LFACE_FOUNDRY_INDEX ? FONT_FOUNDRY_INDEX @@ -2155,6 +2125,34 @@ merge_face_vectors (struct window *w, struct frame *f, to[LFACE_INHERIT_INDEX] = Qnil; } +/* Chase the chain of face inheritance of frame F's face whose + attributes are in ATTRS, for a non-'unspecified' value of face + attribute whose index is ATTR_IDX, and return that value. Window + W, if non-NULL, is used to filter face specifications. */ +static Lisp_Object +face_inherited_attr (struct window *w, struct frame *f, + Lisp_Object attrs[LFACE_VECTOR_SIZE], + enum lface_attribute_index attr_idx, + struct named_merge_point *named_merge_points) +{ + Lisp_Object inherited_attrs[LFACE_VECTOR_SIZE]; + Lisp_Object attr_val = attrs[attr_idx]; + + memcpy (inherited_attrs, attrs, LFACE_VECTOR_SIZE * sizeof (attrs[0])); + while (UNSPECIFIEDP (attr_val) + && !NILP (inherited_attrs[LFACE_INHERIT_INDEX]) + && !UNSPECIFIEDP (inherited_attrs[LFACE_INHERIT_INDEX])) + { + Lisp_Object parent_face = inherited_attrs[LFACE_INHERIT_INDEX]; + bool ok = get_lface_attributes (w, f, parent_face, inherited_attrs, + false, named_merge_points); + if (!ok) + break; + attr_val = inherited_attrs[attr_idx]; + } + return attr_val; +} + /* Merge the named face FACE_NAME on frame F, into the vector of face attributes TO. Use NAMED_MERGE_POINTS to detect loops in face inheritance. Return true if FACE_NAME is a valid face name and @@ -2173,18 +2171,20 @@ merge_named_face (struct window *w, face_name, NAMED_MERGE_POINT_NORMAL, &named_merge_points)) { - Lisp_Object from[LFACE_VECTOR_SIZE]; + Lisp_Object from[LFACE_VECTOR_SIZE], val; bool ok = get_lface_attributes (w, f, face_name, from, false, named_merge_points); - if (ok && (attr_filter == 0 /* No filter. */ - || (!NILP(from[attr_filter]) /* Filter, but specified. */ - && !UNSPECIFIEDP(from[attr_filter])) - || (!NILP(from[attr_filter]) /* Filter, unspecified, but inherited. */ - && UNSPECIFIEDP(from[attr_filter]) - && !NILP (from[LFACE_INHERIT_INDEX]) - && !UNSPECIFIEDP (from[LFACE_INHERIT_INDEX])))) - merge_face_vectors (w, f, from, to, named_merge_points, attr_filter); + if (ok && (attr_filter == 0 /* No filter. */ + || (!NILP (from[attr_filter]) /* Filter, but specified. */ + && !UNSPECIFIEDP (from[attr_filter])) + /* Filter, unspecified, but inherited. */ + || (!NILP (from[LFACE_INHERIT_INDEX]) + && !UNSPECIFIEDP (from[LFACE_INHERIT_INDEX]) + && (val = face_inherited_attr (w, f, from, attr_filter, + named_merge_points), + (!NILP (val) && !UNSPECIFIEDP (val)))))) + merge_face_vectors (w, f, from, to, named_merge_points); return ok; } @@ -3883,7 +3883,7 @@ Default face attributes override any local face attributes. */) /* Ensure that the face vector is fully specified by merging the previously-cached vector. */ memcpy (attrs, oldface->lface, sizeof attrs); - merge_face_vectors (NULL, f, lvec, attrs, 0, 0); + merge_face_vectors (NULL, f, lvec, attrs, 0); vcopy (local_lface, 0, attrs, LFACE_VECTOR_SIZE); newface = realize_face (c, lvec, DEFAULT_FACE_ID); @@ -4639,7 +4639,7 @@ lookup_named_face (struct window *w, struct frame *f, return -1; memcpy (attrs, default_face->lface, sizeof attrs); - merge_face_vectors (w, f, symbol_attrs, attrs, 0, 0); + merge_face_vectors (w, f, symbol_attrs, attrs, 0); return lookup_face (f, attrs); } @@ -4808,7 +4808,7 @@ lookup_derived_face (struct window *w, default_face = FACE_FROM_ID (f, face_id); memcpy (attrs, default_face->lface, sizeof attrs); - merge_face_vectors (w, f, symbol_attrs, attrs, 0, 0); + merge_face_vectors (w, f, symbol_attrs, attrs, 0); return lookup_face (f, attrs); } @@ -4906,7 +4906,7 @@ gui_supports_face_attributes_p (struct frame *f, memcpy (merged_attrs, def_attrs, sizeof merged_attrs); - merge_face_vectors (NULL, f, attrs, merged_attrs, 0, 0); + merge_face_vectors (NULL, f, attrs, merged_attrs, 0); face_id = lookup_face (f, merged_attrs); face = FACE_FROM_ID_OR_NULL (f, face_id); @@ -5551,7 +5551,7 @@ realize_named_face (struct frame *f, Lisp_Object symbol, int id) /* Merge SYMBOL's face with the default face. */ get_lface_attributes_no_remap (f, symbol, symbol_attrs, true); - merge_face_vectors (NULL, f, symbol_attrs, attrs, 0, 0); + merge_face_vectors (NULL, f, symbol_attrs, attrs, 0); /* Realize the face. */ realize_face (c, attrs, id); @@ -6418,7 +6418,7 @@ merge_faces (struct window *w, Lisp_Object face_name, int face_id, if (!face) return base_face_id; - merge_face_vectors (w, f, face->lface, attrs, 0, 0); + merge_face_vectors (w, f, face->lface, attrs, 0); } /* Look up a realized face with the given face attributes, commit 2d12d4d2d467f5df81e232707ad9191264b7c2b0 Author: Robert Pluim Date: Sun Nov 17 21:21:48 2019 +0100 Handle auth-source-search failures in open-network-stream If the user cancels the gpg decryption pop-up, auth-source-search fails *and* epa pops up an error buffer. Fix epa to allow suppressing that, and ignore errors returned from auth-source-search. * lisp/epa.el (epa-suppress-error-buffer): New defvar. Bind non-nil to stop epa popping up an error buffer. * lisp/net/network-stream.el: require epa when byte-compiling. (network-stream-certificate): ignore errors when calling auth-source-search, and suppress the epa error buffer. diff --git a/lisp/epa.el b/lisp/epa.el index a2be9a3dbd..13708d046d 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -179,6 +179,7 @@ You should bind this variable with `let', but do not set it globally.") (defvar epa-list-keys-arguments nil) (defvar epa-info-buffer nil) (defvar epa-error-buffer nil) +(defvar epa-suppress-error-buffer nil) (defvar epa-last-coding-system-specified nil) (defvar epa-key-list-mode-map @@ -578,7 +579,8 @@ If SECRET is non-nil, list secret keys instead of public keys." (message "%s" info))) (defun epa-display-error (context) - (unless (equal (epg-context-error-output context) "") + (unless (or (equal (epg-context-error-output context) "") + epa-suppress-error-buffer) (let ((buffer (get-buffer-create "*Error*"))) (save-selected-window (unless (and epa-error-buffer (buffer-live-p epa-error-buffer)) diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index 9a796d93ab..1e9317bc18 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el @@ -46,6 +46,9 @@ (require 'nsm) (require 'puny) +(eval-when-compile + (require 'epa)) ; for epa-suppress-error-buffer + (declare-function starttls-available-p "starttls" ()) (declare-function starttls-negotiate "starttls" (process)) (declare-function starttls-open-stream "starttls" (name buffer host port)) @@ -225,10 +228,12 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." ;; Either nil or a list with a key/certificate pair. spec) ((eq spec t) - (let* ((auth-info - (car (auth-source-search :max 1 - :host host - :port service))) + (let* ((epa-suppress-error-buffer t) + (auth-info + (ignore-errors + (car (auth-source-search :max 1 + :host host + :port service)))) (key (plist-get auth-info :key)) (cert (plist-get auth-info :cert))) (and key cert (file-readable-p key) (file-readable-p cert)