commit d9464d7fe5d21bd46254bbb691f5d3db34fe6324 (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Mon Jul 11 10:07:21 2022 +0800 Handle errors sending selection decline events asynchronously * src/xselect.c (x_decline_selection_request): Handle errors asynchronously. * src/xterm.c (x_ignore_errors_for_next_request) (x_stop_ignoring_errors): Export functions. * src/xterm.h: Update prototypes. diff --git a/src/xselect.c b/src/xselect.c index 80db0d1fe2..25a75aec91 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -437,10 +437,19 @@ static void x_decline_selection_request (struct selection_input_event *event) { XEvent reply_base; - XSelectionEvent *reply = &(reply_base.xselection); + XSelectionEvent *reply; + Display *dpy; + struct x_display_info *dpyinfo; + + reply = &(reply_base.xselection); + dpy = SELECTION_EVENT_DISPLAY (event); + dpyinfo = x_display_info_for_display (dpy); + + if (!dpyinfo) + return; reply->type = SelectionNotify; - reply->display = SELECTION_EVENT_DISPLAY (event); + reply->display = dpy; reply->requestor = SELECTION_EVENT_REQUESTOR (event); reply->selection = SELECTION_EVENT_SELECTION (event); reply->time = SELECTION_EVENT_TIME (event); @@ -450,10 +459,12 @@ x_decline_selection_request (struct selection_input_event *event) /* The reason for the error may be that the receiver has died in the meantime. Handle that case. */ block_input (); - x_catch_errors (reply->display); - XSendEvent (reply->display, reply->requestor, False, 0, &reply_base); - XFlush (reply->display); - x_uncatch_errors (); + x_ignore_errors_for_next_request (dpyinfo); + XSendEvent (dpyinfo->display, reply->requestor, + False, 0, &reply_base); + x_stop_ignoring_errors (dpyinfo); + + XFlush (dpyinfo->display); unblock_input (); } diff --git a/src/xterm.c b/src/xterm.c index ac4e210786..39ce415472 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1121,8 +1121,6 @@ static void x_scroll_bar_end_update (struct x_display_info *, struct scroll_bar #ifdef HAVE_X_I18N static int x_filter_event (struct x_display_info *, XEvent *); #endif -static void x_ignore_errors_for_next_request (struct x_display_info *); -static void x_stop_ignoring_errors (struct x_display_info *); static void x_clean_failable_requests (struct x_display_info *); static struct frame *x_tooltip_window_to_frame (struct x_display_info *, @@ -23039,7 +23037,7 @@ x_clean_failable_requests (struct x_display_info *dpyinfo) + (last - first)); } -static void +void x_ignore_errors_for_next_request (struct x_display_info *dpyinfo) { struct x_failable_request *request, *max; @@ -23092,7 +23090,7 @@ x_ignore_errors_for_next_request (struct x_display_info *dpyinfo) dpyinfo->next_failable_request++; } -static void +void x_stop_ignoring_errors (struct x_display_info *dpyinfo) { struct x_failable_request *range; diff --git a/src/xterm.h b/src/xterm.h index 92e88bb50f..a1ddf13463 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -1463,6 +1463,8 @@ extern bool x_had_errors_p (Display *); extern void x_unwind_errors_to (int); extern void x_uncatch_errors (void); extern void x_uncatch_errors_after_check (void); +extern void x_ignore_errors_for_next_request (struct x_display_info *); +extern void x_stop_ignoring_errors (struct x_display_info *); extern void x_clear_errors (Display *); extern void x_set_window_size (struct frame *, bool, int, int); extern void x_set_last_user_time_from_lisp (struct x_display_info *, Time); commit b283e36cf1902eeb6d532077e1f46270aa1224e1 Author: Philip Kaludercic Date: Sun Jul 10 20:55:02 2022 +0200 * time-date.el (decoded-time-period): Rename TIME in docstring diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index d19134db83..d1afd8ce95 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -590,7 +590,7 @@ TIME is modified and returned." time) (defun decoded-time-period (time) - "Interpret DECODED as a period and return its length in seconds. + "Interpret TIME as a period and return its length in seconds. For computational purposes, years are 365 days long and months are 30 days long." (+ (if (consp (decoded-time-second time)) commit c6f676154581ce6a4a59b5c12e1e3b6ee685fe19 Author: Michael Albinus Date: Sun Jul 10 20:07:37 2022 +0200 ; * lisp/emacs-lisp/ert-x.el (tramp-remote-path): Fix last change. diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 21a967cb4c..4436d0a4b1 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -493,7 +493,7 @@ The same keyword arguments are supported as in (defvar tramp-remote-path) ;; This should happen on hydra only. -(when (getenv "EMACS_HYDRA_CI") +(when (and (featurep 'tramp) (getenv "EMACS_HYDRA_CI")) (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) ;; If this defconst is used in a test file, `tramp' shall be loaded commit 27c3a8b27707e401dfa28e833fcf12731d89669e Author: Stefan Kangas Date: Sun Jul 10 18:57:19 2022 +0200 Remove some ineffectual calls to purecopy * lisp/dired.el (dired-chown-program, dired-trivial-filenames): * lisp/emacs-lisp/shortdoc.el (shortdoc--display-function): * lisp/help-fns.el (help-fns--mention-shortdoc-groups): * lisp/mail/mail-extr.el (mail-extr-full-name-prefixes) (mail-extr-all-letters-but-separators, mail-extr-all-letters) (mail-extr-first-letters, mail-extr-last-letters) (mail-extr-bad-dot-pattern, mail-extr-full-name-suffix-pattern) (mail-extr-alternative-address-pattern) (mail-extr-trailing-comment-start-pattern) (mail-extr-name-pattern, mail-extr-telephone-extension-pattern) (mail-extr-ham-call-sign-pattern, mail-extr-normal-name-pattern) (mail-extr-two-name-pattern) (mail-extr-listserv-list-name-pattern) (mail-extr-stupid-vms-date-stamp-pattern) (mail-extr-hz-embedded-gb-encoded-chinese-pattern) (mail-extr-x400-encoded-address-pattern) (mail-extr-x400-encoded-address-field-pattern-format) (mail-extr-x400-encoded-address-surname-pattern) (mail-extr-x400-encoded-address-given-name-pattern) (mail-extr-x400-encoded-address-full-name-pattern): Remove ineffectual calls to purecopy. diff --git a/lisp/dired.el b/lisp/dired.el index b9ab2a9b1e..43563d969f 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -103,10 +103,10 @@ If `dired-maybe-use-globstar' is non-nil, then `dired-insert-directory' checks this alist to enable globstar in the shell subprocess.") (defcustom dired-chown-program - (purecopy (cond ((executable-find "chown") "chown") - ((file-executable-p "/usr/sbin/chown") "/usr/sbin/chown") - ((file-executable-p "/etc/chown") "/etc/chown") - (t "chown"))) + (cond ((executable-find "chown") "chown") + ((file-executable-p "/usr/sbin/chown") "/usr/sbin/chown") + ((file-executable-p "/etc/chown") "/etc/chown") + (t "chown")) "Name of chown command (usually `chown')." :group 'dired :type 'file) @@ -161,7 +161,7 @@ always set this variable to t." :type 'boolean :group 'dired-mark) -(defcustom dired-trivial-filenames (purecopy "\\`\\.\\.?\\'\\|\\`\\.?#") +(defcustom dired-trivial-filenames "\\`\\.\\.?\\'\\|\\`\\.?#" "Regexp of files to skip when finding first file of a directory. A value of nil means move to the subdir line. A value of t means move to first file." diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 68293931c3..a2d954cadb 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -1367,15 +1367,15 @@ If SAME-WINDOW, don't pop to a new window." 'action (lambda (_) (describe-function function)) 'follow-link t - 'help-echo (purecopy "mouse-1, RET: describe function")) + 'help-echo "mouse-1, RET: describe function") (insert-text-button (symbol-name function) 'face 'button 'action (lambda (_) (info-lookup-symbol function 'emacs-lisp-mode)) 'follow-link t - 'help-echo (purecopy "mouse-1, RET: show \ -function's documentation in the Info manual"))) + 'help-echo "mouse-1, RET: show \ +function's documentation in the Info manual")) (setq arglist-start (point)) (insert ")\n") ;; Doc string. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 17354783ca..fbd4015870 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -868,7 +868,7 @@ the C sources, too." (shortdoc-display-group group object help-window-keep-selected)) 'follow-link t - 'help-echo (purecopy "mouse-1, RET: show documentation group"))) + 'help-echo "mouse-1, RET: show documentation group")) groups) (insert (if (= (length groups) 1) " group.\n" diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index c87ea2b46e..25ce4ea902 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el @@ -1,7 +1,6 @@ ;;; mail-extr.el --- extract full name and address from email header -*- lexical-binding: t; -*- -;; Copyright (C) 1991-1994, 1997, 2001-2022 Free Software Foundation, -;; Inc. +;; Copyright (C) 1991-2022 Free Software Foundation, Inc. ;; Author: Joe Wells ;; Maintainer: emacs-devel@gnu.org @@ -240,8 +239,7 @@ we will act as though we couldn't find a full name in the address." ;; Matches a leading title that is not part of the name (does not ;; contribute to uniquely identifying the person). (defcustom mail-extr-full-name-prefixes - (purecopy - "\\(Prof\\|D[Rr]\\|Mrs?\\|Rev\\|Rabbi\\|SysOp\\|LCDR\\)\\.?[ \t\n]") + "\\(Prof\\|D[Rr]\\|Mrs?\\|Rev\\|Rabbi\\|SysOp\\|LCDR\\)\\.?[ \t\n]" "Matches prefixes to the full name that identify a person's position. These are stripped from the full name because they do not contribute to uniquely identifying the person." @@ -279,45 +277,42 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"." ;; Yes, there are weird people with digits in their names. ;; You will also notice the consideration for the ;; Swedish/Finnish/Norwegian character set. -(defconst mail-extr-all-letters-but-separators - (purecopy "][[:alnum:]{|}'~`")) +(defconst mail-extr-all-letters-but-separators "][[:alnum:]{|}'~`") ;; Any character that can occur in a name in an RFC 822 (or later) ;; address including the separator (hyphen and possibly period) for ;; multipart names. ;; #### should . be in here? (defconst mail-extr-all-letters - (purecopy (concat mail-extr-all-letters-but-separators "-"))) + (concat mail-extr-all-letters-but-separators "-")) ;; Any character that can start a name. ;; Keep this set as minimal as possible. -(defconst mail-extr-first-letters (purecopy "[:alpha:]")) +(defconst mail-extr-first-letters "[:alpha:]") ;; Any character that can end a name. ;; Keep this set as minimal as possible. -(defconst mail-extr-last-letters (purecopy "[:alpha:]`'.")) +(defconst mail-extr-last-letters "[:alpha:]`'.") (defconst mail-extr-leading-garbage "\\W+") ;; (defconst mail-extr-non-begin-name-chars -;; (purecopy (concat "^" mail-extr-first-letters))) +;; (concat "^" mail-extr-first-letters)) ;; (defconst mail-extr-non-end-name-chars -;; (purecopy (concat "^" mail-extr-last-letters))) +;; (concat "^" mail-extr-last-letters)) ;; Matches periods used instead of spaces. Must not match the period ;; following an initial. (defconst mail-extr-bad-dot-pattern - (purecopy - (format "\\([%s][%s]\\)\\.+\\([%s]\\)" - mail-extr-all-letters - mail-extr-last-letters - mail-extr-first-letters))) + (format "\\([%s][%s]\\)\\.+\\([%s]\\)" + mail-extr-all-letters + mail-extr-last-letters + mail-extr-first-letters)) ;; Matches an embedded or leading nickname that should be removed. ;; (defconst mail-extr-nickname-pattern -;; (purecopy -;; (format "\\([ .]\\|\\`\\)[\"'`[(]\\([ .%s]+\\)[]\"')] " -;; mail-extr-all-letters))) +;; (format "\\([ .]\\|\\`\\)[\"'`[(]\\([ .%s]+\\)[]\"')] " +;; mail-extr-all-letters)) ;; Matches the occurrence of a generational name suffix, and the last ;; character of the preceding name. This is important because we want to @@ -325,59 +320,56 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"." ;; *** Perhaps this should be a user-customizable variable. However, the ;; *** regular expression is fairly tricky to alter, so maybe not. (defconst mail-extr-full-name-suffix-pattern - (purecopy - (format - "\\(,? ?\\([JjSs][Rr]\\.?\\|V?I+V?\\)\\)\\([^%s]\\([^%s]\\|\\'\\)\\|\\'\\)" - mail-extr-all-letters mail-extr-all-letters))) + (format + "\\(,? ?\\([JjSs][Rr]\\.?\\|V?I+V?\\)\\)\\([^%s]\\([^%s]\\|\\'\\)\\|\\'\\)" + mail-extr-all-letters mail-extr-all-letters)) -(defconst mail-extr-roman-numeral-pattern (purecopy "V?I+V?\\b")) +(defconst mail-extr-roman-numeral-pattern "V?I+V?\\b") ;; Matches a trailing uppercase (with other characters possible) acronym. ;; Must not match a trailing uppercase last name or trailing initial (defconst mail-extr-weird-acronym-pattern - (purecopy "\\([A-Z]+[-_/]\\|[A-Z][A-Z][A-Z]?\\b\\)")) + "\\([A-Z]+[-_/]\\|[A-Z][A-Z][A-Z]?\\b\\)") ;; Matches a mixed-case or lowercase name (not an initial). ;; #### Match Latin1 lower case letters here too? ;; (defconst mail-extr-mixed-case-name-pattern -;; (purecopy -;; (format -;; "\\b\\([a-z][%s]*[%s]\\|[%s][%s]*[a-z][%s]*[%s]\\|[%s][%s]*[a-z]\\)" -;; mail-extr-all-letters mail-extr-last-letters -;; mail-extr-first-letters mail-extr-all-letters mail-extr-all-letters -;; mail-extr-last-letters mail-extr-first-letters mail-extr-all-letters))) +;; (format +;; "\\b\\([a-z][%s]*[%s]\\|[%s][%s]*[a-z][%s]*[%s]\\|[%s][%s]*[a-z]\\)" +;; mail-extr-all-letters mail-extr-last-letters +;; mail-extr-first-letters mail-extr-all-letters mail-extr-all-letters +;; mail-extr-last-letters mail-extr-first-letters mail-extr-all-letters)) ;; Matches a trailing alternative address. ;; #### Match Latin1 letters here too? ;; #### Match _ before @ here too? (defconst mail-extr-alternative-address-pattern - (purecopy "\\(aka *\\)?[a-zA-Z.]+[!@][a-zA-Z.]")) + "\\(aka *\\)?[a-zA-Z.]+[!@][a-zA-Z.]") ;; Matches a variety of trailing comments not including comma-delimited ;; comments. (defconst mail-extr-trailing-comment-start-pattern - (purecopy " [-{]\\|--\\|[+@#>, Mark Feit @@ -386,7 +378,7 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"." ;; KE9TV KF0NV N1API N3FU N3GZE N3IGS N4KCC N7IKQ N9HHU W4YHF W6ANK WA2SUH ;; WB7VZI N2NJZ NR3G KJ4KK AB4UM AL7NI KH6OH WN3KBT N4TMI W1A N0NZO (defconst mail-extr-ham-call-sign-pattern - (purecopy "\\b\\(DX[0-9]+\\|[AKNW][A-Z]?[0-9][A-Z][A-Z]?[A-Z]?\\)")) + "\\b\\(DX[0-9]+\\|[AKNW][A-Z]?[0-9][A-Z][A-Z]?[A-Z]?\\)") ;; Possible trailing suffixes: "\\(/\\(KT\\|A[AEG]\\|[R0-9]\\)\\)?" ;; /KT == Temporary Technician (has CSC but not "real" license) @@ -400,31 +392,29 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"." ;; Matches normal single-part name (defconst mail-extr-normal-name-pattern - (purecopy (format "\\b[%s][%s]+[%s]" - mail-extr-first-letters - mail-extr-all-letters-but-separators - mail-extr-last-letters))) + (format "\\b[%s][%s]+[%s]" + mail-extr-first-letters + mail-extr-all-letters-but-separators + mail-extr-last-letters)) ;; Matches a single word name. ;; (defconst mail-extr-one-name-pattern -;; (purecopy (concat "\\`" mail-extr-normal-name-pattern "\\'"))) +;; (concat "\\`" mail-extr-normal-name-pattern "\\'")) ;; Matches normal two names with missing middle initial ;; The first name is not allowed to have a hyphen because this can cause ;; false matches where the "middle initial" is actually the first letter ;; of the second part of the first name. (defconst mail-extr-two-name-pattern - (purecopy - (concat "\\`\\(" mail-extr-normal-name-pattern - "\\|" mail-extr-initial-pattern - "\\) +\\(" mail-extr-name-pattern "\\)\\(,\\|\\'\\)"))) + (concat "\\`\\(" mail-extr-normal-name-pattern + "\\|" mail-extr-initial-pattern + "\\) +\\(" mail-extr-name-pattern "\\)\\(,\\|\\'\\)")) (defconst mail-extr-listserv-list-name-pattern - (purecopy "Multiple recipients of list \\([-A-Z]+\\)")) + "Multiple recipients of list \\([-A-Z]+\\)") (defconst mail-extr-stupid-vms-date-stamp-pattern - (purecopy - "[0-9][0-9]-[JFMASOND][aepuco][nbrylgptvc]-[0-9][0-9][0-9][0-9] [0-9]+ *")) + "[0-9][0-9]-[JFMASOND][aepuco][nbrylgptvc]-[0-9][0-9][0-9][0-9] [0-9]+ *") ;;; HZ -- GB (PRC Chinese character encoding) in ASCII embedding protocol ;; @@ -443,25 +433,23 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"." ;; mode from GB back to ASCII. (Note that the escape-from-GB code '~}' ;; ($7E7D) is outside the defined GB range.) (defconst mail-extr-hz-embedded-gb-encoded-chinese-pattern - (purecopy "~{\\([^~].\\|~[^}]\\)+~}")) + "~{\\([^~].\\|~[^}]\\)+~}") ;; The leading optional lowercase letters are for a bastardized version of ;; the encoding, as is the optional nature of the final slash. (defconst mail-extr-x400-encoded-address-pattern - (purecopy "[a-z]?[a-z]?\\(/[A-Za-z]+\\(\\.[A-Za-z]+\\)?=[^/]+\\)+/?\\'")) + "[a-z]?[a-z]?\\(/[A-Za-z]+\\(\\.[A-Za-z]+\\)?=[^/]+\\)+/?\\'") (defconst mail-extr-x400-encoded-address-field-pattern-format - (purecopy "/%s=\\([^/]+\\)\\(/\\|\\'\\)")) + "/%s=\\([^/]+\\)\\(/\\|\\'\\)") (defconst mail-extr-x400-encoded-address-surname-pattern ;; S stands for Surname (family name). - (purecopy - (format mail-extr-x400-encoded-address-field-pattern-format "[Ss]"))) + (format mail-extr-x400-encoded-address-field-pattern-format "[Ss]")) (defconst mail-extr-x400-encoded-address-given-name-pattern ;; G stands for Given name. - (purecopy - (format mail-extr-x400-encoded-address-field-pattern-format "[Gg]"))) + (format mail-extr-x400-encoded-address-field-pattern-format "[Gg]")) (defconst mail-extr-x400-encoded-address-full-name-pattern ;; PN stands for Personal Name. When used it represents the combination @@ -469,8 +457,7 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"." ;; "The one system I used having this field asked it with the prompt ;; `Personal Name'. But they mapped it into G and S on outgoing real ;; X.400 addresses. As they mapped G and S into PN on incoming..." - (purecopy - (format mail-extr-x400-encoded-address-field-pattern-format "[Pp][Nn]"))) + (format mail-extr-x400-encoded-address-field-pattern-format "[Pp][Nn]")) commit 29684a734253f289e649535b2190e8d2ca956e8b Author: Stefan Kangas Date: Sun Jul 10 18:44:43 2022 +0200 Rename new option to browse-url-default-scheme * lisp/net/browse-url.el (browse-url-default-scheme): Rename from 'browse-url-guess-default-scheme'. Update caller. Suggested by Eli Zaretskii . diff --git a/etc/NEWS b/etc/NEWS index 2ab1361a9e..660ea7d720 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1925,10 +1925,10 @@ related 'auth-sources' entry were wrong. ** Browse URL --- -*** New user option 'browse-url-guess-default-scheme'. -This user option affects the URL scheme that 'browse-url' and related -functions will assume when it has to guess. You could customize this -to "https" to always prefer HTTPS URLs. +*** New user option 'browse-url-default-scheme'. +This user option decides which URL scheme that 'browse-url' and +related functions will use by default. For example, you could +customize this to "https" to always prefer HTTPS URLs. --- *** Support for the Netscape web browser has been removed. diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 198c86f935..a55aec76bf 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -652,8 +652,8 @@ regarding its parameter treatment." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; URL input -(defcustom browse-url-guess-default-scheme "http" - "URL scheme to use when `browse-url' (and related commands) has to guess. +(defcustom browse-url-default-scheme "http" + "URL scheme that `browse-url' (and related commands) will use by default. For example, when point is on an URL fragment like \"www.example.org\", `browse-url' will assume that this is an @@ -669,7 +669,7 @@ websites are increasingly rare, but they do still exist." (or (thing-at-point 'url t) ;; assume that the user is pointing at something like gnu.org/gnu (let ((f (thing-at-point 'filename t))) - (and f (concat browse-url-guess-default-scheme "://" f))))) + (and f (concat browse-url-default-scheme "://" f))))) ;; Having this as a separate function called by the browser-specific ;; functions allows them to be stand-alone commands, making it easier commit cfda663282b788972c344e6733a8aa60a3e0f545 Author: Mattias Engdegård Date: Sun Jul 10 18:02:08 2022 +0200 Speed up string-to-unibyte * src/character.h (str_to_unibyte): * src/character.c (str_to_unibyte): Remove. * src/fns.c (Fstring_to_unibyte): Ditch the call to str_to_unibyte and the unnecessary heap allocation. Write new, faster code. * test/src/fns-tests.el (fns--string-to-unibyte): New test. diff --git a/src/character.c b/src/character.c index c1a1b55389..d12df23f8e 100644 --- a/src/character.c +++ b/src/character.c @@ -734,31 +734,6 @@ str_as_unibyte (unsigned char *str, ptrdiff_t bytes) return (to - str); } -/* Convert eight-bit chars in SRC (in multibyte form) to the - corresponding byte and store in DST. CHARS is the number of - characters in SRC. The value is the number of bytes stored in DST. - Usually, the value is the same as CHARS, but is less than it if SRC - contains a non-ASCII, non-eight-bit character. */ - -ptrdiff_t -str_to_unibyte (const unsigned char *src, unsigned char *dst, ptrdiff_t chars) -{ - ptrdiff_t i; - - for (i = 0; i < chars; i++) - { - int c = string_char_advance (&src); - - if (CHAR_BYTE8_P (c)) - c = CHAR_TO_BYTE8 (c); - else if (! ASCII_CHAR_P (c)) - return i; - *dst++ = c; - } - return i; -} - - static ptrdiff_t string_count_byte8 (Lisp_Object string) { diff --git a/src/character.h b/src/character.h index 6ee6bcab20..2ca935ba04 100644 --- a/src/character.h +++ b/src/character.h @@ -569,8 +569,6 @@ extern ptrdiff_t str_as_multibyte (unsigned char *, ptrdiff_t, ptrdiff_t, ptrdiff_t *); extern ptrdiff_t str_to_multibyte (unsigned char *, ptrdiff_t, ptrdiff_t); extern ptrdiff_t str_as_unibyte (unsigned char *, ptrdiff_t); -extern ptrdiff_t str_to_unibyte (const unsigned char *, unsigned char *, - ptrdiff_t); extern ptrdiff_t strwidth (const char *, ptrdiff_t); extern ptrdiff_t c_string_width (const unsigned char *, ptrdiff_t, int, ptrdiff_t *, ptrdiff_t *); diff --git a/src/fns.c b/src/fns.c index 49d76a0e7c..61ed01eee4 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1413,19 +1413,24 @@ an error is signaled. */) (Lisp_Object string) { CHECK_STRING (string); + if (!STRING_MULTIBYTE (string)) + return string; - if (STRING_MULTIBYTE (string)) + ptrdiff_t chars = SCHARS (string); + Lisp_Object ret = make_uninit_string (chars); + unsigned char *src = SDATA (string); + unsigned char *dst = SDATA (ret); + for (ptrdiff_t i = 0; i < chars; i++) { - ptrdiff_t chars = SCHARS (string); - unsigned char *str = xmalloc (chars); - ptrdiff_t converted = str_to_unibyte (SDATA (string), str, chars); - - if (converted < chars) - error ("Can't convert the %"pD"dth character to unibyte", converted); - string = make_unibyte_string ((char *) str, chars); - xfree (str); + unsigned char b = *src++; + if (b <= 0x7f) + *dst++ = b; /* ASCII */ + else if (CHAR_BYTE8_HEAD_P (b)) + *dst++ = 0x80 | (b & 1) << 6 | (*src++ & 0x3f); /* raw byte */ + else + error ("Cannot convert character at index %"pD"d to unibyte", i); } - return string; + return ret; } diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index ba56019d4c..0119e31df1 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -1344,4 +1344,19 @@ (should (equal (plist-member plist (copy-sequence "a") #'equal) '("a" "c"))))) +(ert-deftest fns--string-to-unibyte () + (dolist (str '("" "a" "abc" "a\x00\x7fz" "a\xaa\xbbz ""\x80\xdd\xff")) + (ert-info ((prin1-to-string str) :prefix "str: ") + (should-not (multibyte-string-p str)) + (let* ((u (string-to-unibyte str)) ; should be identity + (m (string-to-multibyte u)) ; lossless conversion + (uu (string-to-unibyte m))) ; also lossless + (should-not (multibyte-string-p u)) + (should (multibyte-string-p m)) + (should-not (multibyte-string-p uu)) + (should (equal str u)) + (should (equal str uu))))) + (should-error (string-to-unibyte "å")) + (should-error (string-to-unibyte "ABC∀BC"))) + ;;; fns-tests.el ends here commit 4bab499ed0d40d4e5ca68e5a17bcf5341125f734 Author: Michael Albinus Date: Sun Jul 10 18:13:50 2022 +0200 Fix Tramp test environment on hydra.nixos.org * lisp/emacs-lisp/ert-x.el (tramp-remote-path): Declare. Adapt `tramp-remote-path' on hydra. (Bug#56424) * test/lisp/dnd-tests.el (dnd-tests-begin-drag-files): Remove instrumentation. * test/lisp/filenotify-tests.el: * test/lisp/shadowfile-tests.el: * test/lisp/net/tramp-tests.el: Do not adapt `tramp-remote-path'. diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index ae72a47c2f..21a967cb4c 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -488,9 +488,13 @@ The same keyword arguments are supported as in (string-match "Apple \\(LLVM\\|[Cc]lang\\)\\|Xcode\\.app" (shell-command-to-string "gcc --version"))) - -(defvar tramp-methods) (defvar tramp-default-host-alist) +(defvar tramp-methods) +(defvar tramp-remote-path) + +;; This should happen on hydra only. +(when (getenv "EMACS_HYDRA_CI") + (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) ;; If this defconst is used in a test file, `tramp' shall be loaded ;; prior `ert-x'. There is no default value on w32 systems, which diff --git a/test/lisp/dnd-tests.el b/test/lisp/dnd-tests.el index 7ce3677eaa..88f6e69457 100644 --- a/test/lisp/dnd-tests.el +++ b/test/lisp/dnd-tests.el @@ -274,7 +274,6 @@ This function only tries to handle strings." (skip-unless (and (dnd-tests-remote-accessible-p) ;; TODO: make these tests work under X. (not (eq window-system 'x)))) - (let ((tramp-verbose (if (getenv "EMACS_HYDRA_CI") 10 3))) (let ((normal-temp-file (expand-file-name (make-temp-name "dnd-test") temporary-file-directory)) (normal-temp-file-1 (expand-file-name (make-temp-name "dnd-test") @@ -384,14 +383,9 @@ This function only tries to handle strings." ;; And when all remote files are inaccessible. (should-error (dnd-begin-drag-files (list nonexistent-remote-file nonexistent-remote-file-1)))) - (when (getenv "EMACS_HYDRA_CI") - (dolist (buf (tramp-list-tramp-buffers)) - (message ";; %s\n%s" buf (tramp-get-buffer-string buf)) - (kill-buffer buf))) (delete-file normal-temp-file) (delete-file normal-temp-file-1) (delete-file remote-temp-file)))) - ) (ert-deftest dnd-tests-get-local-file-uri () (should (equal (dnd-get-local-file-uri "file://localhost/path/to/foo") diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index ad0138b2e7..4ed1786a8e 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -178,10 +178,6 @@ Return nil when any other file notification watch is still active." tramp-allow-unsafe-temporary-files (or tramp-allow-unsafe-temporary-files noninteractive)) -;; This should happen on hydra only. -(when (getenv "EMACS_HYDRA_CI") - (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) - (defun file-notify--test-add-watch (file flags callback) "Like `file-notify-add-watch', but also passing FILE to CALLBACK." (file-notify-add-watch file flags diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index a53fc7ec7a..8b6d10033f 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -128,6 +128,7 @@ A resource file is in the resource directory as per `(expand-file-name ,file (ert-resource-directory))))) ;; `ert-remote-temporary-file-directory' was introduced in Emacs 29.1. +;; Adapting `tramp-remote-path' happens also there. (unless (boundp 'ert-remote-temporary-file-directory) (eval-and-compile ;; There is no default value on w32 systems, which could work out @@ -152,7 +153,11 @@ A resource file is in the resource directory as per (unless (and (null noninteractive) (file-directory-p "~/")) (setenv "HOME" temporary-file-directory)) (format "/mock::%s" temporary-file-directory))) - "Temporary directory for remote file tests."))) + "Temporary directory for remote file tests.") + + ;; This should happen on hydra only. + (when (getenv "EMACS_HYDRA_CI") + (add-to-list 'tramp-remote-path 'tramp-own-remote-path)))) ;; Beautify batch mode. (when noninteractive @@ -178,10 +183,6 @@ A resource file is in the resource directory as per tramp-persistency-file-name nil tramp-verbose 0) -;; This should happen on hydra only. -(when (getenv "EMACS_HYDRA_CI") - (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) - (defvar tramp--test-enabled-checked nil "Cached result of `tramp--test-enabled'. If the function did run, the value is a cons cell, the `cdr' diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index e822bc9eb6..0916f7ce68 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -55,10 +55,6 @@ ert-remote-temporary-file-directory (ignore-errors (file-truename ert-remote-temporary-file-directory))) -;; This should happen on hydra only. -(when (getenv "EMACS_HYDRA_CI") - (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) - (defconst shadow-test-info-file (expand-file-name "shadows_test" temporary-file-directory) "File to keep shadow information in during tests.") commit f8de0d5436adbfe3e83e358c08d4367c65951212 Author: Stefan Kangas Date: Sun Jul 10 17:09:18 2022 +0200 Don't use purecopy in dictionary.el * lisp/net/dictionary.el (dictionary-pre-buffer) (dictionary-display-dictionary-line) (dictionary-display-more-info, dictionary-display-strategy-line) (dictionary-display-match-lines): Don't use purecopy; it has no effect here. diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index c0ad8c13c5..31cc5035a3 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -755,31 +755,31 @@ of matching words." (progn (insert-button "[Back]" :type 'dictionary-button 'callback 'dictionary-restore-state - 'help-echo (purecopy "Mouse-2 to go backwards in history")) + 'help-echo "Mouse-2 to go backwards in history") (insert " ") (insert-button "[Search definition]" :type 'dictionary-button 'callback 'dictionary-search - 'help-echo (purecopy "Mouse-2 to look up a new word")) + 'help-echo "Mouse-2 to look up a new word") (insert " ") (insert-button "[Matching words]" :type 'dictionary-button 'callback 'dictionary-match-words - 'help-echo (purecopy "Mouse-2 to find matches for a pattern")) + 'help-echo "Mouse-2 to find matches for a pattern") (insert " ") (insert-button "[Quit]" :type 'dictionary-button 'callback 'dictionary-close - 'help-echo (purecopy "Mouse-2 to close this window")) + 'help-echo "Mouse-2 to close this window") (insert "\n ") (insert-button "[Select dictionary]" :type 'dictionary-button 'callback 'dictionary-select-dictionary - 'help-echo (purecopy "Mouse-2 to select dictionary for future searches")) + 'help-echo "Mouse-2 to select dictionary for future searches") (insert " ") (insert-button "[Select match strategy]" :type 'dictionary-button 'callback 'dictionary-select-strategy - 'help-echo (purecopy "Mouse-2 to select matching algorithm")) + 'help-echo "Mouse-2 to select matching algorithm") (insert "\n\n"))) (setq dictionary-marker (point-marker))) @@ -928,13 +928,13 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (insert-button (concat dictionary ": " translated) :type 'dictionary-link 'callback 'dictionary-set-dictionary 'data (cons dictionary description) - 'help-echo (purecopy "Mouse-2 to select this dictionary")) + 'help-echo "Mouse-2 to select this dictionary") (unless (dictionary-special-dictionary dictionary) (insert " ") (insert-button "(Details)" :type 'dictionary-link 'callback 'dictionary-set-dictionary 'list-data (list (cons dictionary description) t) - 'help-echo (purecopy "Mouse-2 to get more information"))) + 'help-echo "Mouse-2 to get more information")) (insert "\n"))))) (defun dictionary-set-dictionary (param &optional more) @@ -972,7 +972,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (insert-button description :type 'dictionary-link 'callback 'dictionary-set-dictionary 'data (cons dictionary description) - 'help-echo (purecopy "Mouse-2 to select this dictionary")) + 'help-echo "Mouse-2 to select this dictionary") (insert "\n\n") (setq reply (dictionary-read-answer)) (insert reply) @@ -1023,7 +1023,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (insert-button description :type 'dictionary-link 'callback 'dictionary-set-strategy 'data strategy - 'help-echo (purecopy "Mouse-2 to select this matching algorithm")) + 'help-echo "Mouse-2 to select this matching algorithm") (insert "\n"))))) (defun dictionary-set-strategy (strategy &rest _ignored) @@ -1124,7 +1124,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (insert-button word :type 'dictionary-link 'callback 'dictionary-new-search 'data (cons word dictionary) - 'help-echo (purecopy "Mouse-2 to lookup word")) + 'help-echo "Mouse-2 to lookup word") (insert "\n")) (reverse word-list)) (insert "\n"))) list)) commit d51d72b4a62384f33a593f5a2c0922c1aaecf106 Author: Stefan Monnier Date: Sun Jul 10 11:15:27 2022 -0400 * src/dired.c (directory_files_internal): Update comment diff --git a/src/dired.c b/src/dired.c index 9aeff51636..c2c099f0a5 100644 --- a/src/dired.c +++ b/src/dired.c @@ -270,7 +270,17 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, ptrdiff_t name_nbytes = SBYTES (name); ptrdiff_t nbytes = directory_nbytes + needsep + name_nbytes; ptrdiff_t nchars = SCHARS (directory) + needsep + SCHARS (name); - /* FIXME: Why not make them all multibyte? */ + /* DECODE_FILE may return non-ASCII unibyte strings (e.g. when + file-name-coding-system is 'binary'), so we don't know for sure + that the bytes we have follow our internal utf-8 representation + for multibyte strings. If nchars == nbytes we don't need to + care and just return a unibyte string; and if not, that means + one of 'name' or 'directory' is multibyte, in which case we + presume that the other one would also be multibyte if it + contained non-ASCII. + FIXME: This last presumption is broken when 'directory' is + multibyte (with non-ASCII), and 'name' is unibyte with non-ASCII + (because file-name-coding-system is 'binary'). */ finalname = (nchars == nbytes) ? make_uninit_string (nbytes) : make_uninit_multibyte_string (nchars, nbytes); commit 46a2e5dc93ccbb36309f859460cb527c91adc4d1 Author: Stefan Monnier Date: Sun Jul 10 10:13:27 2022 -0400 * src/dired.c (directory_files_internal): Fix bug#56469 Avoid concatenating encoded and decoded file names. diff --git a/src/dired.c b/src/dired.c index 6bb8c2fcb9..9aeff51636 100644 --- a/src/dired.c +++ b/src/dired.c @@ -219,6 +219,13 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, } #endif + if (!NILP (full) && !STRING_MULTIBYTE (directory)) + { /* We will be concatenating 'directory' with local file name. + We always decode local file names, so in order to safely concatenate + them we need 'directory' to be decoded as well (bug#56469). */ + directory = DECODE_FILE (directory); + } + ptrdiff_t directory_nbytes = SBYTES (directory); re_match_object = Qt; @@ -263,9 +270,10 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, ptrdiff_t name_nbytes = SBYTES (name); ptrdiff_t nbytes = directory_nbytes + needsep + name_nbytes; ptrdiff_t nchars = SCHARS (directory) + needsep + SCHARS (name); - finalname = make_uninit_multibyte_string (nchars, nbytes); - if (nchars == nbytes) - STRING_SET_UNIBYTE (finalname); + /* FIXME: Why not make them all multibyte? */ + finalname = (nchars == nbytes) + ? make_uninit_string (nbytes) + : make_uninit_multibyte_string (nchars, nbytes); memcpy (SDATA (finalname), SDATA (directory), directory_nbytes); if (needsep) SSET (finalname, directory_nbytes, DIRECTORY_SEP); commit 118e05f570b127f9272c5dea1ae9a739531e238c Author: Stefan Kangas Date: Sun Jul 10 14:30:52 2022 +0200 New user option browse-url-guess-default-scheme * lisp/net/browse-url.el (browse-url-guess-default-scheme): New user option. (browse-url-url-at-point): Use above new user option. diff --git a/etc/NEWS b/etc/NEWS index c2e2f1b7b7..2ab1361a9e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1924,6 +1924,12 @@ related 'auth-sources' entry were wrong. ** Browse URL +--- +*** New user option 'browse-url-guess-default-scheme'. +This user option affects the URL scheme that 'browse-url' and related +functions will assume when it has to guess. You could customize this +to "https" to always prefer HTTPS URLs. + --- *** Support for the Netscape web browser has been removed. This support has been obsolete since Emacs 25.1. The final version of diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index b988fbf9a6..198c86f935 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -652,11 +652,24 @@ regarding its parameter treatment." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; URL input +(defcustom browse-url-guess-default-scheme "http" + "URL scheme to use when `browse-url' (and related commands) has to guess. + +For example, when point is on an URL fragment like +\"www.example.org\", `browse-url' will assume that this is an +\"http\" URL by default (i.e. \"http://www.example.org\"). + +Note that if you set this to \"https\", websites that do not yet +support HTTPS may not load correctly in your web browser. Such +websites are increasingly rare, but they do still exist." + :type 'string + :version "29.1") + (defun browse-url-url-at-point () (or (thing-at-point 'url t) ;; assume that the user is pointing at something like gnu.org/gnu (let ((f (thing-at-point 'filename t))) - (and f (concat "http://" f))))) + (and f (concat browse-url-guess-default-scheme "://" f))))) ;; Having this as a separate function called by the browser-specific ;; functions allows them to be stand-alone commands, making it easier commit afaf45d65357f974421417f5aee5ce4a6f25d94c Author: Stefan Kangas Date: Sun Jul 10 14:22:40 2022 +0200 ; Use example.org in an example * lisp/net/browse-url.el (browse-url-filename-alist): Use example.org to be more RFC2606 compliant. diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index a8e768b5fe..b988fbf9a6 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -411,7 +411,7 @@ address to an HTTP URL: (setq browse-url-filename-alist \\='((\"/webmaster@webserver:/home/www/html/\" . - \"http://www.acme.co.uk/\") + \"https://www.example.org/\") (\"^/\\(ftp@\\|anonymous@\\)?\\([^:/]+\\):/*\" . \"ftp://\\2/\") (\"^/\\([^:@/]+@\\)?\\([^:/]+\\):/*\" . \"ftp://\\1\\2/\") (\"^/+\" . \"file:/\")))" commit e45411966fd7afd76cf61375a32972e2c31c0598 Author: Michael Albinus Date: Sun Jul 10 14:19:55 2022 +0200 * doc/misc/tramp.texi (Frequently Asked Questions): Fix formatting. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index fd895ed144..2699ca92c1 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5681,12 +5681,12 @@ Unloading @value{tramp} resets Ange FTP plugins also. @item -What is the difference between Ange FTP and TRAMP? +What is the difference between Ange FTP and @value{tramp}? -The difference is that Ange FTP uses FTP to transfer files between the -local and the remote host, whereas @value{tramp} uses a combination of -@command{rsh} and @command{rcp} or other work-alike programs, such as -@command{ssh}/@command{scp}. +The difference is that Ange FTP uses @command{ftp} to transfer files +between the local and the remote host, whereas @value{tramp} uses a +combination of @command{rsh} and @command{rcp} or other work-alike +programs, such as @command{ssh}/@command{scp}. @end itemize commit a7fff3699131d82a448d8808205c4359f05aa388 Author: Po Lu Date: Sun Jul 10 20:05:23 2022 +0800 Minor fixes to WM_DELETE_WINDOW handling * src/xterm.c (handle_one_xevent): Only handle WM_DELETE_WINDOW to toplevel windows, and set event timestamp. diff --git a/src/xterm.c b/src/xterm.c index e7e6ca7bf8..ac4e210786 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -16593,11 +16593,14 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (event->xclient.data.l[0] == dpyinfo->Xatom_wm_delete_window) { - f = any; + f = x_top_window_to_frame (dpyinfo, + event->xclient.window); + if (!f) goto OTHER; /* May be a dialog that is to be removed */ inev.ie.kind = DELETE_WINDOW_EVENT; + inev.ie.timestamp = event->xclient.data.l[1]; XSETFRAME (inev.ie.frame_or_window, f); goto done; } commit 86dc875bf590c33d255af04d4e3249db05fca65d Author: Stefan Kangas Date: Sun Jul 10 12:15:48 2022 +0200 Make browse-url.el support for plain "mozilla" obsolete * lisp/net/browse-url.el (browse-url-mozilla-program) (browse-url-mozilla-arguments) (browse-url-mozilla-startup-arguments) (browse-url-mozilla-new-window-is-tab, browse-url-mozilla) (browse-url-mozilla-sentinel): Make obsolete. (Bug#56464) (browse-url--browser-defcustom-type, browse-url-default-browser): Don't refer to above obsolete function 'browse-url-mozilla'. diff --git a/etc/NEWS b/etc/NEWS index 02fe67129d..c2e2f1b7b7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1934,6 +1934,11 @@ the Netscape web browser was released in February, 2008. This support has been obsolete since Emacs 25.1. The final version of the Galeon web browser was released in September, 2008. +--- +*** Support for the "Mozilla" web browser is now obsolete. +Note that this historical web browser is different from Mozilla +Firefox; it is its predecessor. + ** Ruby Mode --- diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index edb9de9e37..a8e768b5fe 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -40,7 +40,6 @@ ;; following browsers, as well as some other obsolete ones: ;; Function Browser Earliest version -;; browse-url-mozilla Mozilla Don't know ;; browse-url-firefox Firefox Don't know (tried with 1.0.1) ;; browse-url-chrome Chrome 47.0.2526.111 ;; browse-url-chromium Chromium 3.0 @@ -154,7 +153,6 @@ (defvar browse-url--browser-defcustom-type `(choice (function-item :tag "Emacs Web Wowser (EWW)" :value eww-browse-url) - (function-item :tag "Mozilla" :value browse-url-mozilla) (function-item :tag "Firefox" :value browse-url-firefox) (function-item :tag "Google Chrome" :value browse-url-chrome) (function-item :tag "Chromium" :value browse-url-chromium) @@ -252,16 +250,19 @@ be used instead." (defcustom browse-url-mozilla-program "mozilla" "The name by which to invoke Mozilla." :type 'string) +(make-obsolete-variable 'browse-url-mozilla-program nil "29.1") (defcustom browse-url-mozilla-arguments nil "A list of strings to pass to Mozilla as arguments." :type '(repeat (string :tag "Argument"))) +(make-obsolete-variable 'browse-url-mozilla-arguments nil "29.1") (defcustom browse-url-mozilla-startup-arguments browse-url-mozilla-arguments "A list of strings to pass to Mozilla when it starts up. Defaults to the value of `browse-url-mozilla-arguments' at the time `browse-url' is loaded." :type '(repeat (string :tag "Argument"))) +(make-obsolete-variable 'browse-url-mozilla-startup-arguments nil "29.1") (defun browse-url--find-executable (candidates default) (while (and candidates (not (executable-find (car candidates)))) @@ -345,6 +346,7 @@ Defaults to the value of `browse-url-epiphany-arguments' at the time If non-nil, then open the URL in a new tab rather than a new window if `browse-url-mozilla' is asked to open it in a new window." :type 'boolean) +(make-obsolete-variable 'browse-url-mozilla-new-window-is-tab nil "29.1") (defcustom browse-url-firefox-new-window-is-tab nil "Whether to open up new windows in a tab or a new window. @@ -1031,7 +1033,6 @@ instead of `browse-url-new-window-flag'." 'browse-url-default-haiku-browser) ((browse-url-can-use-xdg-open) 'browse-url-xdg-open) ;;; ((executable-find browse-url-gnome-moz-program) 'browse-url-gnome-moz) - ((executable-find browse-url-mozilla-program) 'browse-url-mozilla) ((executable-find browse-url-firefox-program) 'browse-url-firefox) ((executable-find browse-url-chromium-program) 'browse-url-chromium) ((executable-find browse-url-kde-program) 'browse-url-kde) @@ -1083,6 +1084,7 @@ new tab in an existing window instead. When called non-interactively, optional second argument NEW-WINDOW is used instead of `browse-url-new-window-flag'." + (declare (obsolete nil "29.1")) (interactive (browse-url-interactive-arg "URL: ")) (setq url (browse-url-encode-url url)) (let* ((process-environment (browse-url-process-environment)) @@ -1109,6 +1111,7 @@ used instead of `browse-url-new-window-flag'." (defun browse-url-mozilla-sentinel (process url) "Handle a change to the process communicating with Mozilla." + (declare (obsolete nil "29.1")) (or (eq (process-exit-status process) 0) (let* ((process-environment (browse-url-process-environment))) ;; Mozilla is not running - start it commit 8eb8928337ec4b09229130231ce0ec410c904051 Author: Stefan Kangas Date: Sun Jul 10 02:24:30 2022 +0200 * lisp/net/browse-url.el: Improve commentary. diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 8d103e251b..edb9de9e37 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -1,4 +1,4 @@ -;;; browse-url.el --- pass a URL to a WWW browser -*- lexical-binding: t; -*- +;;; browse-url.el --- pass a URL to a web browser -*- lexical-binding: t; -*- ;; Copyright (C) 1995-2022 Free Software Foundation, Inc. @@ -24,14 +24,20 @@ ;;; Commentary: -;; This package provides functions which read a URL (Uniform Resource -;; Locator) from the minibuffer, defaulting to the URL around point, -;; and ask a World-Wide Web browser to load it. It can also load the -;; URL associated with the current buffer. Different browsers use -;; different methods of remote control so there is one function for -;; each supported browser. If the chosen browser is not running, it -;; is started. Currently there is support for the following browsers, -;; as well as some other obsolete ones: +;; This package provides functions which read a URL from the +;; minibuffer, defaulting to the URL around point, and ask a web +;; browser to load it. It can also load the URL at point, or one +;; associated with the current buffer. The main functions are: + +;; `browse-url' Open URL +;; `browse-url-at-point' Open URL at point +;; `browse-url-of-buffer' Use web browser to display buffer +;; `browse-url-of-file' Use web browser to display file + +;; Different browsers use different methods of remote control so there +;; is one function for each supported browser. If the chosen browser +;; is not running, it is started. Currently there is support for the +;; following browsers, as well as some other obsolete ones: ;; Function Browser Earliest version ;; browse-url-mozilla Mozilla Don't know @@ -40,7 +46,7 @@ ;; browse-url-chromium Chromium 3.0 ;; browse-url-epiphany GNOME Web (Epiphany) Don't know ;; browse-url-webpositive WebPositive 1.2-alpha (Haiku R1/beta3) -;; browse-url-text-* Any text browser 0 +;; browse-url-text-* Any text browser 0 ;; browse-url-generic arbitrary ;; browse-url-default-windows-browser MS-Windows browser ;; browse-url-default-macosx-browser macOS browser @@ -49,14 +55,12 @@ ;; browse-url-elinks Elinks Don't know (tried with 0.12.GIT) ;; eww-browse-url Emacs Web Wowser -;; Browsers can cache Web pages so it may be necessary to tell them to +;; Browsers can cache web pages so it may be necessary to tell them to ;; reload the current page if it has changed (e.g., if you have edited ;; it). There is currently no perfect automatic solution to this. -;; This package generalizes function html-previewer-process in Marc -;; Andreessen's html-mode (LCD modes/html-mode.el.Z). See also the -;; ffap.el package. The huge hyperbole package also contains similar -;; functions. +;; See also the ffap.el package. The huge hyperbole package also +;; contains similar functions. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Usage @@ -82,14 +86,14 @@ ;; M-x browse-url-of-dired-file RET ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Customization (~/.emacs) +;; Customization (Init File) ;; To see what variables are available for customization, type ;; `M-x set-variable browse-url TAB'. Better, use ;; `M-x customize-group browse-url'. -;; Bind the browse-url commands to keys with the `C-c C-z' prefix -;; (as used by html-helper-mode): +;; Bind the browse-url commands to keys with the `C-c C-z' prefix: + ;; (keymap-global-set "C-c C-z ." 'browse-url-at-point) ;; (keymap-global-set "C-c C-z b" 'browse-url-of-buffer) ;; (keymap-global-set "C-c C-z r" 'browse-url-of-region) commit 65a336ce48303855461cdbe228839d3a183928b1 Author: Michael Albinus Date: Sun Jul 10 12:42:55 2022 +0200 ; * test/lisp/dnd-tests.el (dnd-tests-begin-drag-files): Instrument. diff --git a/test/lisp/dnd-tests.el b/test/lisp/dnd-tests.el index 88f6e69457..7ce3677eaa 100644 --- a/test/lisp/dnd-tests.el +++ b/test/lisp/dnd-tests.el @@ -274,6 +274,7 @@ This function only tries to handle strings." (skip-unless (and (dnd-tests-remote-accessible-p) ;; TODO: make these tests work under X. (not (eq window-system 'x)))) + (let ((tramp-verbose (if (getenv "EMACS_HYDRA_CI") 10 3))) (let ((normal-temp-file (expand-file-name (make-temp-name "dnd-test") temporary-file-directory)) (normal-temp-file-1 (expand-file-name (make-temp-name "dnd-test") @@ -383,9 +384,14 @@ This function only tries to handle strings." ;; And when all remote files are inaccessible. (should-error (dnd-begin-drag-files (list nonexistent-remote-file nonexistent-remote-file-1)))) + (when (getenv "EMACS_HYDRA_CI") + (dolist (buf (tramp-list-tramp-buffers)) + (message ";; %s\n%s" buf (tramp-get-buffer-string buf)) + (kill-buffer buf))) (delete-file normal-temp-file) (delete-file normal-temp-file-1) (delete-file remote-temp-file)))) + ) (ert-deftest dnd-tests-get-local-file-uri () (should (equal (dnd-get-local-file-uri "file://localhost/path/to/foo") commit 170dcde029778e15a342108e20af719f4435432b Author: Eli Zaretskii Date: Sun Jul 10 11:43:45 2022 +0300 ; * lisp/startup.el (command-line-1): Fix last change. diff --git a/lisp/startup.el b/lisp/startup.el index 45b99eb893..6c5549e2c6 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -2798,7 +2798,8 @@ nil default-directory" name) ;; `nondisplayed-buffers-p' is true if there exist buffers ;; in `displayable-buffers' that were not displayed to the ;; user. - (nondisplayed-buffers-p nil)) + (nondisplayed-buffers-p nil) + (old-face-font-rescale-alist face-font-rescale-alist)) (when (> displayable-buffers-len 0) (switch-to-buffer (car displayable-buffers))) (cond commit aa25a38f2c4a67a39e84bed3cfea73fa366f2db4 Author: Eli Zaretskii Date: Sun Jul 10 11:32:05 2022 +0300 Fix the startup.el behavior when 'face-font-rescale-alist' is non-nil * lisp/startup.el (command-line-1, normal-top-level): Reset the default face's font only if 'face-font-rescale-alist' affects that face's font. For the use case where it matters, see https://lists.gnu.org/archive/html/emacs-devel/2022-07/msg00157.html. Make the 'inhibit-startup-screen' and non-inhibit branches behave the same in that case. diff --git a/lisp/startup.el b/lisp/startup.el index 4b42cd236c..45b99eb893 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -800,10 +800,12 @@ It is the default value of the variable `top-level'." ;; face-font-rescale-alist into account. For such ;; situations, we ought to have a way to find all font ;; objects and regenerate them; currently we do not. As a - ;; workaround, we specifically reset te default face's :font - ;; attribute here. See bug#1785. - (unless (eq face-font-rescale-alist - old-face-font-rescale-alist) + ;; workaround, we specifically reset the default face's :font + ;; attribute here, if it was rescaled. See bug#1785. + (when (and (not (eq face-font-rescale-alist + old-face-font-rescale-alist)) + (assoc (font-xlfd-name (face-attribute 'default :font)) + face-font-rescale-alist #'string-match-p)) (set-face-attribute 'default nil :font (font-spec))) ;; Modify the initial frame based on what .emacs puts into @@ -2840,6 +2842,14 @@ nil default-directory" name) ;; before doing any output. (run-hooks 'emacs-startup-hook 'term-setup-hook) + ;; See the commentary in `normal-top-level' for why we do + ;; this. + (when (and (not (eq face-font-rescale-alist + old-face-font-rescale-alist)) + (assoc (font-xlfd-name (face-attribute 'default :font)) + face-font-rescale-alist #'string-match-p)) + (set-face-attribute 'default nil :font (font-spec))) + ;; It's important to notice the user settings before we ;; display the startup message; otherwise, the settings ;; won't take effect until the user gives the first commit 84473eb610e64e1b64d2ca73a092cc257995335f Author: Po Lu Date: Sun Jul 10 15:25:00 2022 +0800 ; * src/composite.c (Fcomposition_get_gstring): Fix compiler warnings. diff --git a/src/composite.c b/src/composite.c index 5ad846e40b..1596e996d6 100644 --- a/src/composite.c +++ b/src/composite.c @@ -1897,7 +1897,7 @@ should be ignored. */) /* FIXME: Not clear why we need to do that: AFAICT the rest of the code should work on an ASCII-only unibyte string just as well (bug#56347). */ - string = make_multibyte_string (SDATA (string), chars, chars); + string = make_multibyte_string (SSDATA (string), chars, chars); } frombyte = string_char_to_byte (string, frompos); } commit d7120d97669f3a8640c487e76527c546970c8049 Author: Po Lu Date: Sun Jul 10 15:22:51 2022 +0800 Fix build with old sqlite libraries * src/sqlite.c (Fsqlite_open): Don't use SQLITE_OPEN_FULLMUTEX if not defined. diff --git a/src/sqlite.c b/src/sqlite.c index 75a3b2ea32..54bfb7b6c6 100644 --- a/src/sqlite.c +++ b/src/sqlite.c @@ -246,8 +246,10 @@ If FILE is nil, an in-memory database will be opened instead. */) (Lisp_Object file) { Lisp_Object name; - int flags = (SQLITE_OPEN_CREATE | SQLITE_OPEN_FULLMUTEX - | SQLITE_OPEN_READWRITE); + int flags = (SQLITE_OPEN_CREATE | SQLITE_OPEN_READWRITE); +#ifdef SQLITE_OPEN_FULLMUTEX + flags |= SQLITE_OPEN_FULLMUTEX; +#endif #ifdef SQLITE_OPEN_URI flags |= SQLITE_OPEN_URI; #endif