commit 8dc4c19be8b1540834336a41cd85eb3d78f2076d (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Sun Jul 10 09:37:40 2022 +0300 Speed up 'find_automatic_composition' * src/composite.c (find_automatic_composition): Limit search backward in buffers to the first newline. Fix commentary. diff --git a/src/composite.c b/src/composite.c index 552214ae84..5ad846e40b 100644 --- a/src/composite.c +++ b/src/composite.c @@ -1513,10 +1513,11 @@ struct position_record /* Similar to find_composition, but find an automatic composition instead. This function looks for automatic composition at or near position - POS of OBJECT (a buffer or a string). OBJECT defaults to the - current buffer. It must be assured that POS is not within a static - composition. Also, the current buffer must be displayed in some - window, otherwise the function will return FALSE. + POS of STRING object, either a buffer or a Lisp string. If STRING + is nil, it defaults to the current buffer. It must be assured that + POS is not within a static composition. Also, the current buffer + must be displayed in some window, otherwise the function will + return FALSE. If LIMIT is negative, and there's no composition that includes POS (i.e. starts at or before POS and ends at or after POS), return @@ -1525,8 +1526,8 @@ struct position_record MAX_AUTO_COMPOSITION_LOOKBACK, the maximum number of look-back for automatic compositions (3) -- this is a limitation imposed by composition rules in composition-function-table, which see. If - BACKLIM is negative, it stands for the beginning of OBJECT: BEGV - for a buffer or position zero for a string. + BACKLIM is negative, it stands for the beginning of STRING object: + BEGV for a buffer or position zero for a string. If LIMIT is positive, search for a composition forward (LIMIT > POS) or backward (LIMIT < POS). In this case, LIMIT bounds the @@ -1535,18 +1536,21 @@ struct position_record function can find a composition that starts after POS. BACKLIM limits how far back is the function allowed to look in - OBJECT while trying to find a position where it is safe to start - searching forward for compositions. Such a safe place is generally - the position after a character that can never be composed. + STRING object while trying to find a position where it is safe to + start searching forward for compositions. Such a safe place is + generally the position after a character that can never be + composed. If BACKLIM is negative, that means the first character position of - OBJECT; this is useful when calling the function for the first time - for a given buffer or string, since it is possible that a - composition begins before POS. However, if POS is very far from - the beginning of OBJECT, a negative value of BACKLIM could make the - function slow. Also, in this case the function may return START - and END that do not include POS, something that is not necessarily - wanted, and needs to be explicitly checked by the caller. + STRING object; this is useful when calling the function for the + first time for a given buffer or string, since it is possible that + a composition begins before POS. However, if POS is very far from + the beginning of STRING object, a negative value of BACKLIM could + make the function slow. For that reason, when STRING is a buffer + or nil, we restrict the search back to the first newline before + POS. Also, in this case the function may return START and END that + do not include POS, something that is not necessarily wanted, and + needs to be explicitly checked by the caller. When calling the function in a loop for the same buffer/string, the caller should generally set BACKLIM equal to POS, to avoid costly @@ -1585,7 +1589,15 @@ find_automatic_composition (ptrdiff_t pos, ptrdiff_t limit, ptrdiff_t backlim, cur.pos = pos; if (NILP (string)) { - head = backlim < 0 ? BEGV : backlim, tail = ZV, stop = GPT; + if (backlim < 0) + { + /* This assumes a newline can never be composed. */ + head = find_newline (pos, -1, 0, -1, -1, NULL, NULL, false) + 1; + } + else + head = backlim; + tail = ZV; + stop = GPT; cur.pos_byte = CHAR_TO_BYTE (cur.pos); cur.p = BYTE_POS_ADDR (cur.pos_byte); } commit 143548fdd6c732ce6bf628d239137297bc373616 Author: Po Lu Date: Sun Jul 10 13:21:21 2022 +0800 Don't sync for errors setting up DND targets and toplevels * src/xterm.c (xm_setup_dnd_targets, x_dnd_free_toplevels) (x_dnd_compute_toplevels): Avoid catching errors synchronously. diff --git a/src/xterm.c b/src/xterm.c index 4e2d977e60..e7e6ca7bf8 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -2085,7 +2085,7 @@ xm_setup_dnd_targets (struct x_display_info *dpyinfo, &actual_type, &actual_format, &nitems, &bytes_remaining, &tmp_data) == Success; had_errors = x_had_errors_p (dpyinfo->display); - x_uncatch_errors (); + x_uncatch_errors_after_check (); /* The drag window is probably invalid, so remove our record of it. */ @@ -2798,6 +2798,7 @@ x_dnd_free_toplevels (bool display_alive) unsigned long *prev_masks; specpdl_ref count; Display *dpy; + struct x_display_info *dpyinfo; if (!x_dnd_toplevels) /* Probably called inside an IO error handler. */ @@ -2865,17 +2866,22 @@ x_dnd_free_toplevels (bool display_alive) if (display_alive) { - x_catch_errors (dpy); + dpyinfo = x_display_info_for_display (dpy); - for (i = 0; i < n_windows; ++i) + if (n_windows) { - XSelectInput (dpy, destroy_windows[i], prev_masks[i]); + x_ignore_errors_for_next_request (dpyinfo); + + for (i = 0; i < n_windows; ++i) + { + XSelectInput (dpy, destroy_windows[i], prev_masks[i]); #ifdef HAVE_XSHAPE - XShapeSelectInput (dpy, destroy_windows[i], None); + XShapeSelectInput (dpy, destroy_windows[i], None); #endif - } + } - x_uncatch_errors (); + x_stop_ignoring_errors (dpyinfo); + } } unbind_to (count, Qnil); @@ -3389,12 +3395,12 @@ x_dnd_compute_toplevels (struct x_display_info *dpyinfo) } #endif - x_catch_errors (dpyinfo->display); + x_ignore_errors_for_next_request (dpyinfo); XSelectInput (dpyinfo->display, toplevels[i], (attrs.your_event_mask | StructureNotifyMask | PropertyChangeMask)); - x_uncatch_errors (); + x_stop_ignoring_errors (dpyinfo); x_dnd_toplevels = tem; } commit c8c8bbd8551e1c19e9b76fe1e1f36e52e55ed040 Merge: 932cf200bb 115261b323 Author: Stefan Kangas Date: Sun Jul 10 06:30:35 2022 +0200 Merge from origin/emacs-28 115261b323 ; Improve wording of recently-changed doc strings. commit 932cf200bb607ed7fdcef82ef3c0f1d1c1bd7c3b Author: Po Lu Date: Sun Jul 10 10:49:46 2022 +0800 Make `x-no-window-manager' cover user time as well * src/xterm.c (x_update_frame_user_time_window): (x_wm_supports_1): Respect `x-no-window-manager'. This makes testing some features easier. diff --git a/src/xterm.c b/src/xterm.c index e10edbad3a..4e2d977e60 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -7113,6 +7113,23 @@ x_update_frame_user_time_window (struct frame *f) output = FRAME_X_OUTPUT (f); dpyinfo = FRAME_DISPLAY_INFO (f); + if (!NILP (Vx_no_window_manager)) + { + if (output->user_time_window != None + && output->user_time_window != FRAME_OUTER_WINDOW (f)) + { + XDestroyWindow (dpyinfo->display, output->user_time_window); + XDeleteProperty (dpyinfo->display, FRAME_OUTER_WINDOW (f), + dpyinfo->Xatom_net_wm_user_time_window); + } + else + XDeleteProperty (dpyinfo->display, FRAME_OUTER_WINDOW (f), + dpyinfo->Xatom_net_wm_user_time); + + output->user_time_window = None; + return; + } + if (!x_wm_supports (f, dpyinfo->Xatom_net_wm_user_time_window)) { if (output->user_time_window == None) @@ -24115,6 +24132,11 @@ x_wm_supports_1 (struct x_display_info *dpyinfo, Atom want_atom) unsigned char *tmp_data = NULL; Atom target_type = XA_WINDOW; + /* The user says there's no window manager, so take him up on + it. */ + if (!NILP (Vx_no_window_manager)) + return false; + block_input (); x_catch_errors (dpy); commit 588feeecfd8e4d20e1b4bc7cbb0dea2422026105 Author: Glenn Morris Date: Sat Jul 9 15:12:42 2022 -0700 * test/Makefile.in (WRITE_LOG): Always be verbose on hydra.nixos. diff --git a/test/Makefile.in b/test/Makefile.in index 0be5842512..1fa9d5f7d9 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -151,13 +151,13 @@ endif %.elc: %.el $(AM_V_ELC)$(emacs) --batch -f batch-byte-compile $< +ifdef EMACS_HYDRA_CI +WRITE_LOG = 2>&1 | tee $@ +else ## Save logs, and show logs for failed tests. WRITE_LOG = > $@ 2>&1 || { STAT=$$?; cat $@; exit $$STAT; } -## On Hydra or Emba, always show logs for certain problematic tests. -ifdef EMACS_HYDRA_CI -lisp/net/tramp-tests.log \ -: WRITE_LOG = 2>&1 | tee $@ endif +## On Emba, always show logs for certain problematic tests. ifdef EMACS_EMBA_CI lisp/filenotify-tests.log lisp/net/tramp-tests.log src/emacs-module-tests.log \ : WRITE_LOG = 2>&1 | tee $@ commit ad011fd3accd97f5ab96dd7459ee8ef9f6ab4090 Author: Stefan Monnier Date: Sat Jul 9 12:53:34 2022 -0400 Make STRING_SET_MULTIBYTE an inline function * src/lisp.h (STRING_SET_MULTIBYTE): Make it into a function. * src/composite.c (Fcomposition_get_gstring): Prefer `make_multibyte_string` over Fconcat+STRING_SET_MULTIBYTE. diff --git a/src/composite.c b/src/composite.c index 4d69702171..552214ae84 100644 --- a/src/composite.c +++ b/src/composite.c @@ -1871,7 +1871,8 @@ should be ignored. */) else { CHECK_STRING (string); - validate_subarray (string, from, to, SCHARS (string), &frompos, &topos); + ptrdiff_t chars = SCHARS (string); + validate_subarray (string, from, to, chars, &frompos, &topos); if (! STRING_MULTIBYTE (string)) { ptrdiff_t i; @@ -1881,9 +1882,10 @@ should be ignored. */) error ("Attempt to shape unibyte text"); /* STRING is a pure-ASCII string, so we can convert it (or, rather, its copy) to multibyte and use that thereafter. */ - Lisp_Object string_copy = Fconcat (1, &string); - STRING_SET_MULTIBYTE (string_copy); - string = string_copy; + /* 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); } frombyte = string_char_to_byte (string, frompos); } diff --git a/src/lisp.h b/src/lisp.h index 5ffc2bb038..dc496cc165 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1640,13 +1640,13 @@ STRING_MULTIBYTE (Lisp_Object str) /* Mark STR as a multibyte string. Assure that STR contains only ASCII characters in advance. */ -#define STRING_SET_MULTIBYTE(STR) \ - do { \ - if (XSTRING (STR)->u.s.size == 0) \ - (STR) = empty_multibyte_string; \ - else \ - XSTRING (STR)->u.s.size_byte = XSTRING (STR)->u.s.size; \ - } while (false) +INLINE void +STRING_SET_MULTIBYTE (Lisp_Object str) +{ + /* The 0-length strings are unique&shared so we can't modify them. */ + eassert (XSTRING (str)->u.s.size > 0); + XSTRING (str)->u.s.size_byte = XSTRING (str)->u.s.size; +} /* Convenience functions for dealing with Lisp strings. */ commit 16e79eb75f0d55bc24442f0faf11cd0a4ca8f62c Author: Stefan Kangas Date: Sat Jul 9 17:47:33 2022 +0200 Exclude platform specific browsers from custom type * lisp/net/browse-url.el (browse-url--browser-defcustom-type): Don't include platform specific browsers on other platforms. diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index c5055ac4a5..8d103e251b 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -148,14 +148,15 @@ :group 'comm) (defvar browse-url--browser-defcustom-type - '(choice - (function-item :tag "eww" :value eww-browse-url) + `(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) (function-item :tag "GNOME Web (Epiphany)" :value browse-url-epiphany) - (function-item :tag "WebPositive" :value browse-url-webpositive) + ,@(when (eq system-type 'haiku) + (list '(function-item :tag "WebPositive" :value browse-url-webpositive))) (function-item :tag "Text browser in an xterm window" :value browse-url-text-xterm) (function-item :tag "Text browser in an Emacs window" @@ -163,11 +164,13 @@ (function-item :tag "KDE" :value browse-url-kde) (function-item :tag "Elinks" :value browse-url-elinks) (function-item :tag "Specified by `Browse Url Generic Program'" - :value browse-url-generic) - (function-item :tag "Default Windows browser" - :value browse-url-default-windows-browser) - (function-item :tag "Default macOS browser" - :value browse-url-default-macosx-browser) + :value browse-url-generic) + ,@(when (eq system-type 'windows-nt) + (list '(function-item :tag "Default Windows browser" + :value browse-url-default-windows-browser))) + ,@(when (eq system-type 'darwin) + (list '(function-item :tag "Default macOS browser" + :value browse-url-default-macosx-browser))) (function-item :tag "Default browser" :value browse-url-default-browser) (function :tag "Your own function") commit 1383e6de55f78c0d786939e4a9a713f220c5177f Author: Stefan Kangas Date: Sat Jul 9 17:46:59 2022 +0200 * lisp/net/eww.el (eww): Improve docstring. diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 995a755135..4dbd5de2ef 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -363,7 +363,9 @@ new buffer instead of reusing the default EWW buffer. If BUFFER, the data to be rendered is in that buffer. In that case, this function doesn't actually fetch URL. BUFFER will be -killed after rendering." +killed after rendering. + +For more information, see Info node `(eww) Top'." (interactive (let ((uris (eww-suggested-uris))) (list (read-string (format-prompt "Enter URL or keywords" commit 96bf08a0ec550ae5f0ef263341520985412997c3 Author: Stefan Kangas Date: Thu Jul 7 13:43:53 2022 +0200 Make browse-url-default-browser fall back to EWW * lisp/net/browse-url.el (browse-url-default-browser): Fall back to EWW. diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 355f9c12c0..c5055ac4a5 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -1031,12 +1031,11 @@ instead of `browse-url-new-window-flag'." ((executable-find browse-url-chrome-program) 'browse-url-chrome) ((executable-find browse-url-webpositive-program) 'browse-url-webpositive) ((executable-find browse-url-xterm-program) 'browse-url-text-xterm) - (t - (lambda (&rest _ignore) (error "No usable browser found")))) + (t #'eww-browse-url)) url args)) (function-put 'browse-url-default-browser 'browse-url-browser-kind - ;; Well, most probably external if we ignore w3. + ;; Well, most probably external if we ignore EWW. 'external) (defun browse-url-can-use-xdg-open () commit 2a8d083607e7e0fe9358f1f6526dbd8aa928af61 Author: Stefan Kangas Date: Thu Jul 7 13:25:23 2022 +0200 Drop support for the dead third-party w3 package The w3 package was removed from GNU ELPA in 2020 as it doesn't run on a recent Emacs, and development had stopped over a decade before that. If anyone wants to revive the w3 package, they should look this all over, but it doesn't make sense for us to maintain this support code. Ref: https://debbugs.gnu.org/25395 * lisp/net/browse-url.el (browse-url-w3): Make obsolete. (browse-url--browser-defcustom-type) (browse-url-default-browser): * lisp/ffap.el (ffap-url-at-point, ffap-file-at-point): * lisp/net/newst-plainview.el (newsticker--buffer-do-insert-text): * lisp/net/newst-reader.el (newsticker-html-renderer) (newsticker-show-news): * lisp/net/newst-treeview.el (newsticker--treeview-render-text): * lisp/org/ol.el (org-store-link): * lisp/url/url.el (url-retrieve): Remove w3 support code and related documentation and comments. (Bug#56435) * test/lisp/net/browse-url-tests.el (browse-url-tests-browser-kind): Adjust test for above changes. * etc/TODO: Remove TODO to install W3. * doc/misc/org.org (Handling Links): Don't mention W3. * lisp/msb.el (msb--few-menus, msb--very-many-menus): Check for eww-mode instead of w3-mode. diff --git a/doc/misc/org.org b/doc/misc/org.org index b1dc708498..fa8fa408c7 100644 --- a/doc/misc/org.org +++ b/doc/misc/org.org @@ -3352,7 +3352,7 @@ current buffer: ~org-link-email-description-format~. By default, it refers to the addressee and the subject. -- /Web browsers: W3, W3M and EWW/ :: +- /Web browsers: W3M and EWW/ :: Here the link is the current URL, with the page title as the description. diff --git a/etc/TODO b/etc/TODO index 7ab913f779..5c55a8b999 100644 --- a/etc/TODO +++ b/etc/TODO @@ -722,8 +722,6 @@ bar. In the mean time, it should process other messages. ** Get some major packages installed -*** W3 (development version needs significant work) - *** PSGML, _possibly_ ECB https://lists.gnu.org/r/emacs-devel/2007-05/msg01493.html Check the assignments file for other packages which might go in and have been diff --git a/lisp/ffap.el b/lisp/ffap.el index d7225ee9c9..9de0dd40d1 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -68,8 +68,8 @@ ;; If you do not like these bindings, modify the variable ;; `ffap-bindings', or write your own. ;; -;; If you use ange-ftp, browse-url, complete, efs, or w3, it is best -;; to load or autoload them before ffap. If you use ff-paths, load it +;; If you use ange-ftp, browse-url, complete, efs, it is best to load +;; or autoload them before ffap. If you use ff-paths, load it ;; afterwards. Try apropos {C-h a ffap RET} to get a list of the many ;; option variables. In particular, if ffap is slow, try these: ;; @@ -79,7 +79,7 @@ ;; (setq ffap-shell-prompt-regexp nil) ; disable shell prompt stripping ;; (setq ffap-gopher-regexp nil) ; disable gopher bookmark matching ;; -;; ffap uses `browse-url' (if found, else `w3-fetch') to fetch URLs. +;; ffap uses `browse-url' to fetch URLs. ;; For a hairier `ffap-url-fetcher', try ffap-url.el (same ftp site). ;; Also, you can add `ffap-menu-rescan' to various hooks to fontify ;; the file and URL references within a buffer. @@ -97,7 +97,6 @@ ;; * break long menus into multiple panes (like imenu?) ;; * notice node in "(dired)Virtual Dired" (quotes, parentheses, whitespace) ;; * notice "machine.dom blah blah blah dir/file" (how?) -;; * as w3 becomes standard, rewrite to rely more on its functions ;; * regexp options for ffap-string-at-point, like font-lock (MCOOK) ;; * v19: could replace `ffap-locate-file' with a quieter `locate-library' ;; * handle "$(VAR)" in Makefiles @@ -1339,30 +1338,25 @@ Assumes the buffer has not changed." ;; Older: (apply 'copy-region-as-kill ffap-string-at-point-region) (message "Copied to kill ring: %s" str)))) -;; External. -(declare-function w3-view-this-url "ext:w3" (&optional no-show)) - ;;;###autoload (defun ffap-url-at-point () "Return URL from around point if it exists, or nil. Sets the variable `ffap-string-at-point-region' to the bounds of URL, if any." (when ffap-url-regexp - (or (and (eq major-mode 'w3-mode) ; In a w3 buffer button? - (w3-view-this-url t)) - (let ((thing-at-point-beginning-of-url-regexp ffap-url-regexp) - (thing-at-point-default-mail-uri-scheme ffap-foo-at-bar-prefix) - val) - (setq val (thing-at-point-url-at-point ffap-lax-url - (if (use-region-p) - (cons (region-beginning) - (region-end))))) - (if val - (let ((bounds (thing-at-point-bounds-of-url-at-point - ffap-lax-url))) - (setq ffap-string-at-point-region - (list (car bounds) (cdr bounds))))) - val)))) + (let ((thing-at-point-beginning-of-url-regexp ffap-url-regexp) + (thing-at-point-default-mail-uri-scheme ffap-foo-at-bar-prefix) + val) + (setq val (thing-at-point-url-at-point ffap-lax-url + (if (use-region-p) + (cons (region-beginning) + (region-end))))) + (if val + (let ((bounds (thing-at-point-bounds-of-url-at-point + ffap-lax-url))) + (setq ffap-string-at-point-region + (list (car bounds) (cdr bounds))))) + val))) (defvar ffap-gopher-regexp "\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *" @@ -1503,12 +1497,7 @@ which may actually result in an URL rather than a filename." ((and (eq major-mode 'internal-ange-ftp-mode) (string-match "^\\*ftp \\(.*\\)@\\(.*\\)\\*$" (buffer-name))) - (concat "/" (substring (buffer-name) 5 -1) ":")) - ;; This is too often a bad idea: - ;;((and (eq major-mode 'w3-mode) - ;; (stringp url-current-server)) - ;; (host-to-ange-path url-current-server)) - ))) + (concat "/" (substring (buffer-name) 5 -1) ":"))))) (and remote-dir (or (and (string-match "\\`\\(/?~?ftp\\)/" name) @@ -1882,7 +1871,7 @@ Return value: ;;; ffap-other-*, ffap-read-only-*, ffap-alternate-* commands: ;; There could be a real `ffap-noselect' function, but we would need -;; at least two new user variables, and there is no w3-fetch-noselect. +;; at least two new user variables. ;; So instead, we just fake it with a slow save-window-excursion. (defun ffap-other-window (filename) diff --git a/lisp/msb.el b/lisp/msb.el index 19f0afed73..6843df2edc 100644 --- a/lisp/msb.el +++ b/lisp/msb.el @@ -103,7 +103,7 @@ ((eq major-mode 'Man-mode) 4090 "Manuals (%d)") - ((eq major-mode 'w3-mode) + ((eq major-mode 'eww-mode) 4020 "WWW (%d)") ((or (memq major-mode @@ -154,7 +154,7 @@ ((eq major-mode 'Man-mode) 5030 "Manuals (%d)") - ((eq major-mode 'w3-mode) + ((eq major-mode 'eww-mode) 5020 "WWW (%d)") ((or (memq major-mode diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 7cffe3e32e..355f9c12c0 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -40,7 +40,6 @@ ;; 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-w3 w3 0 ;; browse-url-text-* Any text browser 0 ;; browse-url-generic arbitrary ;; browse-url-default-windows-browser MS-Windows browser @@ -108,9 +107,9 @@ ;; Gnus provides a standard feature to activate URLs in article ;; buffers for invocation of browse-url. -;; Use the Emacs w3 browser when not running under X11: +;; Use the Emacs Web Wowser (EWW) when not running under X11: ;; (or (eq window-system 'x) -;; (setq browse-url-browser-function 'browse-url-w3)) +;; (setq browse-url-browser-function #'eww-browse-url)) ;; To always save modified buffers before displaying the file in a browser: ;; (setq browse-url-save-file t) @@ -150,7 +149,6 @@ (defvar browse-url--browser-defcustom-type '(choice - (function-item :tag "Emacs W3" :value browse-url-w3) (function-item :tag "eww" :value eww-browse-url) (function-item :tag "Mozilla" :value browse-url-mozilla) (function-item :tag "Firefox" :value browse-url-firefox) @@ -1033,7 +1031,6 @@ instead of `browse-url-new-window-flag'." ((executable-find browse-url-chrome-program) 'browse-url-chrome) ((executable-find browse-url-webpositive-program) 'browse-url-webpositive) ((executable-find browse-url-xterm-program) 'browse-url-text-xterm) - ((locate-library "w3") 'browse-url-w3) (t (lambda (&rest _ignore) (error "No usable browser found")))) url args)) @@ -1367,6 +1364,7 @@ prefix argument reverses the effect of `browse-url-new-window-flag'. 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 "W3 URL: ")) (require 'w3) ; w3-fetch-other-window not autoloaded (if (browse-url-maybe-new-window new-window) diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index 7ae58884f9..5ae2df769a 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -40,7 +40,6 @@ ;; Silence warnings (defvar newsticker-groups) -(defvar w3-mode-map) (defvar w3m-minor-mode-map) (defvar newsticker--retrieval-timer-list nil diff --git a/lisp/net/newst-plainview.el b/lisp/net/newst-plainview.el index df574dfa2f..4eb6f6c695 100644 --- a/lisp/net/newst-plainview.el +++ b/lisp/net/newst-plainview.el @@ -37,7 +37,6 @@ (require 'xml) ;; Silence warnings -(defvar w3-mode-map) (defvar w3m-minor-mode-map) ;; ====================================================================== @@ -1232,7 +1231,6 @@ item-retrieval time is added as well." (newsticker--buffer-do-insert-text item 'desc feed-name-symbol)) (defvar w3m-fill-column) -(defvar w3-maximum-line-length) (defun newsticker--buffer-do-insert-text (item type feed-name-symbol) "Actually insert contents of news item, format it, render it and all that. @@ -1366,19 +1364,14 @@ FEED-NAME-SYMBOL tells to which feed this item belongs." " Date: Sat Jul 9 16:19:07 2022 +0200 Improve introductory section of TRAMP manual * doc/misc/tramp.texi (Top, Overview): Explain what TRAMP is without contrasting to Ange FTP. (Bug#56440) (Frequently Asked Questions): Move information on Ange FTP here. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 76e2ea0f36..fd895ed144 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -50,13 +50,10 @@ This file documents @w{@value{tramp} @value{trampver}}, a remote file editing package for Emacs. @value{tramp} stands for ``Transparent Remote (file) Access, Multiple -Protocol''. This package provides remote file editing, similar to -Ange FTP@. - -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}. +Protocol''. This package provides an easy, convenient, and consistent +interface to editing remote files transparently, just as if they are +local files. This extends to editing, version control, @code{dired}, +and more. You can find the latest version of this document on the web at @uref{@value{trampurl}}. @@ -182,10 +179,11 @@ interface to remote files as if they are local files. @value{tramp}'s transparency extends to editing, version control, and @code{dired}. @value{tramp} can access remote hosts using any number of access -methods, such as @command{rsh}, @command{rlogin}, @command{telnet}, -and related programs. If these programs can successfully pass -@acronym{ASCII} characters, @value{tramp} can use them. -@value{tramp} does not require or mandate 8-bit clean connections. +methods, such as @command{ssh}, @command{rsh}, @command{rlogin}, +@command{telnet}, and related programs. If these programs can +successfully pass @acronym{ASCII} characters, @value{tramp} can use +them. @value{tramp} does not require or mandate 8-bit clean +connections. @value{tramp}'s most common access method is through @command{ssh}, a more secure alternative to @command{ftp} and other older access @@ -5680,6 +5678,15 @@ local host's root directory as @file{/ssh:example.com:}. To unload @value{tramp}, type @kbd{M-x tramp-unload-tramp @key{RET}}. Unloading @value{tramp} resets Ange FTP plugins also. @end itemize + + +@item +What is the difference between Ange FTP and 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}. @end itemize commit f6840328c0bc3daa151a1dc42ba030eb6240a853 Author: Stefan Kangas Date: Sat Jul 9 14:38:48 2022 +0200 Prefer defvar-keymap in net/*.el * lisp/net/dictionary.el (dictionary-mode-map): * lisp/net/dig.el (dig-mode-map): * lisp/net/eudc-hotlist.el (eudc-hotlist-mode-map): * lisp/net/eudc.el (eudc-mode-map): * lisp/net/mairix.el (mairix-searches-mode-map): * lisp/net/newst-treeview.el (newsticker-treeview-list-sort-button-map) (newsticker-treeview-mode-map): * lisp/net/quickurl.el (quickurl-list-mode-map): * lisp/net/rcirc.el (rcirc-mode-map) (rcirc-multiline-minor-mode-map, rcirc-track-minor-mode-map): * lisp/net/rlogin.el (rlogin-mode-map): * lisp/net/secrets.el (secrets-mode-map): * lisp/net/sieve-mode.el (sieve-mode-map): * lisp/net/sieve.el (sieve-manage-mode-map): * lisp/net/snmp-mode.el (snmp-mode-map): * lisp/net/telnet.el (telnet-mode-map): Prefer defvar-keymap. diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index eec405373d..c0ad8c13c5 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -326,26 +326,22 @@ is utf-8" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Global variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar dictionary-mode-map - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (set-keymap-parent map button-buffer-map) - - (define-key map "q" #'dictionary-close) - (define-key map "h" #'dictionary-help) - (define-key map "s" #'dictionary-search) - (define-key map "d" #'dictionary-lookup-definition) - (define-key map "D" #'dictionary-select-dictionary) - (define-key map "M" #'dictionary-select-strategy) - (define-key map "m" #'dictionary-match-words) - (define-key map "l" #'dictionary-previous) - (define-key map "n" #'forward-button) - (define-key map "p" #'backward-button) - (define-key map " " #'scroll-up-command) - (define-key map [?\S-\ ] #'scroll-down-command) - (define-key map (read-kbd-macro "M-SPC") #'scroll-down-command) - map) - "Keymap for the dictionary mode.") +(defvar-keymap dictionary-mode-map + :doc "Keymap for the dictionary mode." + :suppress t :parent button-buffer-map + "q" #'dictionary-close + "h" #'dictionary-help + "s" #'dictionary-search + "d" #'dictionary-lookup-definition + "D" #'dictionary-select-dictionary + "M" #'dictionary-select-strategy + "m" #'dictionary-match-words + "l" #'dictionary-previous + "n" #'forward-button + "p" #'backward-button + "SPC" #'scroll-up-command + "S-SPC" #'scroll-down-command + "M-SPC" #'scroll-down-command) (defvar dictionary-connection nil diff --git a/lisp/net/dig.el b/lisp/net/dig.el index 7157d0cb58..d4fad0c61f 100644 --- a/lisp/net/dig.el +++ b/lisp/net/dig.el @@ -123,11 +123,9 @@ Buffer should contain output generated by `dig-invoke'." (setq str (replace-match "" nil nil str))) str)) -(defvar dig-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "g" nil) - (define-key map "q" #'dig-exit) - map)) +(defvar-keymap dig-mode-map + "g" nil + "q" #'dig-exit) (define-derived-mode dig-mode special-mode "Dig" "Major mode for displaying dig output." diff --git a/lisp/net/eudc-hotlist.el b/lisp/net/eudc-hotlist.el index 26afd76805..d70e0cf4f6 100644 --- a/lisp/net/eudc-hotlist.el +++ b/lisp/net/eudc-hotlist.el @@ -35,15 +35,13 @@ (defvar eudc-hotlist-menu nil) (defvar eudc-hotlist-list-beginning nil) -(defvar eudc-hotlist-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "a" #'eudc-hotlist-add-server) - (define-key map "d" #'eudc-hotlist-delete-server) - (define-key map "s" #'eudc-hotlist-select-server) - (define-key map "t" #'eudc-hotlist-transpose-servers) - (define-key map "q" #'eudc-hotlist-quit-edit) - (define-key map "x" #'kill-current-buffer) - map)) +(defvar-keymap eudc-hotlist-mode-map + "a" #'eudc-hotlist-add-server + "d" #'eudc-hotlist-delete-server + "s" #'eudc-hotlist-select-server + "t" #'eudc-hotlist-transpose-servers + "q" #'eudc-hotlist-quit-edit + "x" #'kill-current-buffer) (define-derived-mode eudc-hotlist-mode fundamental-mode "EUDC-Servers" "Major mode used to edit the hotlist of servers. diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index eb1342e438..9208e40a73 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -56,16 +56,14 @@ (defvar eudc-form-widget-list nil) -(defvar eudc-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map widget-keymap) - (define-key map "q" #'kill-current-buffer) - (define-key map "x" #'kill-current-buffer) - (define-key map "f" #'eudc-query-form) - (define-key map "b" #'eudc-try-bbdb-insert) - (define-key map "n" #'eudc-move-to-next-record) - (define-key map "p" #'eudc-move-to-previous-record) - map)) +(defvar-keymap eudc-mode-map + :parent widget-keymap + "q" #'kill-current-buffer + "x" #'kill-current-buffer + "f" #'eudc-query-form + "b" #'eudc-try-bbdb-insert + "n" #'eudc-move-to-next-record + "p" #'eudc-move-to-previous-record) (defvar mode-popup-menu) diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el index d84763b162..0b99d2a0b7 100644 --- a/lisp/net/mairix.el +++ b/lisp/net/mairix.el @@ -743,21 +743,20 @@ VALUES may contain values for editable fields from current article." ;;;; Major mode for editing/deleting/saving searches -(defvar mairix-searches-mode-map - (let ((map (make-keymap))) - (define-key map [(return)] 'mairix-select-search) - (define-key map [(down)] 'mairix-next-search) - (define-key map [(up)] 'mairix-previous-search) - (define-key map [(right)] 'mairix-next-search) - (define-key map [(left)] 'mairix-previous-search) - (define-key map "\C-p" 'mairix-previous-search) - (define-key map "\C-n" 'mairix-next-search) - (define-key map [(q)] 'mairix-select-quit) - (define-key map [(e)] 'mairix-select-edit) - (define-key map [(d)] 'mairix-select-delete) - (define-key map [(s)] 'mairix-select-save) - map) - "`mairix-searches-mode' keymap.") +(defvar-keymap mairix-searches-mode-map + :doc "`mairix-searches-mode' keymap." + :full t + "" #'mairix-select-search + "" #'mairix-next-search + "" #'mairix-previous-search + "" #'mairix-next-search + "" #'mairix-previous-search + "C-p" #'mairix-previous-search + "C-n" #'mairix-next-search + "q" #'mairix-select-quit + "e" #'mairix-select-edit + "d" #'mairix-select-delete + "s" #'mairix-select-save) (defvar mairix-searches-mode-font-lock-keywords '(("^\\([0-9]+\\)" diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el index b429a33dec..1e04e7d1ca 100644 --- a/lisp/net/newst-treeview.el +++ b/lisp/net/newst-treeview.el @@ -608,14 +608,10 @@ If CLEAR-BUFFER is non-nil the list buffer is completely erased." (newsticker--treeview-list-update-faces) (goto-char (point-min)))) -(defvar newsticker-treeview-list-sort-button-map - (let ((map (make-sparse-keymap))) - (define-key map [header-line mouse-1] - #'newsticker--treeview-list-sort-by-column) - (define-key map [header-line mouse-2] - #'newsticker--treeview-list-sort-by-column) - map) - "Local keymap for newsticker treeview list window sort buttons.") +(defvar-keymap newsticker-treeview-list-sort-button-map + :doc "Local keymap for newsticker treeview list window sort buttons." + " " #'newsticker--treeview-list-sort-by-column + " " #'newsticker--treeview-list-sort-by-column) (defun newsticker--treeview-list-sort-by-column (&optional event) "Sort the newsticker list window buffer by the column clicked on. @@ -2012,41 +2008,39 @@ Return t if groups have changed, nil otherwise." menu) "Map for newsticker item menu.") -(defvar newsticker-treeview-mode-map - (let ((map (make-sparse-keymap 'newsticker-treeview-mode-map))) - (define-key map " " #'newsticker-treeview-next-page) - (define-key map "a" #'newsticker-add-url) - (define-key map "b" #'newsticker-treeview-browse-url-item) - (define-key map "c" #'newsticker-treeview-customize-current-feed) - (define-key map "F" #'newsticker-treeview-prev-feed) - (define-key map "f" #'newsticker-treeview-next-feed) - (define-key map "g" #'newsticker-treeview-get-news) - (define-key map "G" #'newsticker-get-all-news) - (define-key map "i" #'newsticker-treeview-toggle-item-immortal) - (define-key map "j" #'newsticker-treeview-jump) - (define-key map "n" #'newsticker-treeview-next-item) - (define-key map "N" #'newsticker-treeview-next-new-or-immortal-item) - (define-key map "O" #'newsticker-treeview-mark-list-items-old) - (define-key map "o" #'newsticker-treeview-mark-item-old) - (define-key map "p" #'newsticker-treeview-prev-item) - (define-key map "P" #'newsticker-treeview-prev-new-or-immortal-item) - (define-key map "q" #'newsticker-treeview-quit) - (define-key map "S" #'newsticker-treeview-save-item) - (define-key map "s" #'newsticker-treeview-save) - (define-key map "u" #'newsticker-treeview-update) - (define-key map "v" #'newsticker-treeview-browse-url) - ;;(define-key map "\n" #'newsticker-treeview-scroll-item) - ;;(define-key map "\C-m" #'newsticker-treeview-scroll-item) - (define-key map "\M-m" #'newsticker-group-move-feed) - (define-key map "\M-a" #'newsticker-group-add-group) - (define-key map "\M-d" #'newsticker-group-delete-group) - (define-key map "\M-r" #'newsticker-group-rename-group) - (define-key map [M-down] #'newsticker-group-shift-feed-down) - (define-key map [M-up] #'newsticker-group-shift-feed-up) - (define-key map [M-S-down] #'newsticker-group-shift-group-down) - (define-key map [M-S-up] #'newsticker-group-shift-group-up) - map) - "Mode map for newsticker treeview.") +(defvar-keymap newsticker-treeview-mode-map + :doc "Mode map for newsticker treeview." + "SPC" #'newsticker-treeview-next-page + "a" #'newsticker-add-url + "b" #'newsticker-treeview-browse-url-item + "c" #'newsticker-treeview-customize-current-feed + "F" #'newsticker-treeview-prev-feed + "f" #'newsticker-treeview-next-feed + "g" #'newsticker-treeview-get-news + "G" #'newsticker-get-all-news + "i" #'newsticker-treeview-toggle-item-immortal + "j" #'newsticker-treeview-jump + "n" #'newsticker-treeview-next-item + "N" #'newsticker-treeview-next-new-or-immortal-item + "O" #'newsticker-treeview-mark-list-items-old + "o" #'newsticker-treeview-mark-item-old + "p" #'newsticker-treeview-prev-item + "P" #'newsticker-treeview-prev-new-or-immortal-item + "q" #'newsticker-treeview-quit + "S" #'newsticker-treeview-save-item + "s" #'newsticker-treeview-save + "u" #'newsticker-treeview-update + "v" #'newsticker-treeview-browse-url + ;;"C-j" #'newsticker-treeview-scroll-item + ;;"RET" #'newsticker-treeview-scroll-item + "M-m" #'newsticker-group-move-feed + "M-a" #'newsticker-group-add-group + "M-d" #'newsticker-group-delete-group + "M-r" #'newsticker-group-rename-group + "M-" #'newsticker-group-shift-feed-down + "M-" #'newsticker-group-shift-feed-up + "M-S-" #'newsticker-group-shift-group-down + "M-S-" #'newsticker-group-shift-group-up) (define-derived-mode newsticker-treeview-mode fundamental-mode "Newsticker TV" "Major mode for Newsticker Treeview. diff --git a/lisp/net/quickurl.el b/lisp/net/quickurl.el index 598a7da071..61cae43a88 100644 --- a/lisp/net/quickurl.el +++ b/lisp/net/quickurl.el @@ -163,19 +163,17 @@ in your init file (after loading/requiring quickurl).") (defvar quickurl-urls nil "URL alist for use with `quickurl' and `quickurl-ask'.") -(defvar quickurl-list-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "a" #'quickurl-list-add-url) - (define-key map [(control m)] #'quickurl-list-insert-url) - (define-key map "u" #'quickurl-list-insert-naked-url) - (define-key map " " #'quickurl-list-insert-with-lookup) - (define-key map "l" #'quickurl-list-insert-lookup) - (define-key map "d" #'quickurl-list-insert-with-desc) - (define-key map [(control g)] #'quickurl-list-quit) - (define-key map "q" #'quickurl-list-quit) - (define-key map [mouse-2] #'quickurl-list-mouse-select) - map) - "Local keymap for a `quickurl-list-mode' buffer.") +(defvar-keymap quickurl-list-mode-map + :doc "Local keymap for a `quickurl-list-mode' buffer." + "a" #'quickurl-list-add-url + "RET" #'quickurl-list-insert-url + "u" #'quickurl-list-insert-naked-url + "SPC" #'quickurl-list-insert-with-lookup + "l" #'quickurl-list-insert-lookup + "d" #'quickurl-list-insert-with-desc + "C-g" #'quickurl-list-quit + "q" #'quickurl-list-quit + "" #'quickurl-list-mouse-select) (defvar quickurl-list-buffer-name "*quickurl-list*" "Name for the URL listing buffer.") diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 775cff9730..54d7861f44 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1346,33 +1346,30 @@ The list is updated automatically by `defun-rcirc-command'.") 'set-rcirc-encode-coding-system "28.1") -(defvar rcirc-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "RET") 'rcirc-send-input) - (define-key map (kbd "M-p") 'rcirc-insert-prev-input) - (define-key map (kbd "M-n") 'rcirc-insert-next-input) - (define-key map (kbd "TAB") 'completion-at-point) - (define-key map (kbd "C-c C-b") 'rcirc-browse-url) - (define-key map (kbd "C-c C-c") 'rcirc-edit-multiline) - (define-key map (kbd "C-c C-j") 'rcirc-cmd-join) - (define-key map (kbd "C-c C-k") 'rcirc-cmd-kick) - (define-key map (kbd "C-c C-l") 'rcirc-toggle-low-priority) - (define-key map (kbd "C-c C-d") 'rcirc-cmd-mode) - (define-key map (kbd "C-c C-m") 'rcirc-cmd-msg) - (define-key map (kbd "C-c C-r") 'rcirc-cmd-nick) ; rename - (define-key map (kbd "C-c C-o") 'rcirc-omit-mode) - (define-key map (kbd "C-c C-p") 'rcirc-cmd-part) - (define-key map (kbd "C-c C-q") 'rcirc-cmd-query) - (define-key map (kbd "C-c C-t") 'rcirc-cmd-topic) - (define-key map (kbd "C-c C-n") 'rcirc-cmd-names) - (define-key map (kbd "C-c C-w") 'rcirc-cmd-whois) - (define-key map (kbd "C-c C-x") 'rcirc-cmd-quit) - (define-key map (kbd "C-c TAB") ; C-i - 'rcirc-toggle-ignore-buffer-activity) - (define-key map (kbd "C-c C-s") 'rcirc-switch-to-server-buffer) - (define-key map (kbd "C-c C-a") 'rcirc-jump-to-first-unread-line) - map) - "Keymap for rcirc mode.") +(defvar-keymap rcirc-mode-map + :doc "Keymap for rcirc mode." + "RET" #'rcirc-send-input + "M-p" #'rcirc-insert-prev-input + "M-n" #'rcirc-insert-next-input + "TAB" #'completion-at-point + "C-c C-b" #'rcirc-browse-url + "C-c C-c" #'rcirc-edit-multiline + "C-c C-j" #'rcirc-cmd-join + "C-c C-k" #'rcirc-cmd-kick + "C-c C-l" #'rcirc-toggle-low-priority + "C-c C-d" #'rcirc-cmd-mode + "C-c C-m" #'rcirc-cmd-msg + "C-c C-r" #'rcirc-cmd-nick ; rename + "C-c C-o" #'rcirc-omit-mode + "C-c C-p" #'rcirc-cmd-part + "C-c C-q" #'rcirc-cmd-query + "C-c C-t" #'rcirc-cmd-topic + "C-c C-n" #'rcirc-cmd-names + "C-c C-w" #'rcirc-cmd-whois + "C-c C-x" #'rcirc-cmd-quit + "C-c C-i" #'rcirc-toggle-ignore-buffer-activity + "C-c C-s" #'rcirc-switch-to-server-buffer + "C-c C-a" #'rcirc-jump-to-first-unread-line) (defvar-local rcirc-short-buffer-name nil "Generated abbreviation to use to indicate buffer activity.") @@ -1714,14 +1711,12 @@ extracted." parent (substitute-command-keys "\\[rcirc-multiline-minor-cancel]"))))) -(defvar rcirc-multiline-minor-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-c") 'rcirc-multiline-minor-submit) - (define-key map (kbd "C-x C-s") 'rcirc-multiline-minor-submit) - (define-key map (kbd "C-c C-k") 'rcirc-multiline-minor-cancel) - (define-key map (kbd "ESC ESC ESC") 'rcirc-multiline-minor-cancel) - map) - "Keymap for multiline mode in rcirc.") +(defvar-keymap rcirc-multiline-minor-mode-map + :doc "Keymap for multiline mode in rcirc." + "C-c C-c" #'rcirc-multiline-minor-submit + "C-x C-s" #'rcirc-multiline-minor-submit + "C-c C-k" #'rcirc-multiline-minor-cancel + "ESC ESC ESC" #'rcirc-multiline-minor-cancel) (define-minor-mode rcirc-multiline-minor-mode "Minor mode for editing multiple lines in rcirc." @@ -2269,12 +2264,10 @@ This function does not alter the INPUT string." (mapconcat rcirc-nick-filter sorted sep))) ;;; activity tracking -(defvar rcirc-track-minor-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-@") 'rcirc-next-active-buffer) - (define-key map (kbd "C-c C-SPC") 'rcirc-next-active-buffer) - map) - "Keymap for rcirc track minor mode.") +(defvar-keymap rcirc-track-minor-mode-map + :doc "Keymap for rcirc track minor mode." + "C-c C-@" #'rcirc-next-active-buffer + "C-c C-SPC" #'rcirc-next-active-buffer) (defcustom rcirc-track-abbrevate-flag t "Non-nil means `rcirc-track-minor-mode' should abbreviate names." diff --git a/lisp/net/rlogin.el b/lisp/net/rlogin.el index 98b660dcc4..a6d0edae07 100644 --- a/lisp/net/rlogin.el +++ b/lisp/net/rlogin.el @@ -1,7 +1,6 @@ ;;; rlogin.el --- remote login interface -*- lexical-binding:t -*- -;; Copyright (C) 1992-1995, 1997-1998, 2001-2022 Free Software -;; Foundation, Inc. +;; Copyright (C) 1992-2022 Free Software Foundation, Inc. ;; Author: Noah Friedman ;; Keywords: unix, comm @@ -118,19 +117,15 @@ this variable is set from that." :type '(choice (const nil) string) :group 'rlogin) -(defvar rlogin-mode-map - (let ((map (if (consp shell-mode-map) - (cons 'keymap shell-mode-map) - (copy-keymap shell-mode-map)))) - (define-key map "\C-c\C-c" 'rlogin-send-Ctrl-C) - (define-key map "\C-c\C-d" 'rlogin-send-Ctrl-D) - (define-key map "\C-c\C-z" 'rlogin-send-Ctrl-Z) - (define-key map "\C-c\C-\\" 'rlogin-send-Ctrl-backslash) - (define-key map "\C-d" 'rlogin-delchar-or-send-Ctrl-D) - (define-key map "\C-i" 'rlogin-tab-or-complete) - map) - "Keymap for `rlogin-mode'.") - +(defvar-keymap rlogin-mode-map + :doc "Keymap for `rlogin-mode'." + :parent shell-mode-map + "C-c C-c" #'rlogin-send-Ctrl-C + "C-c C-d" #'rlogin-send-Ctrl-D + "C-c C-z" #'rlogin-send-Ctrl-Z + "C-c C-\\" #'rlogin-send-Ctrl-backslash + "C-d" #'rlogin-delchar-or-send-Ctrl-D + "TAB" #'rlogin-tab-or-complete) (defvar rlogin-history nil) diff --git a/lisp/net/secrets.el b/lisp/net/secrets.el index d8341774e4..c4f97a92fb 100644 --- a/lisp/net/secrets.el +++ b/lisp/net/secrets.el @@ -741,14 +741,13 @@ ITEM can also be an object path, which is used if contained in COLLECTION." ;;; Visualization. -(defvar secrets-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map (make-composed-keymap special-mode-map widget-keymap)) - (define-key map "n" #'next-line) - (define-key map "p" #'previous-line) - (define-key map "z" #'kill-current-buffer) - map) - "Keymap used in `secrets-mode' buffers.") +(defvar-keymap secrets-mode-map + :doc "Keymap used in `secrets-mode' buffers." + :parent (make-composed-keymap special-mode-map + widget-keymap) + "n" #'next-line + "p" #'previous-line + "z" #'kill-current-buffer) (define-derived-mode secrets-mode special-mode "Secrets" "Major mode for presenting password entries retrieved by Security Service. diff --git a/lisp/net/sieve-mode.el b/lisp/net/sieve-mode.el index 58fd41d899..f62af03534 100644 --- a/lisp/net/sieve-mode.el +++ b/lisp/net/sieve-mode.el @@ -137,13 +137,11 @@ ;; Key map definition -(defvar sieve-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-c\C-l" #'sieve-upload) - (define-key map "\C-c\C-c" #'sieve-upload-and-kill) - (define-key map "\C-c\C-m" #'sieve-manage) - map) - "Key map used in sieve mode.") +(defvar-keymap sieve-mode-map + :doc "Keymap used in sieve mode." + "C-c C-l" #'sieve-upload + "C-c C-c" #'sieve-upload-and-kill + "C-c RET" #'sieve-manage) ;; Menu diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el index 630ea04070..3a6067ee10 100644 --- a/lisp/net/sieve.el +++ b/lisp/net/sieve.el @@ -106,33 +106,31 @@ require \"fileinto\"; ;; FIXME: This is arguably a bug/problem in `easy-menu-define'. (declare-function sieve-manage-mode-menu "sieve") -(defvar sieve-manage-mode-map - (let ((map (make-sparse-keymap))) - ;; various - (define-key map "?" #'sieve-help) - (define-key map "h" #'sieve-help) - ;; activating - (define-key map "m" #'sieve-activate) - (define-key map "u" #'sieve-deactivate) - (define-key map "\M-\C-?" #'sieve-deactivate-all) - ;; navigation keys - (define-key map "\C-p" #'sieve-prev-line) - (define-key map [up] #'sieve-prev-line) - (define-key map "\C-n" #'sieve-next-line) - (define-key map [down] #'sieve-next-line) - (define-key map " " #'sieve-next-line) - (define-key map "n" #'sieve-next-line) - (define-key map "p" #'sieve-prev-line) - (define-key map "\C-m" #'sieve-edit-script) - (define-key map "f" #'sieve-edit-script) - ;; (define-key map "o" #'sieve-edit-script-other-window) - (define-key map "r" #'sieve-remove) - (define-key map "q" #'sieve-bury-buffer) - (define-key map "Q" #'sieve-manage-quit) - (define-key map [(down-mouse-2)] #'sieve-edit-script) - (define-key map [(down-mouse-3)] #'sieve-manage-mode-menu) - map) - "Keymap for `sieve-manage-mode'.") +(defvar-keymap sieve-manage-mode-map + :doc "Keymap for `sieve-manage-mode'." + ;; various + "?" #'sieve-help + "h" #'sieve-help + ;; activating + "m" #'sieve-activate + "u" #'sieve-deactivate + "M-DEL" #'sieve-deactivate-all + ;; navigation keys + "C-p" #'sieve-prev-line + "" #'sieve-prev-line + "C-n" #'sieve-next-line + "" #'sieve-next-line + "SPC" #'sieve-next-line + "n" #'sieve-next-line + "p" #'sieve-prev-line + "RET" #'sieve-edit-script + "f" #'sieve-edit-script + ;; "o" #'sieve-edit-script-other-window + "r" #'sieve-remove + "q" #'sieve-bury-buffer + "Q" #'sieve-manage-quit + "" #'sieve-edit-script + "" #'sieve-manage-mode-menu) (easy-menu-define sieve-manage-mode-menu sieve-manage-mode-map "Sieve Menu." diff --git a/lisp/net/snmp-mode.el b/lisp/net/snmp-mode.el index de84b4f8dd..394c4a9666 100644 --- a/lisp/net/snmp-mode.el +++ b/lisp/net/snmp-mode.el @@ -248,14 +248,12 @@ This is used during Tempo template completion." ;; Set up our keymap ;; -(defvar snmp-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\177" 'backward-delete-char-untabify) - (define-key map "\C-c\C-i" 'tempo-complete-tag) - (define-key map "\C-c\C-f" 'tempo-forward-mark) - (define-key map "\C-c\C-b" 'tempo-backward-mark) - map) - "Keymap used in SNMP mode.") +(defvar-keymap snmp-mode-map + :doc "Keymap used in SNMP mode." + "DEL" #'backward-delete-char-untabify + "C-c TAB" #'tempo-complete-tag + "C-c C-f" #'tempo-forward-mark + "C-c C-b" #'tempo-backward-mark) ;; Set up our syntax table diff --git a/lisp/net/telnet.el b/lisp/net/telnet.el index 0d54d2220b..802e7bc0a2 100644 --- a/lisp/net/telnet.el +++ b/lisp/net/telnet.el @@ -1,7 +1,6 @@ ;;; telnet.el --- run a telnet session from within an Emacs buffer -*- lexical-binding: t; -*- -;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2022 Free Software -;; Foundation, Inc. +;; Copyright (C) 1985-2022 Free Software Foundation, Inc. ;; Author: William F. Schelter ;; Maintainer: emacs-devel@gnu.org @@ -61,14 +60,13 @@ PROGRAM says which program to run, to talk to that machine. LOGIN-NAME, which is optional, says what to log in as on that machine.") (defvar telnet-new-line "\r") -(defvar telnet-mode-map - (let ((map (nconc (make-sparse-keymap) comint-mode-map))) - (define-key map "\C-m" #'telnet-send-input) - ;; (define-key map "\C-j" #'telnet-send-input) - (define-key map "\C-c\C-q" #'send-process-next-char) - (define-key map "\C-c\C-c" #'telnet-interrupt-subjob) - (define-key map "\C-c\C-z" #'telnet-c-z) - map)) +(defvar-keymap telnet-mode-map + :parent comint-mode-map + "RET" #'telnet-send-input + ;; "C-j" #'telnet-send-input + "C-c C-q" #'send-process-next-char + "C-c C-c" #'telnet-interrupt-subjob + "C-c C-z" #'telnet-c-z) (defvar telnet-prompt-pattern "^[^#$%>\n]*[#$%>] *") (defvar telnet-replace-c-g nil) commit 30cf1f34c583d6ed16bdc5b9578370f30c95fe1b Author: Po Lu Date: Sat Jul 9 20:19:56 2022 +0800 Avoid extra sync and atom name query on ending Motif DND * src/xterm.c (handle_one_xevent): Use `x_dnd_action_symbol' to set the Motif action instead. diff --git a/src/xterm.c b/src/xterm.c index d9485980fe..e10edbad3a 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -16471,16 +16471,16 @@ handle_one_xevent (struct x_display_info *dpyinfo, switch (operation) { case XM_DRAG_MOVE: - x_dnd_action = dpyinfo->Xatom_XdndActionMove; + x_dnd_action_symbol = QXdndActionMove; break; case XM_DRAG_COPY: - x_dnd_action = dpyinfo->Xatom_XdndActionCopy; + x_dnd_action_symbol = QXdndActionCopy; break; /* This means XM_DRAG_OPERATION_IS_LINK (operation). */ default: - x_dnd_action = dpyinfo->Xatom_XdndActionLink; + x_dnd_action_symbol = QXdndActionLink; break; } commit 5d7b92448f1996a77a22c9bb0f4b8906552b60b6 Author: Stefan Kangas Date: Fri Jul 8 15:07:55 2022 +0200 Delete obsolete variable tooltip-use-echo-area * lisp/tooltip.el (tooltip-use-echo-area): Delete variable obsolete since 24.1. (tooltip-help-tips): * lisp/progmodes/gud.el (gud-tooltip-process-output) (gud-tooltip-tips): Don't use above deleted variable. diff --git a/etc/NEWS b/etc/NEWS index 9fe7c97549..02fe67129d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2304,8 +2304,8 @@ This change is now applied in 'dired-insert-directory'. 'semantic-grammar-syntax-table', 'set-register-value', 'speedbar-key-map', 'speedbar-syntax-table', 'starttls-any-program-available', 'strokes-report-bug', -'toggle-emacs-lock', 'turn-on-cwarn-mode', 'turn-on-iimage-mode', -'vc-toggle-read-only', 'view-return-to-alist', +'toggle-emacs-lock', 'tooltip-use-echo-area', 'turn-on-cwarn-mode', +'turn-on-iimage-mode', 'vc-toggle-read-only', 'view-return-to-alist', 'view-return-to-alist-update', 'w32-default-color-map' (function), 'which-func-mode' (function), 'x-cut-buffer-or-selection-value'. diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index d277eef284..be43effed7 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -3694,7 +3694,6 @@ With arg, dereference expr if ARG is positive, otherwise do not dereference." (message "Dereferencing is now %s." (if gud-tooltip-dereference "on" "off"))) -(defvar tooltip-use-echo-area) (declare-function tooltip-show "tooltip" (text &optional use-echo-area)) (declare-function tooltip-strip-prompt "tooltip" (process output)) @@ -3708,8 +3707,7 @@ With arg, dereference expr if ARG is positive, otherwise do not dereference." "Process debugger output and show it in a tooltip window." (remove-function (process-filter process) #'gud-tooltip-process-output) (tooltip-show (tooltip-strip-prompt process output) - (or gud-tooltip-echo-area tooltip-use-echo-area - (not tooltip-mode)))) + (or gud-tooltip-echo-area (not tooltip-mode)))) (defun gud-tooltip-print-command (expr) "Return a suitable command to print the expression EXPR." @@ -3753,8 +3751,7 @@ This function must return nil if it doesn't handle EVENT." (unless (null define-elt) (tooltip-show (cdr define-elt) - (or gud-tooltip-echo-area tooltip-use-echo-area - (not tooltip-mode))) + (or gud-tooltip-echo-area (not tooltip-mode))) expr)))) (when gud-tooltip-dereference (setq expr (concat "*" expr))) diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 3e9c16a445..95cb1cc62c 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -140,15 +140,6 @@ When using the GTK toolkit, this face will only be used if :group 'tooltip :group 'basic-faces) -(defcustom tooltip-use-echo-area nil - "Use the echo area instead of tooltip frames for help and GUD tooltips. -This variable is obsolete; instead of setting it to t, disable -`tooltip-mode' (which has a similar effect)." - :type 'boolean) - -(make-obsolete-variable 'tooltip-use-echo-area - "disable Tooltip mode instead" "24.1" 'set) - (defcustom tooltip-resize-echo-area nil "If non-nil, using the echo area for tooltips will resize the echo area. By default, when the echo area is used for displaying tooltips, @@ -427,7 +418,7 @@ This is installed on the hook `tooltip-functions', which is run when the timer with id `tooltip-timeout-id' fires. Value is non-nil if this function handled the tip." (when (stringp tooltip-help-message) - (tooltip-show tooltip-help-message tooltip-use-echo-area) + (tooltip-show tooltip-help-message (not tooltip-mode)) t)) (provide 'tooltip) commit 75e3736ba17d993bfd99b5238ab95998f331982e Author: Stefan Kangas Date: Sat Jul 9 12:43:50 2022 +0200 * lisp/woman.el (woman-fill-column): Increase default to 70. diff --git a/lisp/woman.el b/lisp/woman.el index 6bb775115a..c74faa8af4 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -841,10 +841,12 @@ Only useful when run on a graphic display such as X or MS-Windows." :tag "WoMan Formatting" :group 'woman) -(defcustom woman-fill-column 65 - "Right margin for formatted text -- default is 65." +;; This could probably be 80 to match 'Man-width'. +(defcustom woman-fill-column 70 + "Right margin for formatted text -- default is 70." :type 'natnum - :group 'woman-formatting) + :group 'woman-formatting + :version "29.1") (defcustom woman-fill-frame nil ;; Based loosely on a suggestion by Theodore Jump: commit d40cb5243023fe6f431ee0a629626fb8e90f5300 Author: Stefan Kangas Date: Sat Jul 9 12:01:43 2022 +0200 * lisp/mh-e/mh-mime.el (mh-small-show-buffer-p): Double value. diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index 144eb9b3f9..b93f7d8c41 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -1141,7 +1141,7 @@ this ;-)" "Check if show buffer is small. This is used to decide if smileys and graphical emphasis should be displayed." - (>= 32000 (buffer-size))) + (>= 64000 (buffer-size))) commit 76ca5f5eceda6c78f209588da0893bab5b42165c Author: Stefan Kangas Date: Fri Jul 8 14:55:42 2022 +0200 Delete obsolete variable font-lock-maximum-size * lisp/font-lock.el (font-lock-maximum-size): Delete variable obsolete since 24.1. (font-lock-initial-fontify): * lisp/mail/rmail.el (rmail-variables): * lisp/mh-e/mh-mime.el (mh-small-show-buffer-p): Don't use above deleted variable. * lisp/font-core.el (font-lock-mode): * lisp/font-lock.el: * lisp/info.el: Don't mention above deleted variable. diff --git a/etc/NEWS b/etc/NEWS index ef6e7216e2..9fe7c97549 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2276,7 +2276,8 @@ This change is now applied in 'dired-insert-directory'. 'deferred-action-function', 'dired-x-submit-report', 'eieio-defgeneric', 'eieio-defmethod', 'emacs-lock-from-exiting', 'erc-complete-word', 'eshell-cmpl-suffix-list', 'eshell-for', -'gnus-carpal', 'gnus-debug-exclude-variables', 'gnus-debug-files', +'font-lock-maximum-size', 'gnus-carpal', +'gnus-debug-exclude-variables', 'gnus-debug-files', 'gnus-local-domain', 'gnus-outgoing-message-group', 'gnus-registry-user-format-function-M', 'image-extension-data', 'image-library-alist', 'inhibit-first-line-modes-regexps', diff --git a/lisp/font-core.el b/lisp/font-core.el index 2b75309ff3..db07aa011c 100644 --- a/lisp/font-core.el +++ b/lisp/font-core.el @@ -105,8 +105,7 @@ example, put in your ~/.emacs: Where major modes support different levels of fontification, you can use the variable `font-lock-maximum-decoration' to specify which level you generally prefer. When you turn Font Lock mode -on/off the buffer is fontified/defontified, though fontification -occurs only if the buffer is less than `font-lock-maximum-size'. +on/off the buffer is fontified/defontified. To add your own highlighting for some major mode, and modify the highlighting selected automatically via the variable diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 206879b169..181a7dc90e 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -47,9 +47,9 @@ ;; ;; Fontification for a particular mode may be available in a number of levels ;; of decoration. The higher the level, the more decoration, but the more time -;; it takes to fontify. See the variable `font-lock-maximum-decoration', and -;; also the variable `font-lock-maximum-size'. Support modes for Font Lock -;; mode can be used to speed up Font Lock mode. See `font-lock-support-mode'. +;; it takes to fontify. See the variable `font-lock-maximum-decoration'. +;; Support modes for Font Lock mode can be used to speed up Font Lock +;; mode. See `font-lock-support-mode'. ;;;; How Font Lock mode fontifies: @@ -228,32 +228,6 @@ ;; User variables. -(defcustom font-lock-maximum-size 256000 - "Maximum buffer size for unsupported buffer fontification. -When `font-lock-support-mode' is nil, only buffers smaller than -this are fontified. This variable has no effect if a Font Lock -support mode (usually `jit-lock-mode') is enabled. - -If nil, means size is irrelevant. -If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE), -where MAJOR-MODE is a symbol or t (meaning the default). For example: - ((c-mode . 256000) (c++-mode . 256000) (rmail-mode . 1048576)) -means that the maximum size is 250K for buffers in C or C++ modes, one megabyte -for buffers in Rmail mode, and size is irrelevant otherwise." - :type '(choice (const :tag "none" nil) - (integer :tag "size") - (repeat :menu-tag "mode specific" :tag "mode specific" - :value ((t . nil)) - (cons :tag "Instance" - (radio :tag "Mode" - (const :tag "all" t) - (symbol :tag "name")) - (radio :tag "Size" - (const :tag "none" nil) - (integer :tag "size"))))) - :group 'font-lock) -(make-obsolete-variable 'font-lock-maximum-size nil "24.1") - (defcustom font-lock-maximum-decoration t "Maximum decoration level for fontification. If nil, use the default decoration (typically the minimum available). @@ -695,15 +669,9 @@ be enabled." ;; The first fontification after turning the mode on. This must ;; only be called after the mode hooks have been run. (when (and font-lock-mode - (font-lock-specified-p t)) - (let ((max-size (font-lock-value-in-major-mode font-lock-maximum-size))) - (cond (font-lock-fontified - nil) - ((or (null max-size) (> max-size (buffer-size))) - (with-no-warnings (font-lock-fontify-buffer))) - (font-lock-verbose - (message "Fontifying %s...buffer size greater than font-lock-maximum-size" - (buffer-name))))))) + (font-lock-specified-p t) + (not font-lock-fontified)) + (with-no-warnings (font-lock-fontify-buffer)))) (defun font-lock-mode-internal (arg) ;; Turn on Font Lock mode. diff --git a/lisp/info.el b/lisp/info.el index 0d0dda8c06..7fdb893edc 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -133,8 +133,6 @@ orientation. See `Info-nth-menu-item'.") :version "22.1" :type 'boolean) -;; It's unfortunate that nil means no fontification, as opposed to no limit, -;; since that differs from font-lock-maximum-size. (defcustom Info-fontify-maximum-menu-size 400000 "Maximum size of menu to fontify if `font-lock-mode' is non-nil. Set to nil to disable node fontification; set to t for no limit." diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 467375dbe1..a970ab2a76 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -1451,7 +1451,6 @@ If so restore the actual mbox message collection." (setq-local font-lock-defaults '(rmail-font-lock-keywords t t nil nil - (font-lock-maximum-size . nil) (font-lock-dont-widen . t) (font-lock-inhibit-thing-lock . (lazy-lock-mode fast-lock-mode)))) (setq-local require-final-newline nil) diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index d2e07977e5..144eb9b3f9 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -1141,15 +1141,7 @@ this ;-)" "Check if show buffer is small. This is used to decide if smileys and graphical emphasis should be displayed." - (let ((max nil)) - ;; FIXME: font-lock-maximum-size is obsolete. - (when (and (boundp 'font-lock-maximum-size) font-lock-maximum-size) - (cond ((numberp font-lock-maximum-size) - (setq max font-lock-maximum-size)) - ((listp font-lock-maximum-size) - (setq max (cdr (or (assoc 'mh-show-mode font-lock-maximum-size) - (assoc t font-lock-maximum-size))))))) - (or (not (numberp max)) (>= (/ max 8) (buffer-size))))) + (>= 32000 (buffer-size))) commit 5f8922b9e26f8c0bf68bd72ff6804616a7134792 Author: Mattias Engdegård Date: Sat Jul 9 11:15:17 2022 +0200 ; * lisp/emacs-lisp/cconv.el (cconv--var-classification): Optimise. diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index eca1123899..7f95fa94fa 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -267,8 +267,7 @@ Returns a form where all lambdas don't have any free variables." (define-inline cconv--var-classification (binder form) (inline-quote - (alist-get (cons ,binder ,form) cconv-var-classification - nil nil #'equal))) + (cdr (assoc (cons ,binder ,form) cconv-var-classification)))) (defun cconv--convert-funcbody (funargs funcbody env parentform) "Run `cconv-convert' on FUNCBODY, the forms of a lambda expression. commit 14a361435324fe4b1a388a382982e6af8bf44ff0 Author: Stefan Kangas Date: Sat Jul 9 11:29:25 2022 +0200 New command emacs-news-toggle-tag * lisp/textmodes/emacs-news-mode.el (emacs-news-toggle-tag): New command. (emacs-news-mode-map): Bind above new command to "C-c C-t". * test/lisp/textmodes/emacs-news-mode-resources/toggle-tag.erts: * test/lisp/textmodes/emacs-news-mode-tests.el: New files. diff --git a/lisp/textmodes/emacs-news-mode.el b/lisp/textmodes/emacs-news-mode.el index be4bba06d2..af0aa2ddea 100644 --- a/lisp/textmodes/emacs-news-mode.el +++ b/lisp/textmodes/emacs-news-mode.el @@ -52,6 +52,7 @@ :parent emacs-news-common-map "C-c C-s" #'emacs-news-next-untagged-entry "C-c C-r" #'emacs-news-previous-untagged-entry + "C-c C-t" #'emacs-news-toggle-tag "C-c C-g" #'emacs-news-goto-section "C-c C-j" #'emacs-news-find-heading "C-c C-e" #'emacs-news-count-untagged-entries @@ -162,6 +163,26 @@ untagged NEWS entry." (interactive nil emacs-news-mode) (emacs-news-next-untagged-entry t)) +(defun emacs-news-toggle-tag () + "Toggle documentation tag of current headline in the Emacs NEWS file." + (interactive nil emacs-news-mode) + (save-excursion + (goto-char (line-beginning-position)) + (cond ((or (looking-at (rx bol (or "---" "+++") eol))) + (forward-line 2)) + ((or (looking-at (rx bol "*** "))) + (forward-line 1))) + (outline-previous-visible-heading 1) + (forward-line -1) + (cond ((not (looking-at (rx bol (or "---" "+++") eol))) + (insert "\n---")) + ((looking-at (rx bol "---" eol)) + (delete-char 3) + (insert "+++")) + ((looking-at (rx bol "+++" eol)) + (delete-char 4)) + (t (user-error "Invalid headline tag; can't toggle"))))) + (defun emacs-news-count-untagged-entries () "Say how many untagged entries there are in the current NEWS buffer." (interactive nil emacs-news-mode) diff --git a/test/lisp/textmodes/emacs-news-mode-resources/toggle-tag.erts b/test/lisp/textmodes/emacs-news-mode-resources/toggle-tag.erts new file mode 100644 index 0000000000..63c3b1b7d8 --- /dev/null +++ b/test/lisp/textmodes/emacs-news-mode-resources/toggle-tag.erts @@ -0,0 +1,131 @@ +Name: tag1 +Point-Char: | + +=-= ++++ +*** 'dired-do-relsymlink-regexp' moved from dired-x to dired. +The corresponding key "% Y" is now bound by default in Dired. + +*** 'M-G' is now bound to 'dired-goto-subdir'. +|Before, that binding was only available with 'dired-x'. +=-= ++++ +*** 'dired-do-relsymlink-regexp' moved from dired-x to dired. +The corresponding key "% Y" is now bound by default in Dired. + +--- +*** 'M-G' is now bound to 'dired-goto-subdir'. +|Before, that binding was only available with 'dired-x'. +=-=-= + +Name: tag2 +Point-Char: | + +=-= ++++ +*** 'dired-do-relsymlink-regexp' moved from dired-x to dired. +The corresponding key "% Y" is now bound by default in Dired. + +--- +*** 'M-G' is now bound to 'dired-goto-subdir'. +|Before, that binding was only available if the 'dired-x' package was +loaded. +=-= ++++ +*** 'dired-do-relsymlink-regexp' moved from dired-x to dired. +The corresponding key "% Y" is now bound by default in Dired. + ++++ +*** 'M-G' is now bound to 'dired-goto-subdir'. +|Before, that binding was only available if the 'dired-x' package was +loaded. +=-=-= + +Name: tag3 +Point-Char: | + +=-= ++++ +*** 'dired-do-relsymlink-regexp' moved from dired-x to dired. +The corresponding key "% Y" is now bound by default in Dired. + ++++ +*** 'M-G' is now bound to 'dired-goto-subdir'. +|Before, that binding was only available if the 'dired-x' package was +loaded. +=-= ++++ +*** 'dired-do-relsymlink-regexp' moved from dired-x to dired. +The corresponding key "% Y" is now bound by default in Dired. + +*** 'M-G' is now bound to 'dired-goto-subdir'. +|Before, that binding was only available if the 'dired-x' package was +loaded. +=-=-= + +Name: tag4-point-at-headline +Point-Char: | + +=-= ++++ +*** 'dired-do-relsymlink-regexp' moved from dired-x to dired. +The corresponding key "% Y" is now bound by default in Dired. + +|*** 'M-G' is now bound to 'dired-goto-subdir'. +Before, that binding was only available if the 'dired-x' package was +loaded. +=-= ++++ +*** 'dired-do-relsymlink-regexp' moved from dired-x to dired. +The corresponding key "% Y" is now bound by default in Dired. + +--- +|*** 'M-G' is now bound to 'dired-goto-subdir'. +Before, that binding was only available if the 'dired-x' package was +loaded. +=-=-= + +Name: tag5-point-at-tag +Point-Char: | + +=-= ++++ +*** 'dired-do-relsymlink-regexp' moved from dired-x to dired. +The corresponding key "% Y" is now bound by default in Dired. + +|--- +*** 'M-G' is now bound to 'dired-goto-subdir'. +Before, that binding was only available if the 'dired-x' package was +loaded. +=-= ++++ +*** 'dired-do-relsymlink-regexp' moved from dired-x to dired. +The corresponding key "% Y" is now bound by default in Dired. + +|+++ +*** 'M-G' is now bound to 'dired-goto-subdir'. +Before, that binding was only available if the 'dired-x' package was +loaded. +=-=-= + +Name: tag6-point-at-tag +Point-Char: | + +=-= ++++ +*** 'dired-do-relsymlink-regexp' moved from dired-x to dired. +The corresponding key "% Y" is now bound by default in Dired. + +|+++ +*** 'M-G' is now bound to 'dired-goto-subdir'. +Before, that binding was only available if the 'dired-x' package was +loaded. +=-= ++++ +*** 'dired-do-relsymlink-regexp' moved from dired-x to dired. +The corresponding key "% Y" is now bound by default in Dired. + +|*** 'M-G' is now bound to 'dired-goto-subdir'. +Before, that binding was only available if the 'dired-x' package was +loaded. +=-=-= diff --git a/test/lisp/textmodes/emacs-news-mode-tests.el b/test/lisp/textmodes/emacs-news-mode-tests.el new file mode 100644 index 0000000000..d2da5eda90 --- /dev/null +++ b/test/lisp/textmodes/emacs-news-mode-tests.el @@ -0,0 +1,32 @@ +;;; emacs-news-mode-tests.el --- Tests for emacs-news-mode.el -*- lexical-binding: t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) +(require 'ert-x) +(require 'emacs-news-mode) + +(ert-deftest emacs-news-toggle-tag () + (ert-test-erts-file (ert-resource-file "toggle-tag.erts") + (lambda () + (emacs-news-mode) + (emacs-news-toggle-tag)))) + +;;; emacs-news-mode-tests.el ends here commit ecb2eccad56518992426500dd8119024ea8288a8 Author: Stefan Kangas Date: Sat Jul 9 10:54:01 2022 +0200 Improve ert-test-erts-file documentation * lisp/emacs-lisp/ert.el (ert-test-erts-file): Improve docstring. * doc/misc/ert.texi (erts files): Fix typo. diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi index 4dccd8edcf..1b7f38daad 100644 --- a/doc/misc/ert.texi +++ b/doc/misc/ert.texi @@ -822,7 +822,7 @@ that's pretty difficult to read and write, especially when the text in question is multi-line. So ert provides a function called @code{ert-test-erts-file} that takes -two parameters: The name of a specially-formatted @dfn{erts} file, and +two parameters: the name of a specially-formatted @dfn{erts} file, and (optionally) a function that performs the transform. @findex erts-mode diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 21bee4c6d8..49b54c2d00 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -2880,8 +2880,14 @@ To be used in the ERT results buffer." nil) (defun ert-test-erts-file (file &optional transform) - "Parse FILE as a file containing before/after parts. -TRANSFORM will be called to get from before to after." + "Parse FILE as a file containing before/after parts (an erts file). + +This function puts the \"before\" section of an .erts file into a +temporary buffer, calls the TRANSFORM function, and then compares +the result with the \"after\" section. + +See Info node `(ert) erts files' for more information on how to +write erts files." (with-temp-buffer (insert-file-contents file) (let ((gen-specs (list (cons 'dummy t) commit d74dad673b854b011b23853d298c9a8f86d2d6ad Author: Stefan Kangas Date: Sat Jul 9 10:21:31 2022 +0200 Bind M-G unconditionally in Dired * lisp/dired-x.el: Move dired-goto-subdir binding from here... * lisp/dired.el (dired-mode-map): ...to here. (Bug#21981) * doc/misc/dired-x.texi (Miscellaneous Commands): Move documentation of above command from here... * doc/emacs/dired.texi (Subdirectory Motion): ...to here. diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 69450c82d6..292c986c1c 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -1333,6 +1333,12 @@ parent directory. @kindex > @r{(Dired)} @item > Move down to the next directory-file line (@code{dired-next-dirline}). + +@findex dired-goto-subdir +@kindex M-G @r{(Dired)} +@item M-G +Prompt for a directory and move to its directory-file line +(@code{dired-goto-subdir}). @end table @node Hiding Subdirectories diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index 0e8f969b29..50d9914081 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi @@ -882,15 +882,6 @@ normal and a wildcard buffer for the same directory, @kbd{C-x d @key{RET}} will toggle between those two. @end table -@table @kbd -@findex dired-goto-subdir -@kindex M-G -@item M-G -(@code{dired-goto-subdir}) Go to the header line of an inserted directory. -This command reads its argument, with completion derived from the names of the -inserted subdirectories. -@end table - @table @code @item dired-vm diff --git a/etc/NEWS b/etc/NEWS index 8c9a05775f..ef6e7216e2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1065,6 +1065,11 @@ The corresponding key "Y" is now bound by default in Dired. *** 'dired-do-relsymlink-regexp' moved from dired-x to dired. The corresponding key "% Y" is now bound by default in Dired. +--- +*** 'M-G' is now bound to 'dired-goto-subdir'. +Before, that binding was only available if the 'dired-x' package was +loaded. + +++ *** 'dired-info' and 'dired-man' moved from dired-x to dired. The 'dired-info' and 'dired-man' commands have been moved from the diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 4d66ab6f12..9edf837481 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -236,7 +236,6 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used." (define-key dired-mode-map "\C-x\M-o" 'dired-omit-mode) (define-key dired-mode-map "\M-(" 'dired-mark-sexp) (define-key dired-mode-map "\M-!" 'dired-smart-shell-command) -(define-key dired-mode-map "\M-G" 'dired-goto-subdir) (define-key dired-mode-map "F" 'dired-do-find-marked-files) (define-key dired-mode-map "V" 'dired-do-run-mail) diff --git a/lisp/dired.el b/lisp/dired.el index bdcfc36a0e..b9ab2a9b1e 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2174,6 +2174,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." "S-SPC" #'dired-previous-line " " #'dired-next-line " " #'dired-previous-line + "M-G" #'dired-goto-subdir ;; hiding "$" #'dired-hide-subdir "M-$" #'dired-hide-all commit 04f1396640f2af1a3be2ba48181c4e9242e6e77c Author: Stefan Kangas Date: Sat Jul 9 10:14:54 2022 +0200 Move dired-buffer-more-recently-used-p to dired.el * lisp/dired-x.el (dired-buffer-more-recently-used-p): Move from here... * lisp/dired.el (dired-buffer-more-recently-used-p): ...to here. diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 796625058b..4d66ab6f12 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -1138,14 +1138,6 @@ otherwise." ;;; Miscellaneous internal functions -;; This should be a builtin -(defun dired-buffer-more-recently-used-p (buffer1 buffer2) - "Return t if BUFFER1 is more recently used than BUFFER2. -Considers buffers closer to the car of `buffer-list' to be more recent." - (and (not (equal buffer1 buffer2)) - (memq buffer1 (buffer-list)) - (not (memq buffer1 (memq buffer2 (buffer-list)))))) - ;; Needed if ls -lh is supported and also for GNU ls -ls. (defun dired-x--string-to-number (str) "Like `string-to-number' but recognize a trailing unit prefix. diff --git a/lisp/dired.el b/lisp/dired.el index 5769b73f63..bdcfc36a0e 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -40,9 +40,6 @@ (require 'dired-loaddefs nil t) (require 'dnd) -(declare-function dired-buffer-more-recently-used-p - "dired-x" (buffer1 buffer2)) - ;;; Customizable variables @@ -3505,6 +3502,14 @@ is the directory where the file on this line resides." (point-max) (point)))) +;; This should be a builtin +(defun dired-buffer-more-recently-used-p (buffer1 buffer2) + "Return t if BUFFER1 is more recently used than BUFFER2. +Considers buffers closer to the car of `buffer-list' to be more recent." + (and (not (equal buffer1 buffer2)) + (memq buffer1 (buffer-list)) + (not (memq buffer1 (memq buffer2 (buffer-list)))))) + ;;; Deleting files commit ac7b90e323eb375d5ff48fb24df206dc6336e656 Author: Stefan Kangas Date: Fri Jul 8 14:46:20 2022 +0200 Delete obsolete variable buffer-substring-filters * lisp/simple.el (buffer-substring-filters): Delete variable obsolete since 24.1. (buffer-substring--filter): Adjust for deleted variable. * doc/lispref/text.texi (Buffer Contents): Adjust documentation for deleted variable. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 0c04d01261..ab46afc838 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -243,10 +243,8 @@ using a function specified by the variable The default filter function consults the obsolete wrapper hook @code{filter-buffer-substring-functions} (see the documentation string of the macro @code{with-wrapper-hook} for the details about this -obsolete facility), and the obsolete variable -@code{buffer-substring-filters}. If both of these are @code{nil}, it -returns the unaltered text from the buffer, i.e., what -@code{buffer-substring} would return. +obsolete facility). If it is @code{nil}, it returns the unaltered +text from the buffer, i.e., what @code{buffer-substring} would return. If @var{delete} is non-@code{nil}, the function deletes the text between @var{start} and @var{end} after copying it, like @@ -282,22 +280,12 @@ the same as those of @code{filter-buffer-substring}. The first hook function is passed a @var{fun} that is equivalent to the default operation of @code{filter-buffer-substring}, i.e., it -returns the buffer-substring between @var{start} and @var{end} -(processed by any @code{buffer-substring-filters}) and optionally -deletes the original text from the buffer. In most cases, the hook -function will call @var{fun} once, and then do its own processing of -the result. The next hook function receives a @var{fun} equivalent to -this, and so on. The actual return value is the result of all the -hook functions acting in sequence. -@end defvar - -@defvar buffer-substring-filters -The value of this obsolete variable should be a list of functions -that accept a single string argument and return another string. -The default @code{filter-buffer-substring} function passes the buffer -substring to the first function in this list, and the return value of -each function is passed to the next function. The return value of the -last function is passed to @code{filter-buffer-substring-functions}. +returns the buffer-substring between @var{start} and @var{end} and +optionally deletes the original text from the buffer. In most cases, +the hook function will call @var{fun} once, and then do its own +processing of the result. The next hook function receives a @var{fun} +equivalent to this, and so on. The actual return value is the result +of all the hook functions acting in sequence. @end defvar @defun current-word &optional strict really-word diff --git a/etc/NEWS b/etc/NEWS index 5831bbefd4..8c9a05775f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2261,8 +2261,9 @@ This change is now applied in 'dired-insert-directory'. 'allout-mode-deactivate-hook', 'ansi-color-unfontify-region', 'auth-source-forget-user-or-password', 'auth-source-hide-passwords', 'auth-source-user-or-password', 'bibtex-complete', -'bibtex-entry-field-alist', 'byte-compile-disable-print-circle', -'cfengine-mode-abbrevs', 'chart-map', 'comint-dynamic-complete', +'bibtex-entry-field-alist', 'buffer-substring-filters', +'byte-compile-disable-print-circle', 'cfengine-mode-abbrevs', +'chart-map', 'comint-dynamic-complete', 'comint-dynamic-complete-as-filename', 'comint-dynamic-simple-complete', 'command-history-map', 'completion-annotate-function', 'condition-case-no-debug', diff --git a/lisp/simple.el b/lisp/simple.el index 1d251dbf5e..caba924f6a 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -5352,17 +5352,6 @@ that `filter-buffer-substring' received. It should return the buffer substring between BEG and END, after filtering. If DELETE is non-nil, it should delete the text between BEG and END from the buffer.") -(defvar buffer-substring-filters nil - "List of filter functions for `buffer-substring--filter'. -Each function must accept a single argument, a string, and return a string. -The buffer substring is passed to the first function in the list, -and the return value of each function is passed to the next. -As a special convention, point is set to the start of the buffer text -being operated on (i.e., the first argument of `buffer-substring--filter') -before these functions are called.") -(make-obsolete-variable 'buffer-substring-filters - 'filter-buffer-substring-function "24.1") - (defun filter-buffer-substring (beg end &optional delete) "Return the buffer substring between BEG and END, after filtering. If DELETE is non-nil, delete the text between BEG and END from the buffer. @@ -5383,20 +5372,15 @@ that are special to a buffer, and should not be copied into other buffers." "Default function to use for `filter-buffer-substring-function'. Its arguments and return value are as specified for `filter-buffer-substring'. Also respects the obsolete wrapper hook `filter-buffer-substring-functions' -\(see `with-wrapper-hook' for details about wrapper hooks), -and the abnormal hook `buffer-substring-filters'. +(see `with-wrapper-hook' for details about wrapper hooks). No filtering is done unless a hook says to." (subr--with-wrapper-hook-no-warnings filter-buffer-substring-functions (beg end delete) (cond - ((or delete buffer-substring-filters) + (delete (save-excursion (goto-char beg) - (let ((string (if delete (delete-and-extract-region beg end) - (buffer-substring beg end)))) - (dolist (filter buffer-substring-filters) - (setq string (funcall filter string))) - string))) + (delete-and-extract-region beg end))) (t (buffer-substring beg end))))) commit 6caade631ef9b80f751ce94d14252c1fb802fce0 Author: Eli Zaretskii Date: Sat Jul 9 12:45:21 2022 +0300 ; Rename 'ffap--accept-or-reject-p' * lisp/ffap.el (ffap-accept-or-reject-p): Renamed from 'ffap--accept-or-reject-p'; all users changed. Doc fix. diff --git a/lisp/ffap.el b/lisp/ffap.el index 65e0779e40..d7225ee9c9 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -377,9 +377,10 @@ Actual search is done by the function `ffap-next-guess'." ;;; Machines (`ffap-machine-p'): -(defun ffap--accept-or-reject-p (symbol) +(defun ffap-accept-or-reject-p (symbol) "Return non-nil if SYMBOL is `accept' or `reject'. -Otherwise, return nil." +Otherwise, return nil. This is intended for use as the +predicate in the `:safe' property of user options." (memq symbol '(accept reject))) ;; I cannot decide a "best" strategy here, so these are variables. In @@ -391,7 +392,7 @@ Value should be a symbol, one of `ping', `accept', and `reject'." :type '(choice (const ping) (const accept) (const reject)) - :safe #'ffap--accept-or-reject-p + :safe #'ffap-accept-or-reject-p :group 'ffap) (defcustom ffap-machine-p-known 'accept @@ -401,7 +402,7 @@ See `mail-extr.el' for the known domains." :type '(choice (const ping) (const accept) (const reject)) - :safe #'ffap--accept-or-reject-p + :safe #'ffap-accept-or-reject-p :group 'ffap :version "29.1") @@ -412,7 +413,7 @@ See `mail-extr.el' for the known domains." :type '(choice (const ping) (const accept) (const reject)) - :safe #'ffap--accept-or-reject-p + :safe #'ffap-accept-or-reject-p :group 'ffap) (defun ffap-what-domain (domain) commit bab449f034f44657ff3ed1bf533be6a27f4dafd6 Author: Po Lu Date: Sat Jul 9 16:18:35 2022 +0800 Improve drag-and-drop emulation time handling * src/xselect.c (x_handle_selection_request): Use display-specific pending DND time. (x_set_pending_dnd_time): Delete function. * src/xterm.c (x_dnd_do_unsupported_drop, handle_one_xevent): Set dpyinfo->pending_dnd_time instead. * src/xterm.h (struct x_display_info): New field `pending_dnd_time'. Make handling pending drops display-specific to avoid interference when there are multiple displays. diff --git a/src/xselect.c b/src/xselect.c index d1b6d454ab..80db0d1fe2 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -40,8 +40,6 @@ along with GNU Emacs. If not, see . */ #include -static Time pending_dnd_time; - struct prop_location; struct selection_data; @@ -265,7 +263,7 @@ x_atom_to_symbol (struct x_display_info *dpyinfo, Atom atom) TIMESTAMP should be the timestamp where selection ownership will be assumed. DND_DATA is the local value that will be used for selection requests - with `pending_dnd_time'. + with `dpyinfo->pending_dnd_time'. Update the Vselection_alist so that we can reply to later requests for our selection. */ @@ -855,8 +853,11 @@ x_handle_selection_request (struct selection_input_event *event) /* This is how the XDND protocol recommends dropping text onto a target that doesn't support XDND. */ - if (SELECTION_EVENT_TIME (event) == pending_dnd_time + 1 - || SELECTION_EVENT_TIME (event) == pending_dnd_time + 2) + if (dpyinfo->pending_dnd_time + && ((SELECTION_EVENT_TIME (event) + == dpyinfo->pending_dnd_time + 1) + || (SELECTION_EVENT_TIME (event) + == dpyinfo->pending_dnd_time + 2))) use_alternate = true; block_input (); @@ -2884,12 +2885,6 @@ x_timestamp_for_selection (struct x_display_info *dpyinfo, return value; } -void -x_set_pending_dnd_time (Time time) -{ - pending_dnd_time = time; -} - static void syms_of_xselect_for_pdumper (void); void diff --git a/src/xterm.c b/src/xterm.c index 1afb8adcfe..d9485980fe 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -3873,8 +3873,10 @@ x_dnd_do_unsupported_drop (struct x_display_info *dpyinfo, && child_return != None) child = child_return; + x_uncatch_errors (); + if (!CONSP (value)) - goto cancel; + return; current_value = assq_no_quit (QPRIMARY, dpyinfo->terminal->Vselection_alist); @@ -3891,9 +3893,7 @@ x_dnd_do_unsupported_drop (struct x_display_info *dpyinfo, from generating events that will insert something else. */ if (owner != FRAME_X_WINDOW (f)) - goto cancel; - - x_uncatch_errors (); + return; event.xbutton.window = child; event.xbutton.subwindow = None; @@ -3903,7 +3903,7 @@ x_dnd_do_unsupported_drop (struct x_display_info *dpyinfo, event.xbutton.button = 2; event.xbutton.same_screen = True; - x_set_pending_dnd_time (before); + dpyinfo->pending_dnd_time = before; event.xbutton.type = ButtonPress; event.xbutton.time = before + 1; @@ -3924,9 +3924,6 @@ x_dnd_do_unsupported_drop (struct x_display_info *dpyinfo, x_dnd_action_symbol = QXdndActionPrivate; return; - - cancel: - x_uncatch_errors (); } static void @@ -18934,23 +18931,17 @@ handle_one_xevent (struct x_display_info *dpyinfo, } } else - { - x_set_pending_dnd_time (event->xbutton.time); - x_dnd_send_unsupported_drop (dpyinfo, (x_dnd_last_seen_toplevel != None - ? x_dnd_last_seen_toplevel - : x_dnd_last_seen_window), - event->xbutton.x_root, event->xbutton.y_root, - event->xbutton.time); - } + x_dnd_send_unsupported_drop (dpyinfo, (x_dnd_last_seen_toplevel != None + ? x_dnd_last_seen_toplevel + : x_dnd_last_seen_window), + event->xbutton.x_root, event->xbutton.y_root, + event->xbutton.time); } else if (x_dnd_last_seen_toplevel != None) - { - x_set_pending_dnd_time (event->xbutton.time); - x_dnd_send_unsupported_drop (dpyinfo, x_dnd_last_seen_toplevel, - event->xbutton.x_root, - event->xbutton.y_root, - event->xbutton.time); - } + x_dnd_send_unsupported_drop (dpyinfo, x_dnd_last_seen_toplevel, + event->xbutton.x_root, + event->xbutton.y_root, + event->xbutton.time); x_dnd_last_protocol_version = -1; @@ -20352,22 +20343,16 @@ handle_one_xevent (struct x_display_info *dpyinfo, } } else - { - x_set_pending_dnd_time (xev->time); - x_dnd_send_unsupported_drop (dpyinfo, (x_dnd_last_seen_toplevel != None - ? x_dnd_last_seen_toplevel - : x_dnd_last_seen_window), - xev->root_x, xev->root_y, xev->time); - } + x_dnd_send_unsupported_drop (dpyinfo, (x_dnd_last_seen_toplevel != None + ? x_dnd_last_seen_toplevel + : x_dnd_last_seen_window), + xev->root_x, xev->root_y, xev->time); } else if (x_dnd_last_seen_toplevel != None) - { - x_set_pending_dnd_time (xev->time); - x_dnd_send_unsupported_drop (dpyinfo, - x_dnd_last_seen_toplevel, - xev->root_x, xev->root_y, - xev->time); - } + x_dnd_send_unsupported_drop (dpyinfo, + x_dnd_last_seen_toplevel, + xev->root_x, xev->root_y, + xev->time); x_dnd_last_protocol_version = -1; x_dnd_last_motif_style = XM_DRAG_STYLE_NONE; diff --git a/src/xterm.h b/src/xterm.h index 6684d7839f..92e88bb50f 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -765,6 +765,10 @@ struct x_display_info /* Pointer to the next request in `failable_requests'. */ struct x_failable_request *next_failable_request; + + /* The pending drag-and-drop time for middle-click based + drag-and-drop emulation. */ + Time pending_dnd_time; }; #ifdef HAVE_X_I18N @@ -1617,7 +1621,6 @@ extern void x_clipboard_manager_save_all (void); extern Lisp_Object x_timestamp_for_selection (struct x_display_info *, Lisp_Object); -extern void x_set_pending_dnd_time (Time); extern void x_own_selection (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Time); extern Atom x_intern_cached_atom (struct x_display_info *, const char *, commit 115261b323a73aaf5253b3052f433895c8b77881 (refs/remotes/origin/emacs-28) Author: Eli Zaretskii Date: Sat Jul 9 10:39:57 2022 +0300 ; Improve wording of recently-changed doc strings. * lisp/simple.el (auto-save-mode): * lisp/files.el (auto-save-visited-mode): Improve wording of the doc strings. diff --git a/lisp/files.el b/lisp/files.el index bccf7d56ba..1212187274 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -419,14 +419,15 @@ idle for `auto-save-visited-interval' seconds." (timer-set-idle-time auto-save--timer value :repeat)))) (define-minor-mode auto-save-visited-mode - "Toggle automatic saving to file-visiting buffers on or off. + "Toggle automatic saving of file-visiting buffers to their files. -When this mode is enabled, visited files are saved automatically. -The user option `auto-save-visited-interval' controls how often. +When this mode is enabled, file-visiting buffers are automatically +saved to their files. This is in contrast to `auto-save-mode', which +auto-saves those buffers to a separate file, leaving the original +file intact. See Info node `Saving' for details of the save process. -Unlike `auto-save-mode', this mode will auto-save buffer contents -to the visited files directly and will also run all save-related -hooks. See Info node `Saving' for details of the save process. +The user option `auto-save-visited-interval' controls how often to +auto-save a buffer into its visited file. You can also set the buffer-local value of the variable `auto-save-visited-mode' to nil. A buffer where the buffer-local diff --git a/lisp/simple.el b/lisp/simple.el index dca8589be4..a18a614d68 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -8400,15 +8400,15 @@ presented." (define-minor-mode auto-save-mode "Toggle auto-saving in the current buffer (Auto Save mode). -When this mode is enabled, Emacs periodically saves each visited -file in a separate file called the \"auto-save file\". This is a -safety measure to prevent you from losing more than a limited -amount of work if the system crashes. - -Auto-saving does not alter the file you actually use: the visited -file is changed only when you request saving it explicitly (such -as with \\[save-buffer]). If you want to save visited files -automatically, use \\[auto-save-visited-mode]). +When this mode is enabled, Emacs periodically saves each file-visiting +buffer in a separate \"auto-save file\". This is a safety measure to +prevent you from losing more than a limited amount of work if the +system crashes. + +Auto-saving does not alter the file visited by the buffer: the visited +file is changed only when you request saving it explicitly (such as +with \\[save-buffer]). If you want to save the buffer into its +visited files automatically, use \\[auto-save-visited-mode]). For more details, see Info node `(emacs) Auto Save'." :variable ((and buffer-auto-save-file-name commit edabfe4ff66090b3b2c433962df4cfe1a68259fd Author: Po Lu Date: Sat Jul 9 04:50:06 2022 +0000 Fix race conditions handling selection clear events on Haiku * src/haiku_select.cc (be_handle_clipboard_changed_message): Include current clipboard count. (be_selection_outdated_p): New function. * src/haikuselect.c (haiku_handle_selection_clear): Ignore outdated events. (haiku_selection_disowned): New argument `count'. Include it in the timestamp field of the selection clear event. * src/haikuselect.h: Update prototypes. * src/systime.h: Define `Time' to an appropriate value on Haiku. diff --git a/src/haiku_select.cc b/src/haiku_select.cc index edb821e313..e1f2a81524 100644 --- a/src/haiku_select.cc +++ b/src/haiku_select.cc @@ -451,31 +451,37 @@ be_unlock_clipboard (enum haiku_clipboard clipboard, bool discard) void be_handle_clipboard_changed_message (void) { + int64 n_clipboard, n_primary, n_secondary; + + n_clipboard = system_clipboard->SystemCount (); + n_primary = primary->SystemCount (); + n_secondary = secondary->SystemCount (); + if (count_clipboard != -1 - && (system_clipboard->SystemCount () - > count_clipboard + 1) + && (n_clipboard > count_clipboard + 1) && owned_clipboard) { owned_clipboard = false; - haiku_selection_disowned (CLIPBOARD_CLIPBOARD); + haiku_selection_disowned (CLIPBOARD_CLIPBOARD, + n_clipboard); } if (count_primary != -1 - && (primary->SystemCount () - > count_primary + 1) + && (n_primary > count_primary + 1) && owned_primary) { owned_primary = false; - haiku_selection_disowned (CLIPBOARD_PRIMARY); + haiku_selection_disowned (CLIPBOARD_PRIMARY, + n_primary); } if (count_secondary != -1 - && (secondary->SystemCount () - > count_secondary + 1) + && (n_secondary > count_secondary + 1) && owned_secondary) { owned_secondary = false; - haiku_selection_disowned (CLIPBOARD_SECONDARY); + haiku_selection_disowned (CLIPBOARD_SECONDARY, + n_secondary); } } @@ -487,3 +493,18 @@ be_start_watching_selection (enum haiku_clipboard id) clipboard = get_clipboard_object (id); clipboard->StartWatching (be_app); } + +bool +be_selection_outdated_p (enum haiku_clipboard id, int64 count) +{ + if (id == CLIPBOARD_CLIPBOARD && count_clipboard > count) + return true; + + if (id == CLIPBOARD_PRIMARY && count_primary > count) + return true; + + if (id == CLIPBOARD_SECONDARY && count_secondary > count) + return true; + + return false; +} diff --git a/src/haikuselect.c b/src/haikuselect.c index 03aba1f9ba..9d8c4a2cd1 100644 --- a/src/haikuselect.c +++ b/src/haikuselect.c @@ -1024,6 +1024,13 @@ init_haiku_select (void) void haiku_handle_selection_clear (struct input_event *ie) { + enum haiku_clipboard id; + + id = haiku_get_clipboard_name (ie->arg); + + if (be_selection_outdated_p (id, ie->timestamp)) + return; + CALLN (Frun_hook_with_args, Qhaiku_lost_selection_functions, ie->arg); @@ -1033,7 +1040,7 @@ haiku_handle_selection_clear (struct input_event *ie) } void -haiku_selection_disowned (enum haiku_clipboard id) +haiku_selection_disowned (enum haiku_clipboard id, int64 count) { struct input_event ie; @@ -1055,6 +1062,7 @@ haiku_selection_disowned (enum haiku_clipboard id) break; } + ie.timestamp = count; kbd_buffer_store_event (&ie); } diff --git a/src/haikuselect.h b/src/haikuselect.h index d027834e8b..61efeb9cd9 100644 --- a/src/haikuselect.h +++ b/src/haikuselect.h @@ -39,7 +39,7 @@ extern "C" { #endif /* Defined in haikuselect.c. */ -extern void haiku_selection_disowned (enum haiku_clipboard); +extern void haiku_selection_disowned (enum haiku_clipboard, int64); /* Defined in haiku_select.cc. */ extern void be_clipboard_init (void); @@ -66,6 +66,7 @@ extern int be_lock_clipboard_message (enum haiku_clipboard, void **, bool); extern void be_unlock_clipboard (enum haiku_clipboard, bool); extern void be_handle_clipboard_changed_message (void); extern void be_start_watching_selection (enum haiku_clipboard); +extern bool be_selection_outdated_p (enum haiku_clipboard, int64); #ifdef __cplusplus }; diff --git a/src/systime.h b/src/systime.h index 75088bd4a6..085a7ddeab 100644 --- a/src/systime.h +++ b/src/systime.h @@ -26,6 +26,9 @@ INLINE_HEADER_BEGIN #ifdef HAVE_X_WINDOWS # include +#elif defined HAVE_HAIKU +# include +typedef int64 Time; #else typedef unsigned long Time; #endif commit f400c60237f04781b60423492c583beea6c77e8e Merge: 29c8866c7f 3442de2edd Author: Stefan Kangas Date: Sat Jul 9 06:30:38 2022 +0200 Merge from origin/emacs-28 3442de2edd Doc fix; don't mention obsolete variable c4e251103b ; * lisp/textmodes/rst.el: Update URLs. commit 29c8866c7fcd325995c6fc9b2b18537855fee52c Author: Po Lu Date: Sat Jul 9 01:16:05 2022 +0000 Fix redisplay after running selection hook on Haiku * src/haikuselect.c (haiku_handle_selection_clear): Call redisplay_preserve_echo_area. diff --git a/src/haikuselect.c b/src/haikuselect.c index 999a0f5ac2..03aba1f9ba 100644 --- a/src/haikuselect.c +++ b/src/haikuselect.c @@ -1026,6 +1026,10 @@ haiku_handle_selection_clear (struct input_event *ie) { CALLN (Frun_hook_with_args, Qhaiku_lost_selection_functions, ie->arg); + + /* This is required for redisplay to happen if something changed the + display inside the selection loss functions. */ + redisplay_preserve_echo_area (20); } void commit 35ae8d9f3b18c34a6e6c594afcc442e7aaa5fe29 Author: Po Lu Date: Sat Jul 9 09:07:07 2022 +0800 Add new minor mode to deactivate the region once PRIMARY is lost * doc/emacs/killing.texi (Primary Selection): Document new minor mode `lost-selection-mode'. * etc/NEWS: Announce new minor mode. * lisp/select.el (lost-selection-function): New function. (lost-selection-mode): New global minor mode. diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi index 4435f6e494..bb8d51158a 100644 --- a/doc/emacs/killing.texi +++ b/doc/emacs/killing.texi @@ -610,14 +610,14 @@ yanks the contents of the clipboard at point. @cindex primary selection @cindex selection, primary - Under the X Window System, there exists a @dfn{primary selection} -containing the last stretch of text selected in an X application -(usually by dragging the mouse). Typically, this text can be inserted -into other X applications by @kbd{mouse-2} clicks. The primary -selection is separate from the clipboard. Its contents are more -fragile; they are overwritten each time you select text with the -mouse, whereas the clipboard is only overwritten by explicit cut -or copy commands. + Under the X Window System, PGTK and Haiku, there exists a +@dfn{primary selection} containing the last stretch of text selected +in an X application (usually by dragging the mouse). Typically, this +text can be inserted into other X applications by @kbd{mouse-2} +clicks. The primary selection is separate from the clipboard. Its +contents are more fragile; they are overwritten each time you select +text with the mouse, whereas the clipboard is only overwritten by +explicit cut or copy commands. Under X, whenever the region is active (@pxref{Mark}), the text in the region is saved in the primary selection. This applies regardless @@ -639,6 +639,13 @@ regions to the primary selection entirely. (@kbd{C-y}) to insert this text if @code{select-enable-primary} is set (@pxref{Clipboard}). +@cindex lost-selection-mode + By default, Emacs keeps the region active even after text is +selected in another program; this is contrary to typical X behavior. +To make Emacs deactivate the region after another program places data +in the primary selection, enable the global minor mode +@code{lost-selection-mode}. + @cindex MS-Windows, and primary selection MS-Windows provides no primary selection, but Emacs emulates it within a single Emacs session by storing the selected text internally. diff --git a/etc/NEWS b/etc/NEWS index 925bd9a212..5831bbefd4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2421,6 +2421,11 @@ This is meant to be used in modes that have a header line that should be kept aligned with the buffer contents when the user switches 'display-line-numbers-mode' on or off. ++++ +** New minor mode 'lost-selection-mode'. +This minor mode makes Emacs deactivate the mark in all buffers when +the primary selection is obtained by another program. + +++ ** New predicate 'char-uppercase-p'. This returns non-nil if its argument its an uppercase character. diff --git a/lisp/select.el b/lisp/select.el index d977a8714b..6002b2615e 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -475,6 +475,45 @@ are not available to other programs." (symbolp data) (integerp data))) + +;; Minor mode to make losing ownership of PRIMARY behave more like +;; other X programs. + +(defun lost-selection-function (selection) + "Handle losing of ownership of SELECTION. +If SELECTION is `PRIMARY', deactivate the mark in every +non-temporary buffer." + (let ((select-active-regions nil)) + (when (eq selection 'PRIMARY) + (dolist (buffer (buffer-list)) + (unless (string-match-p "^ " + (buffer-name buffer)) + (with-current-buffer buffer + (deactivate-mark t))))))) + +(define-minor-mode lost-selection-mode + "Toggle `lost-selection-mode'. + +When this is enabled, selecting some text in another program will +cause the mark to be deactivated in all buffers, mimicking the +behavior of most X Windows programs." + :global t + :group 'x + (if lost-selection-mode + (cond ((featurep 'x) (add-hook 'x-lost-selection-functions + #'lost-selection-function)) + ((featurep 'pgtk) (add-hook 'pgtk-lost-selection-functions + #'lost-selection-function)) + ((featurep 'haiku) (add-hook 'haiku-lost-selection-functions + #'lost-selection-function))) + (cond ((featurep 'x) (remove-hook 'x-lost-selection-functions + #'lost-selection-function)) + ((featurep 'pgtk) (remove-hook 'pgtk-lost-selection-functions + #'lost-selection-function)) + ((featurep 'haiku) (remove-hook 'haiku-lost-selection-functions + #'lost-selection-function))))) + + ;; Functions to convert the selection into various other selection types. ;; Every selection type that Emacs handles is implemented this way, except ;; for TIMESTAMP, which is a special case. commit 3d3aaf3af3e497e5ed1aa5924c73fadf45ea3eef Author: Sean Whitton Date: Fri Jul 8 17:28:51 2022 -0700 ; * message.el (message-auto-save-directory): Clarify docstring. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 48115a4165..7c2b24c6ee 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -1411,7 +1411,7 @@ text and it replaces `self-insert-command' with the other command, e.g. (file-name-as-directory (expand-file-name "drafts" message-directory)) "~/") "Directory where Message auto-saves buffers if Gnus isn't running. -If nil, Message won't auto-save." +If nil, Message won't auto-save, whether or not Gnus is running." :group 'message-buffers :link '(custom-manual "(message)Various Message Variables") :type '(choice directory (const :tag "Don't auto-save" nil))) commit ee5814178503c327f703e03f372f792fa1689632 Author: Po Lu Date: Sat Jul 9 08:05:30 2022 +0800 Speed up querying for window manager support * src/xterm.c (handle_one_xevent): Clear net_supported_window if it is destroyed. (x_get_wm_check_window): New function. (x_wm_supports_1): First try net_supported_window. If it still exists, don't ask for _NET_SUPPORTING_WM_CHECK. diff --git a/src/xterm.c b/src/xterm.c index 23a784ade8..1afb8adcfe 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -19215,6 +19215,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto OTHER; case DestroyNotify: + if (event->xdestroywindow.window + == dpyinfo->net_supported_window) + dpyinfo->net_supported_window = None; + xft_settings_event (dpyinfo, event); break; @@ -24076,6 +24080,36 @@ x_set_offset (struct frame *f, int xoff, int yoff, int change_gravity) unblock_input (); } +static Window +x_get_wm_check_window (struct x_display_info *dpyinfo) +{ + Window result; + unsigned char *tmp_data = NULL; + int rc, actual_format; + unsigned long actual_size, bytes_remaining; + Atom actual_type; + + rc = XGetWindowProperty (dpyinfo->display, dpyinfo->root_window, + dpyinfo->Xatom_net_supporting_wm_check, + 0, 1, False, XA_WINDOW, &actual_type, + &actual_format, &actual_size, + &bytes_remaining, &tmp_data); + + if (rc != Success || actual_type != XA_WINDOW + || actual_format != 32 || actual_size != 1) + { + if (tmp_data) + XFree (tmp_data); + + return None; + } + + result = *(Window *) tmp_data; + XFree (tmp_data); + + return result; +} + /* Return true if _NET_SUPPORTING_WM_CHECK window exists and _NET_SUPPORTED on the root window for frame F contains ATOMNAME. This is how a WM check shall be done according to the Window Manager @@ -24099,30 +24133,32 @@ x_wm_supports_1 (struct x_display_info *dpyinfo, Atom want_atom) block_input (); x_catch_errors (dpy); - rc = XGetWindowProperty (dpy, target_window, - dpyinfo->Xatom_net_supporting_wm_check, - 0, max_len, False, target_type, - &actual_type, &actual_format, &actual_size, - &bytes_remaining, &tmp_data); - if (rc != Success || actual_type != XA_WINDOW || x_had_errors_p (dpy)) - { - if (tmp_data) XFree (tmp_data); - x_uncatch_errors (); - unblock_input (); - return false; - } + wmcheck_window = dpyinfo->net_supported_window; - wmcheck_window = *(Window *) tmp_data; - XFree (tmp_data); + if (wmcheck_window == None) + wmcheck_window = x_get_wm_check_window (dpyinfo); - /* Check if window exists. */ - XSelectInput (dpy, wmcheck_window, StructureNotifyMask); - if (x_had_errors_p (dpy)) + if (!x_special_window_exists_p (dpyinfo, wmcheck_window)) { - x_uncatch_errors_after_check (); - unblock_input (); - return false; + if (dpyinfo->net_supported_window != None) + { + dpyinfo->net_supported_window = None; + wmcheck_window = x_get_wm_check_window (dpyinfo); + + if (!x_special_window_exists_p (dpyinfo, wmcheck_window)) + { + x_uncatch_errors (); + unblock_input (); + return false; + } + } + else + { + x_uncatch_errors (); + unblock_input (); + return false; + } } if (dpyinfo->net_supported_window != wmcheck_window) commit 0508d7c4d6637d63a823b66e9f87ab54c2e73b09 Author: Alan Mackenzie Date: Fri Jul 8 20:19:03 2022 +0000 Remove now unused parameter TRACK from do_switch_frame. * src/lisp.h (extern do_swith_frame declaration) * src/frame.c (do_switch_frame): Remove parameter TRACK and its comment. * src/frame.c (Fselect_frame, Fhandle_switch_frame, delete_frame) * src/keyboard.c (quit_throw_to_read_char) * src/minibuf.c (read_minibuf_unwind (twice)) * src/window.c (Fset_window_configuration): Remove argument TRACK. diff --git a/src/frame.c b/src/frame.c index 4828595b93..923ef2d609 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1444,10 +1444,6 @@ affects all frames on the same terminal device. */) If FRAME is a switch-frame event `(switch-frame FRAME1)', use FRAME1 as frame. - If TRACK is non-zero and the frame that currently has the focus - redirects its focus to the selected frame, redirect that focused - frame's focus to FRAME instead. - FOR_DELETION non-zero means that the selected frame is being deleted, which includes the possibility that the frame's terminal is dead. @@ -1455,7 +1451,7 @@ affects all frames on the same terminal device. */) The value of NORECORD is passed as argument to Fselect_window. */ Lisp_Object -do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object norecord) +do_switch_frame (Lisp_Object frame, int for_deletion, Lisp_Object norecord) { struct frame *sf = SELECTED_FRAME (), *f; @@ -1574,7 +1570,7 @@ This function returns FRAME, or nil if FRAME has been deleted. */) /* Do not select a tooltip frame (Bug#47207). */ error ("Cannot select a tooltip frame"); else - return do_switch_frame (frame, 1, 0, norecord); + return do_switch_frame (frame, 0, norecord); } DEFUN ("handle-switch-frame", Fhandle_switch_frame, @@ -1590,7 +1586,7 @@ necessarily represent user-visible input focus. */) kset_prefix_arg (current_kboard, Vcurrent_prefix_arg); run_hook (Qmouse_leave_buffer_hook); - return do_switch_frame (event, 0, 0, Qnil); + return do_switch_frame (event, 0, Qnil); } DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0, @@ -2105,7 +2101,7 @@ delete_frame (Lisp_Object frame, Lisp_Object force) Fraise_frame (frame1); #endif - do_switch_frame (frame1, 0, 1, Qnil); + do_switch_frame (frame1, 1, Qnil); sf = SELECTED_FRAME (); } else diff --git a/src/keyboard.c b/src/keyboard.c index a520e53397..7c13ac9611 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -11459,7 +11459,7 @@ quit_throw_to_read_char (bool from_signal) if (FRAMEP (internal_last_event_frame) && !EQ (internal_last_event_frame, selected_frame)) do_switch_frame (make_lispy_switch_frame (internal_last_event_frame), - 0, 0, Qnil); + 0, Qnil); sys_longjmp (getcjmp, 1); } diff --git a/src/lisp.h b/src/lisp.h index 35cc7f5a09..5ffc2bb038 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4842,7 +4842,7 @@ extern void syms_of_indent (void); /* Defined in frame.c. */ extern void store_frame_param (struct frame *, Lisp_Object, Lisp_Object); extern void store_in_alist (Lisp_Object *, Lisp_Object, Lisp_Object); -extern Lisp_Object do_switch_frame (Lisp_Object, int, int, Lisp_Object); +extern Lisp_Object do_switch_frame (Lisp_Object, int, Lisp_Object); extern Lisp_Object get_frame_param (struct frame *, Lisp_Object); extern void frames_discard_buffer (Lisp_Object); extern void init_frame_once (void); diff --git a/src/minibuf.c b/src/minibuf.c index c2e270a450..0fba334b22 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1123,8 +1123,8 @@ read_minibuf_unwind (void) found: if (!EQ (exp_MB_frame, saved_selected_frame) && !NILP (exp_MB_frame)) - do_switch_frame (exp_MB_frame, 0, 0, Qt); /* This also sets - minibuf_window */ + do_switch_frame (exp_MB_frame, 0, Qt); /* This also sets + minibuf_window */ /* To keep things predictable, in case it matters, let's be in the minibuffer when we reset the relevant variables. Don't depend on @@ -1236,7 +1236,7 @@ read_minibuf_unwind (void) /* Restore the selected frame. */ if (!EQ (exp_MB_frame, saved_selected_frame) && !NILP (exp_MB_frame)) - do_switch_frame (saved_selected_frame, 0, 0, Qt); + do_switch_frame (saved_selected_frame, 0, Qt); } /* Replace the expired minibuffer in frame exp_MB_frame with the next less diff --git a/src/window.c b/src/window.c index af463b90ce..70438b70b8 100644 --- a/src/window.c +++ b/src/window.c @@ -7299,7 +7299,7 @@ the return value is nil. Otherwise the value is t. */) do_switch_frame (NILP (dont_set_frame) ? data->selected_frame : old_frame - , 0, 0, Qnil); + , 0, Qnil); } FRAME_WINDOW_CHANGE (f) = true; commit 3442de2edd8770bae8541257dc5a65fcb932d8da Author: Stefan Kangas Date: Fri Jul 8 21:15:15 2022 +0200 Doc fix; don't mention obsolete variable * src/window.c (Fset_window_hscroll): Doc fix; don't mention obsolete variable. diff --git a/src/window.c b/src/window.c index cbb2a9e0e1..0cf6373e0b 100644 --- a/src/window.c +++ b/src/window.c @@ -1232,7 +1232,7 @@ WINDOW must be a live window and defaults to the selected one. Clip the number to a reasonable value if out of range. Return the new number. NCOL should be zero or positive. -Note that if `automatic-hscrolling' is non-nil, you cannot scroll the +Note that if `auto-hscroll-mode' is non-nil, you cannot scroll the window so that the location of point moves off-window. */) (Lisp_Object window, Lisp_Object ncol) { commit df157953612910e26cab7d1aa31b7ac5cd58d945 Author: Juri Linkov Date: Fri Jul 8 20:58:33 2022 +0300 * lisp/isearch.el (isearch-search-fun-in-noncontiguous-region): New function. (isearch-search-fun-in-text-property): Refactor body to 'search-within-boundaries', then call it (bug#14013). (search-within-boundaries): New function refactored from isearch-search-fun-in-text-property. * test/lisp/isearch-tests.el: Add tests for new search functions. (isearch--test-search-within-boundaries): New function. (isearch--test-search-fun-in-text-property) (isearch--test-search-fun-in-noncontiguous-region): New tests. diff --git a/lisp/isearch.el b/lisp/isearch.el index ad8897dda2..8f480a87d9 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -4489,89 +4489,117 @@ LAX-WHITESPACE: The value of `isearch-lax-whitespace' and (funcall after-change nil nil nil))))) +(defun isearch-search-fun-in-noncontiguous-region (search-fun bounds) + "Return the function that searches inside noncontiguous regions. +A noncontiguous region is defined by the argument BOUNDS that +is a list of cons cells of the form (START . END)." + (apply-partially + #'search-within-boundaries + search-fun + (lambda (pos) + (seq-some (lambda (b) (if isearch-forward + (and (>= pos (car b)) (< pos (cdr b))) + (and (> pos (car b)) (<= pos (cdr b))))) + bounds)) + (lambda (pos) + (let ((bounds (flatten-list bounds)) + found) + (unless isearch-forward + (setq bounds (nreverse bounds))) + (while (and bounds (not found)) + (if (if isearch-forward (< pos (car bounds)) (> pos (car bounds))) + (setq found (car bounds)) + (setq bounds (cdr bounds)))) + found)))) + (defun isearch-search-fun-in-text-property (search-fun property) "Return the function to search inside text that has the specified PROPERTY. The function will limit the search for matches only inside text which has this property in the current buffer. The argument SEARCH-FUN provides the function to search text, and defaults to the value of `isearch-search-fun-default' when nil." - (lambda (string &optional bound noerror count) - (let* ((old (point)) - ;; Check if point is already on the property. - (beg (when (get-text-property - (if isearch-forward old (max (1- old) (point-min))) - property) - old)) - end found (i 0) - (subregexp - (and isearch-regexp - (save-match-data - (catch 'subregexp - (while (string-match "\\^\\|\\$" string i) - (setq i (match-end 0)) - (when (subregexp-context-p string (match-beginning 0)) - ;; The ^/$ is not inside a char-range or escaped. - (throw 'subregexp t)))))))) - ;; Otherwise, try to search for the next property. - (unless beg - (setq beg (if isearch-forward - (next-single-property-change old property) - (previous-single-property-change old property))) - (when beg (goto-char beg))) - ;; Non-nil `beg' means there are more properties. - (while (and beg (not found)) - ;; Search for the end of the current property. - (setq end (if isearch-forward - (next-single-property-change beg property) - (previous-single-property-change beg property))) - ;; Handle ^/$ specially by matching in a temporary buffer. - (if subregexp - (let* ((prop-beg - (if (or (if isearch-forward (bobp) (eobp)) - (null (get-text-property - (+ (point) (if isearch-forward -1 0)) - property))) - ;; Already at the beginning of the field. - beg - ;; Get the real beginning of the field when - ;; the search was started in the middle. - (if isearch-forward - (previous-single-property-change beg property) - (next-single-property-change beg property)))) - (substring (buffer-substring prop-beg end)) - (offset (if isearch-forward prop-beg end)) - match-data) - (with-temp-buffer - (insert substring) - (goto-char (- beg offset -1)) - ;; Apply ^/$ regexp on the whole extracted substring. - (setq found (funcall - (or search-fun (isearch-search-fun-default)) - string (and bound (max (point-min) - (min (point-max) - (- bound offset -1)))) - noerror count)) - ;; Adjust match data as if it's matched in original buffer. - (when found - (setq found (+ found offset -1) - match-data (mapcar (lambda (m) (+ m offset -1)) - (match-data))))) - (when match-data (set-match-data match-data))) - (setq found (funcall - (or search-fun (isearch-search-fun-default)) - string (if bound (if isearch-forward - (min bound end) - (max bound end)) - end) - noerror count))) - ;; Get the next text property. - (unless found - (setq beg (if isearch-forward - (next-single-property-change end property) - (previous-single-property-change end property))) - (when beg (goto-char beg)))) - (unless found (goto-char old)) - found))) + (apply-partially + #'search-within-boundaries + search-fun + (lambda (pos) (get-text-property (if isearch-forward pos + (max (1- pos) (point-min))) + property)) + (lambda (pos) (if isearch-forward + (next-single-property-change pos property) + (previous-single-property-change pos property))))) + +(defun search-within-boundaries ( search-fun get-fun next-fun + string &optional bound noerror count) + (let* ((old (point)) + ;; Check if point is already on the property. + (beg (when (funcall get-fun old) old)) + end found (i 0) + (subregexp + (and isearch-regexp + (save-match-data + (catch 'subregexp + (while (string-match "\\^\\|\\$" string i) + (setq i (match-end 0)) + (when (subregexp-context-p string (match-beginning 0)) + ;; The ^/$ is not inside a char-range or escaped. + (throw 'subregexp t)))))))) + ;; Otherwise, try to search for the next property. + (unless beg + (setq beg (funcall next-fun old)) + (when beg (goto-char beg))) + ;; Non-nil `beg' means there are more properties. + (while (and beg (not found)) + ;; Search for the end of the current property. + (setq end (funcall next-fun beg)) + ;; Handle ^/$ specially by matching in a temporary buffer. + (if subregexp + (let* ((prop-beg + (if (or (if isearch-forward (bobp) (eobp)) + (null (funcall get-fun + (+ (point) + (if isearch-forward -1 1))))) + ;; Already at the beginning of the field. + beg + ;; Get the real beginning of the field when + ;; the search was started in the middle. + (let ((isearch-forward (not isearch-forward))) + ;; Search in the reverse direction. + (funcall next-fun beg)))) + (substring (buffer-substring prop-beg end)) + (offset (if isearch-forward prop-beg end)) + match-data) + (with-temp-buffer + (insert substring) + (goto-char (- beg offset -1)) + ;; Apply ^/$ regexp on the whole extracted substring. + (setq found (funcall + (or search-fun (isearch-search-fun-default)) + string (and bound (max (point-min) + (min (point-max) + (- bound offset -1)))) + noerror count)) + ;; Adjust match data as if it's matched in original buffer. + (when found + (setq found (+ found offset -1) + match-data (mapcar (lambda (m) (+ m offset -1)) + (match-data))))) + (when found (goto-char found)) + (when match-data (set-match-data + (mapcar (lambda (m) (copy-marker m)) + match-data)))) + (setq found (funcall + (or search-fun (isearch-search-fun-default)) + string (if bound (if isearch-forward + (min bound end) + (max bound end)) + end) + noerror count))) + ;; Get the next text property. + (unless found + (setq beg (funcall next-fun end)) + (when beg (goto-char beg)))) + (unless found (goto-char old)) + found)) (defun isearch-resume (string regexp word forward message case-fold) diff --git a/test/lisp/isearch-tests.el b/test/lisp/isearch-tests.el index 4600757d94..8cb5e5e454 100644 --- a/test/lisp/isearch-tests.el +++ b/test/lisp/isearch-tests.el @@ -38,5 +38,85 @@ ;; Bug #21091: let `isearch-done' work without `isearch-update'. (isearch-done)) + +;; Search functions. + +(defun isearch--test-search-within-boundaries (pairs) + (goto-char (point-min)) + (let ((isearch-forward t) + (isearch-regexp nil)) + (dolist (pos (append pairs nil)) + (should (eq (cdr pos) (isearch-search-string "foo" nil t))) + (should (equal (match-string 0) "foo")) + (when (car pos) (should (eq (car pos) (match-beginning 0)))))) + + (goto-char (point-max)) + (let ((isearch-forward nil) + (isearch-regexp nil)) + (dolist (pos (append (reverse pairs) nil)) + (should (eq (car pos) (isearch-search-string "foo" nil t))) + (should (equal (match-string 0) "foo")) + (when (cdr pos) (should (eq (cdr pos) (match-end 0)))))) + + (goto-char (point-min)) + (let ((isearch-forward t) + (isearch-regexp t)) + (dolist (pos (append pairs nil)) + (should (eq (cdr pos) (isearch-search-string ".*" nil t))) + (should (equal (match-string 0) "foo")) + (when (car pos) (should (eq (car pos) (match-beginning 0)))))) + + (goto-char (point-min)) + (let ((isearch-forward t) + (isearch-regexp t)) + (dolist (pos (append pairs nil)) + (should (eq (cdr pos) (isearch-search-string "^.*" nil t))) + (should (equal (match-string 0) "foo")) + (when (car pos) (should (eq (car pos) (match-beginning 0)))))) + + (goto-char (point-min)) + (let ((isearch-forward t) + (isearch-regexp t)) + (dolist (pos (append pairs nil)) + (should (eq (cdr pos) (isearch-search-string ".*$" nil t))) + (should (equal (match-string 0) "foo")) + (when (car pos) (should (eq (car pos) (match-beginning 0)))))) + + (goto-char (point-max)) + (let ((isearch-forward nil) + (isearch-regexp t)) + (dolist (pos (append (reverse pairs) nil)) + (should (eq (car pos) (isearch-search-string "^.*" nil t))) + (should (equal (match-string 0) "foo")) + (when (cdr pos) (should (eq (cdr pos) (match-end 0)))))) + + (goto-char (point-max)) + (let ((isearch-forward nil) + (isearch-regexp t)) + (dolist (pos (append (reverse pairs) nil)) + (should (eq (car pos) (isearch-search-string "foo$" nil t))) + (should (equal (match-string 0) "foo")) + (when (cdr pos) (should (eq (cdr pos) (match-end 0))))))) + +(ert-deftest isearch--test-search-fun-in-text-property () + (let* ((pairs '((4 . 7) (11 . 14) (21 . 24))) + (isearch-search-fun-function + (lambda () (isearch-search-fun-in-text-property nil 'dired-filename)))) + (with-temp-buffer + (insert "foo" (propertize "foo" 'dired-filename t) "foo\n") + (insert (propertize "foo" 'dired-filename t) "foo\n") + (insert "foo" (propertize "foo" 'dired-filename t) "\n") + (isearch--test-search-within-boundaries pairs)))) + +(ert-deftest isearch--test-search-fun-in-noncontiguous-region () + (let* ((pairs '((4 . 7) (11 . 14) (21 . 24))) + (isearch-search-fun-function + (lambda () (isearch-search-fun-in-noncontiguous-region nil pairs)))) + (with-temp-buffer + (insert "foofoofoo\n") + (insert "foofoo\n") + (insert "foofoo\n") + (isearch--test-search-within-boundaries pairs)))) + (provide 'isearch-tests) ;;; isearch-tests.el ends here commit 3cfac1fe073815bdbba96e3a35a1c15626022c07 Author: Juri Linkov Date: Fri Jul 8 20:47:11 2022 +0300 Display the number of invisible matches for isearch-lazy-count (bug#40808) * lisp/isearch.el (lazy-count-invisible-format): New variable. (isearch-mode): Set isearch-lazy-count-invisible to nil. (isearch-lazy-count-format): Use lazy-count-invisible-format and isearch-lazy-count-invisible. (isearch-range-invisible): Handle the value 'can-be-opened' of 'search-invisible' and don't open overlays for it, just check if these overlays can be opened. (isearch-lazy-count-invisible): New variable. (isearch-lazy-highlight-new-loop): Set isearch-lazy-count-invisible to nil. (isearch-lazy-highlight-search): Let-bind search-invisible either to t for non-nil isearch-lazy-count, or to 'can-be-opened'. (isearch-lazy-highlight-match): Don't highlight matches intended to be counted only, not highlighted. (isearch-lazy-highlight-buffer-update): Separately count invisible matches by isearch-lazy-count-invisible. * lisp/info.el (Info-isearch-filter): Check if search-invisible is t. diff --git a/lisp/info.el b/lisp/info.el index 906385fdc7..0d0dda8c06 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -2208,7 +2208,7 @@ and is not in the header line or a tag table." (let ((backward (< found beg-found))) (not (or - (and (not search-invisible) + (and (not (eq search-invisible t)) (if backward (or (text-property-not-all found beg-found 'invisible nil) (text-property-not-all found beg-found 'display nil)) diff --git a/lisp/isearch.el b/lisp/isearch.el index db7b53c014..ad8897dda2 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -466,6 +466,12 @@ and doesn't remove full-buffer highlighting after a search." :group 'lazy-count :version "27.1") +(defvar lazy-count-invisible-format " (invisible %s)" + "Format of the number of invisible matches for the prompt. +When invisible matches exist, their number is appended +after the total number of matches. Display nothing when +this variable is nil.") + ;; Define isearch help map. @@ -1277,6 +1283,7 @@ used to set the value of `isearch-regexp-function'." isearch-lazy-count-current nil isearch-lazy-count-total nil + isearch-lazy-count-invisible nil ;; Save the original value of `minibuffer-message-timeout', and ;; set it to nil so that isearch's messages don't get timed out. @@ -3529,7 +3536,12 @@ isearch-message-suffix prompt. Otherwise, for isearch-message-prefix." (- isearch-lazy-count-total isearch-lazy-count-current -1))) - (or isearch-lazy-count-total "?")) + (if (and isearch-lazy-count-invisible + lazy-count-invisible-format) + (concat (format "%s" (or isearch-lazy-count-total "?")) + (format lazy-count-invisible-format + isearch-lazy-count-invisible)) + (or isearch-lazy-count-total "?"))) ""))) @@ -3780,10 +3792,11 @@ Optional third argument, if t, means if fail just return nil (no error). (save-excursion (goto-char beg) (let (;; can-be-opened keeps track if we can open some overlays. - (can-be-opened (eq search-invisible 'open)) + (can-be-opened (memq search-invisible '(open can-be-opened))) ;; the list of overlays that could be opened (crt-overlays nil)) - (when (and can-be-opened isearch-hide-immediately) + (when (and can-be-opened isearch-hide-immediately + (not (eq search-invisible 'can-be-opened))) (isearch-close-unnecessary-overlays beg end)) ;; If the following character is currently invisible, ;; skip all characters with that same `invisible' property value. @@ -3822,9 +3835,10 @@ Optional third argument, if t, means if fail just return nil (no error). (if (>= (point) end) (if (and can-be-opened (consp crt-overlays)) (progn - (setq isearch-opened-overlays - (append isearch-opened-overlays crt-overlays)) - (mapc 'isearch-open-overlay-temporary crt-overlays) + (unless (eq search-invisible 'can-be-opened) + (setq isearch-opened-overlays + (append isearch-opened-overlays crt-overlays)) + (mapc 'isearch-open-overlay-temporary crt-overlays)) nil) (setq isearch-hidden t))))))) @@ -4008,6 +4022,7 @@ since they have special meaning in a regexp." (defvar isearch-lazy-highlight-error nil) (defvar isearch-lazy-count-current nil) (defvar isearch-lazy-count-total nil) +(defvar isearch-lazy-count-invisible nil) (defvar isearch-lazy-count-hash (make-hash-table)) (defvar lazy-count-update-hook nil "Hook run after new lazy count results are computed.") @@ -4086,7 +4101,8 @@ by other Emacs features." ;; Reset old counter before going to count new numbers (clrhash isearch-lazy-count-hash) (setq isearch-lazy-count-current nil - isearch-lazy-count-total nil) + isearch-lazy-count-total nil + isearch-lazy-count-invisible nil) ;; Delay updating the message if possible, to avoid flicker (when (string-equal isearch-string "") (when (and isearch-mode (null isearch-message-function)) @@ -4166,10 +4182,10 @@ Attempt to do the search exactly the way the pending Isearch would." (isearch-regexp-lax-whitespace isearch-lazy-highlight-regexp-lax-whitespace) (isearch-forward isearch-lazy-highlight-forward) - ;; Don't match invisible text unless it can be opened - ;; or when counting matches and user can visit hidden matches - (search-invisible (or (eq search-invisible 'open) - (and isearch-lazy-count search-invisible))) + ;; Count all invisible matches, but highlight only + ;; matches that can be opened by visiting them later + (search-invisible (or (not (null isearch-lazy-count)) + 'can-be-opened)) (retry t) (success nil)) ;; Use a loop like in `isearch-search'. @@ -4186,15 +4202,20 @@ Attempt to do the search exactly the way the pending Isearch would." (error nil))) (defun isearch-lazy-highlight-match (mb me) - (let ((ov (make-overlay mb me))) - (push ov isearch-lazy-highlight-overlays) - ;; 1000 is higher than ediff's 100+, - ;; but lower than isearch main overlay's 1001 - (overlay-put ov 'priority 1000) - (overlay-put ov 'face 'lazy-highlight) - (unless (or (eq isearch-lazy-highlight 'all-windows) - isearch-lazy-highlight-buffer) - (overlay-put ov 'window (selected-window))))) + (when (or (not isearch-lazy-count) + ;; Recheck the match that possibly was intended + ;; for counting only, but not for highlighting + (let ((search-invisible 'can-be-opened)) + (funcall isearch-filter-predicate mb me))) + (let ((ov (make-overlay mb me))) + (push ov isearch-lazy-highlight-overlays) + ;; 1000 is higher than ediff's 100+, + ;; but lower than isearch main overlay's 1001 + (overlay-put ov 'priority 1000) + (overlay-put ov 'face 'lazy-highlight) + (unless (or (eq isearch-lazy-highlight 'all-windows) + isearch-lazy-highlight-buffer) + (overlay-put ov 'window (selected-window)))))) (defun isearch-lazy-highlight-start () "Start a new lazy-highlight updating loop." @@ -4328,11 +4349,22 @@ Attempt to do the search exactly the way the pending Isearch would." (setq found nil) (forward-char -1))) (when isearch-lazy-count - (setq isearch-lazy-count-total - (1+ (or isearch-lazy-count-total 0))) - (puthash (if isearch-lazy-highlight-forward me mb) - isearch-lazy-count-total - isearch-lazy-count-hash)) + ;; Count as invisible when can't open overlay, + ;; but don't leave search-invisible with the + ;; value `open' since then lazy-highlight + ;; will open all overlays with matches. + (if (not (let ((search-invisible + (if (eq search-invisible 'open) + 'can-be-opened + search-invisible))) + (funcall isearch-filter-predicate mb me))) + (setq isearch-lazy-count-invisible + (1+ (or isearch-lazy-count-invisible 0))) + (setq isearch-lazy-count-total + (1+ (or isearch-lazy-count-total 0))) + (puthash (if isearch-lazy-highlight-forward me mb) + isearch-lazy-count-total + isearch-lazy-count-hash))) ;; Don't highlight the match when this loop is used ;; only to count matches or when matches were already ;; highlighted within the current window boundaries commit ef559dcd2ab3ec6e1f714180cbdf3b4e0965c13d Author: Stefan Kangas Date: Fri Jul 8 19:00:32 2022 +0200 Don't mention moved variable in dired-x manual * doc/misc/dired-x.texi (Technical Details): Remove mention of 'dired-clean-up-buffers-too'; it has been moved to dired.el. diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index e3a2832cb0..0e8f969b29 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi @@ -165,10 +165,8 @@ When @file{dired-x.el} is loaded, some standard Dired functions from Dired}), if it is active. @code{dired-find-buffer-nocreate} and @code{dired-initial-position} respect the value of @code{dired-find-subdir} (@pxref{Miscellaneous Commands}). -@code{dired-clean-up-after-deletion} respects the value of -@code{dired-clean-up-buffers-too}. @code{dired-read-shell-command} uses -@code{dired-guess-shell-command} (@pxref{Shell Command Guessing}) to -offer a smarter default command. +@code{dired-read-shell-command} uses @code{dired-guess-shell-command} +(@pxref{Shell Command Guessing}) to offer a smarter default command. @node Installation @chapter Installation commit fc50847b406481485f87a49aa58bb81ef6893e52 Author: Stefan Kangas Date: Fri Jul 8 18:50:47 2022 +0200 Delete redundant defgroup dired-keys * lisp/dired-x.el (dired-keys): Delete defgroup. (dired-bind-vm): Move to :group dired-x. diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 08daef71c6..796625058b 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -50,11 +50,6 @@ "Extended directory editing (dired-x)." :group 'dired) -(defgroup dired-keys nil - "Dired keys customizations." - :prefix "dired-" - :group 'dired-x) - (defcustom dired-bind-vm nil "Non-nil means \"V\" runs `dired-vm', otherwise \"V\" runs `dired-rmail'. RMAIL files in the old Babyl format (used before Emacs 23.1) @@ -62,7 +57,7 @@ contain \"-*- rmail -*-\" at the top, so `dired-find-file' will run `rmail' on these files. New RMAIL files use the standard mbox format, and so cannot be distinguished in this way." :type 'boolean - :group 'dired-keys) + :group 'dired-x) (defvar dired-bind-jump t) (make-obsolete-variable 'dired-bind-jump "not used." "28.1") commit 99c96f50ed2058bec44612134ccaf9aa51c9730e Author: Stefan Kangas Date: Fri Jul 8 18:31:17 2022 +0200 Move dired-do-relsymlink from dired-x.el to dired.el * lisp/dired-x.el (dired-do-relsymlink, dired-make-relative-symlink) (dired-do-relsymlink-regexp): Move from here... * lisp/dired-aux.el (dired-do-relsymlink, dired-make-relative-symlink) (dired-do-relsymlink-regexp): ...to here. (Bug#21981) * lisp/dired-x.el: Move keybinding and menu binding from here... * lisp/dired.el (dired-mode-map, dired-mode-regexp-menu): ...to here. * lisp/dired-x.el (dired-keep-marker-relsymlink): Move from here... * lisp/dired.el (dired-keep-marker-relsymlink): ...to here. Improve docstring. * doc/misc/dired-x.texi (Miscellaneous Commands): Move documentation of above commands from here... * doc/emacs/dired.texi (Operating on Files) (Transforming File Names): ...to here. diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index c7ef097bfb..69450c82d6 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -844,6 +844,26 @@ This is like @samp{ln -s}. The argument @var{new} is the directory to make the links in, or (if making just one link) the name to give the link. +@findex dired-do-relsymlink +@kindex Y @r{(Dired)} +@item Y @var{new} @key{RET} +Make relative symbolic links to the specified files +(@code{dired-do-relsymlink}). The argument @var{new} is the directory +to make the links in, or (if making just one link) the name to give +the link. This is like @code{dired-do-symlink} but creates relative +symbolic links. For example: + +@example + foo -> ../bar/foo +@end example + +@noindent +It does not create absolute ones like: + +@example + foo -> /path/that/may/change/any/day/bar/foo +@end example + @findex dired-do-chmod @kindex M @r{(Dired)} @cindex changing file permissions (in Dired) @@ -1150,9 +1170,12 @@ Rename each of the selected files to a lower-case name @itemx % S @var{from} @key{RET} @var{to} @key{RET} @kindex % S @r{(Dired)} @findex dired-do-symlink-regexp -These four commands rename, copy, make hard links and make soft links, -in each case computing the new name by regular-expression substitution -from the name of the old file. +@itemx % Y @var{from} @key{RET} @var{to} @key{RET} +@kindex % Y @r{(Dired)} +@findex dired-do-relsymlink-regexp +These five commands rename, copy, make hard links, make soft links, +and make relative soft links, in each case computing the new name by +regular-expression substitution from the name of the old file. @end table The four regular-expression substitution commands effectively diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index 504060f41f..e3a2832cb0 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi @@ -920,33 +920,6 @@ to @kbd{V}. Otherwise, @code{dired-bind-rmail} will be bound. @findex dired-rmail Bound to @kbd{V} if @code{dired-bind-vm} is @code{nil}. Run Rmail on this file (assumed to be mail folder in Rmail format). - -@item dired-do-relsymlink -@cindex relative symbolic links. -@kindex Y -@findex dired-do-relsymlink -Bound to @kbd{Y}. Relative symlink all marked (or next ARG) files into a -directory, or make a relative symbolic link to the current file. This creates -relative symbolic links like - -@example - foo -> ../bar/foo -@end example - -@noindent -not absolute ones like - -@example - foo -> /ugly/path/that/may/change/any/day/bar/foo -@end example - -@item dired-do-relsymlink-regexp -@kindex %Y -@findex dired-do-relsymlink-regexp -Bound to @kbd{%Y}. Relative symlink all marked files containing -@var{regexp} to @var{newname}. See functions -@code{dired-do-rename-regexp} and @code{dired-do-relsymlink} for more -info. @end table @node Bugs diff --git a/etc/NEWS b/etc/NEWS index 1e6fb06bdc..925bd9a212 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1057,6 +1057,14 @@ customize the user option 'dired-clean-up-buffers-too' to nil. The related user option 'dired-clean-confirm-killing-deleted-buffers' (which see) has also been moved to 'dired'. ++++ +*** 'dired-do-relsymlink' moved from dired-x to dired. +The corresponding key "Y" is now bound by default in Dired. + ++++ +*** 'dired-do-relsymlink-regexp' moved from dired-x to dired. +The corresponding key "% Y" is now bound by default in Dired. + +++ *** 'dired-info' and 'dired-man' moved from dired-x to dired. The 'dired-info' and 'dired-man' commands have been moved from the diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 5f2d1cfc9f..b9f33036e3 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -2521,6 +2521,73 @@ Also see `dired-do-revert-buffer'." (dired-do-create-files 'symlink #'make-symbolic-link "Symlink" arg dired-keep-marker-symlink)) +;;;###autoload +(defun dired-do-relsymlink (&optional arg) + "Relative symlink all marked (or next ARG) files into a directory. +Otherwise make a relative symbolic link to the current file. +This creates relative symbolic links like + + foo -> ../bar/foo + +not absolute ones like + + foo -> /ugly/file/name/that/may/change/any/day/bar/foo + +For absolute symlinks, use \\[dired-do-symlink]." + (interactive "P") + (dired-do-create-files 'relsymlink #'dired-make-relative-symlink + "RelSymLink" arg dired-keep-marker-relsymlink)) + +(defun dired-make-relative-symlink (file1 file2 &optional ok-if-already-exists) + "Make a symbolic link (pointing to FILE1) in FILE2. +The link is relative (if possible), for example + + \"/vol/tex/bin/foo\" \"/vol/local/bin/foo\" + +results in + + \"../../tex/bin/foo\" \"/vol/local/bin/foo\"" + (interactive "FRelSymLink: \nFRelSymLink %s: \np") + (let (name1 name2 len1 len2 (index 0) sub) + (setq file1 (expand-file-name file1) + file2 (expand-file-name file2) + len1 (length file1) + len2 (length file2)) + ;; Find common initial file name components: + (let (next) + (while (and (setq next (string-search "/" file1 index)) + (< (setq next (1+ next)) (min len1 len2)) + ;; For the comparison, both substrings must end in + ;; `/', so NEXT is *one plus* the result of the + ;; string-search. + ;; E.g., consider the case of linking "/tmp/a/abc" + ;; to "/tmp/abc" erroneously giving "/tmp/a" instead + ;; of "/tmp/" as common initial component + (string-equal (substring file1 0 next) + (substring file2 0 next))) + (setq index next)) + (setq name2 file2 + sub (substring file1 0 index) + name1 (substring file1 index))) + (if (string-equal sub "/") + ;; No common initial file name found + (setq name1 file1) + ;; Else they have a common parent directory + (let ((tem (substring file2 index)) + (start 0) + (count 0)) + ;; Count number of slashes we must compensate for ... + (while (setq start (string-search "/" tem start)) + (setq count (1+ count) + start (1+ start))) + ;; ... and prepend a "../" for each slash found: + (dotimes (_ count) + (setq name1 (concat "../" name1))))) + (make-symbolic-link + (directory-file-name name1) ; must not link to foo/ + ; (trailing slash!) + name2 ok-if-already-exists))) + ;;;###autoload (defun dired-do-hardlink (&optional arg) "Add names (hard links) current file or all marked (or next ARG) files. @@ -2681,6 +2748,16 @@ See function `dired-do-rename-regexp' for more info." #'make-symbolic-link "SymLink" arg regexp newname whole-name dired-keep-marker-symlink)) +;;;###autoload +(defun dired-do-relsymlink-regexp (regexp newname &optional arg whole-name) + "RelSymlink all marked files containing REGEXP to NEWNAME. +See functions `dired-do-rename-regexp' and `dired-do-relsymlink' +for more info." + (interactive (dired-mark-read-regexp "RelSymLink")) + (dired-do-create-files-regexp + #'dired-make-relative-symlink + "RelSymLink" arg regexp newname whole-name dired-keep-marker-relsymlink)) + ;;; Change case of file names diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 1e1bf9efd6..08daef71c6 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -238,15 +238,11 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used." (define-key dired-mode-map "*O" 'dired-mark-omitted) (define-key dired-mode-map "*." 'dired-mark-extension)) -(when (keymapp (lookup-key dired-mode-map "%")) - (define-key dired-mode-map "%Y" 'dired-do-relsymlink-regexp)) - (define-key dired-mode-map "\C-x\M-o" 'dired-omit-mode) (define-key dired-mode-map "\M-(" 'dired-mark-sexp) (define-key dired-mode-map "\M-!" 'dired-smart-shell-command) (define-key dired-mode-map "\M-G" 'dired-goto-subdir) (define-key dired-mode-map "F" 'dired-do-find-marked-files) -(define-key dired-mode-map "Y" 'dired-do-relsymlink) (define-key dired-mode-map "V" 'dired-do-run-mail) @@ -257,12 +253,6 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used." ["Find Files" dired-do-find-marked-files :help "Find current or marked files"] "Shell Command...") - (easy-menu-add-item menu '("Operate") - ["Relative Symlink to..." dired-do-relsymlink - :visible (fboundp 'make-symbolic-link) - :help "Make relative symbolic links for current or \ -marked files"] - "Hardlink to...") (easy-menu-add-item menu '("Mark") ["Flag Extension..." dired-flag-extension :help "Flag files with a certain extension for deletion"] @@ -276,12 +266,6 @@ marked files"] :help "Mark files matching `dired-omit-files' \ and `dired-omit-extensions'"] "Unmark All") - (easy-menu-add-item menu '("Regexp") - ["Relative Symlink..." dired-do-relsymlink-regexp - :visible (fboundp 'make-symbolic-link) - :help "Make relative symbolic links for files \ -matching regexp"] - "Hardlink...") (easy-menu-add-item menu '("Immediate") ["Omit Mode" dired-omit-mode :style toggle :selected dired-omit-mode @@ -1044,95 +1028,6 @@ See `dired-guess-shell-alist-user'." ;; If we got a return, then return default. (if (equal val "") default val)))) - -;;; Relative symbolic links - -(declare-function make-symbolic-link "fileio.c") - -(defvar dired-keep-marker-relsymlink ?S - "See variable `dired-keep-marker-move'.") - -(defun dired-make-relative-symlink (file1 file2 &optional ok-if-already-exists) - "Make a symbolic link (pointing to FILE1) in FILE2. -The link is relative (if possible), for example - - \"/vol/tex/bin/foo\" \"/vol/local/bin/foo\" - -results in - - \"../../tex/bin/foo\" \"/vol/local/bin/foo\"" - (interactive "FRelSymLink: \nFRelSymLink %s: \np") - (let (name1 name2 len1 len2 (index 0) sub) - (setq file1 (expand-file-name file1) - file2 (expand-file-name file2) - len1 (length file1) - len2 (length file2)) - ;; Find common initial file name components: - (let (next) - (while (and (setq next (string-search "/" file1 index)) - (< (setq next (1+ next)) (min len1 len2)) - ;; For the comparison, both substrings must end in - ;; `/', so NEXT is *one plus* the result of the - ;; string-search. - ;; E.g., consider the case of linking "/tmp/a/abc" - ;; to "/tmp/abc" erroneously giving "/tmp/a" instead - ;; of "/tmp/" as common initial component - (string-equal (substring file1 0 next) - (substring file2 0 next))) - (setq index next)) - (setq name2 file2 - sub (substring file1 0 index) - name1 (substring file1 index))) - (if (string-equal sub "/") - ;; No common initial file name found - (setq name1 file1) - ;; Else they have a common parent directory - (let ((tem (substring file2 index)) - (start 0) - (count 0)) - ;; Count number of slashes we must compensate for ... - (while (setq start (string-search "/" tem start)) - (setq count (1+ count) - start (1+ start))) - ;; ... and prepend a "../" for each slash found: - (dotimes (_ count) - (setq name1 (concat "../" name1))))) - (make-symbolic-link - (directory-file-name name1) ; must not link to foo/ - ; (trailing slash!) - name2 ok-if-already-exists))) - -(autoload 'dired-do-create-files "dired-aux") - -;;;###autoload -(defun dired-do-relsymlink (&optional arg) - "Relative symlink all marked (or next ARG) files into a directory. -Otherwise make a relative symbolic link to the current file. -This creates relative symbolic links like - - foo -> ../bar/foo - -not absolute ones like - - foo -> /ugly/file/name/that/may/change/any/day/bar/foo - -For absolute symlinks, use \\[dired-do-symlink]." - (interactive "P") - (dired-do-create-files 'relsymlink #'dired-make-relative-symlink - "RelSymLink" arg dired-keep-marker-relsymlink)) - -(autoload 'dired-mark-read-regexp "dired-aux") -(autoload 'dired-do-create-files-regexp "dired-aux") - -(defun dired-do-relsymlink-regexp (regexp newname &optional arg whole-name) - "RelSymlink all marked files containing REGEXP to NEWNAME. -See functions `dired-do-rename-regexp' and `dired-do-relsymlink' -for more info." - (interactive (dired-mark-read-regexp "RelSymLink")) - (dired-do-create-files-regexp - #'dired-make-relative-symlink - "RelSymLink" arg regexp newname whole-name dired-keep-marker-relsymlink)) - ;;; Visit all marked files simultaneously diff --git a/lisp/dired.el b/lisp/dired.el index 48dffa0e36..5769b73f63 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -210,6 +210,11 @@ If a character, new links are unconditionally marked with that character." (character :tag "Mark")) :group 'dired-mark) +(defvar dired-keep-marker-relsymlink ?S + "Controls marking of newly made relative symbolic links. +If t, they are marked if and as the files linked to were marked. +If a character, new links are unconditionally marked with that character.") + (defcustom dired-free-space 'first "Whether and how to display the amount of free disk space in Dired buffers. If nil, don't display. @@ -2090,6 +2095,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." "S" #'dired-do-symlink "T" #'dired-do-touch "X" #'dired-do-shell-command + "Y" #'dired-do-relsymlink "Z" #'dired-do-compress "c" #'dired-do-compress-to "!" #'dired-do-shell-command @@ -2119,6 +2125,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." "% H" #'dired-do-hardlink-regexp "% R" #'dired-do-rename-regexp "% S" #'dired-do-symlink-regexp + "% Y" #'dired-do-relsymlink-regexp "% &" #'dired-flag-garbage-files ;; Commands for marking and unmarking. "* *" #'dired-mark-executables @@ -2296,6 +2303,9 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." ["Symlink..." dired-do-symlink-regexp :visible (fboundp 'make-symbolic-link) :help "Make symbolic links for files matching regexp"] + ["Relative Symlink..." dired-do-relsymlink-regexp + :visible (fboundp 'make-symbolic-link) + :help "Make relative symbolic links for files matching regexp"] ["Hardlink..." dired-do-hardlink-regexp :help "Make hard links for files matching regexp"] ["Upcase" dired-upcase @@ -2365,6 +2375,9 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." ["Symlink to..." dired-do-symlink :visible (fboundp 'make-symbolic-link) :help "Make symbolic links for current or marked files"] + ["Relative Symlink to..." dired-do-relsymlink + :visible (fboundp 'make-symbolic-link) + :help "Make relative symbolic links for current or marked files"] ["Hardlink to..." dired-do-hardlink :help "Make hard links for current or marked files"] ["Print..." dired-do-print commit 033d370a5140aaba79cbac37399a387390d4c18e Author: Juri Linkov Date: Fri Jul 8 20:17:29 2022 +0300 * lisp/progmodes/ruby-mode.el (ruby-mode): Set outline-regexp, outline-level. Suggested by Yilkal Argaw . diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index a197724634..87bb92908d 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -2457,6 +2457,13 @@ If there is no Rubocop config file, Rubocop will be passed a flag (setq-local beginning-of-defun-function #'ruby-beginning-of-defun) (setq-local end-of-defun-function #'ruby-end-of-defun) + ;; `outline-regexp' contains the first part of `ruby-indent-beg-re' + (setq-local outline-regexp (concat "^\\s *" + (regexp-opt '("class" "module" "def")) + "\\_>")) + (setq-local outline-level (lambda () (1+ (/ (current-indentation) + ruby-indent-level)))) + (add-hook 'after-save-hook #'ruby-mode-set-encoding nil 'local) (add-hook 'electric-indent-functions #'ruby--electric-indent-p nil 'local) (add-hook 'flymake-diagnostic-functions #'ruby-flymake-auto nil 'local) commit 1c300c983f60a15413cfd0b31abb7d8294a1a5cc Author: Mattias Engdegård Date: Fri Jul 8 18:24:26 2022 +0200 Remove unused member of internal struct * src/fns.c (struct textprop_rec, concat_to_string): Remove `from`. diff --git a/src/fns.c b/src/fns.c index f4ba67b40e..49d76a0e7c 100644 --- a/src/fns.c +++ b/src/fns.c @@ -712,7 +712,6 @@ the same empty object instead of its copy. */) struct textprop_rec { ptrdiff_t argnum; /* refer to ARGS (arguments of `concat') */ - ptrdiff_t from; /* refer to ARGS[argnum] (argument string) */ ptrdiff_t to; /* refer to VAL (the target string) */ }; @@ -843,7 +842,6 @@ concat_to_string (ptrdiff_t nargs, Lisp_Object *args) if (string_intervals (arg)) { textprops[num_textprops].argnum = i; - textprops[num_textprops].from = 0; textprops[num_textprops].to = toindex; num_textprops++; } commit 58790a5266c60a935e6f6f1c3bda7c8fc7b72a6d Author: Stefan Kangas Date: Fri Jul 8 16:13:56 2022 +0200 * lisp/dired.el (dired-jump-map): Bind also "j" to dired-jump. diff --git a/lisp/dired.el b/lisp/dired.el index 3eff218728..48dffa0e36 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -4807,6 +4807,7 @@ Interactively with prefix argument, read FILE-NAME." (defvar-keymap dired-jump-map :doc "Keymap to repeat `dired-jump'. Used in `repeat-mode'." + "j" #'dired-jump "C-j" #'dired-jump) (put 'dired-jump 'repeat-map 'dired-jump-map) commit 9e0f52b7d941d55b658d39d452d84652026bdb84 Author: Po Lu Date: Fri Jul 8 21:16:15 2022 +0800 Ensure correct position is returned after child frame movement * src/xterm.c (x_set_offset): Synchronize child frame movement correctly. diff --git a/src/xterm.c b/src/xterm.c index 9651c4e119..23a784ade8 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -24067,6 +24067,11 @@ x_set_offset (struct frame *f, int xoff, int yoff, int change_gravity) && FRAME_X_OUTPUT (f)->move_offset_top == 0)))) x_check_expected_move (f, modified_left, modified_top); } + /* Instead, just wait for the last ConfigureWindow request to + complete. No window manager is involved when moving child + frames. */ + else + XSync (FRAME_X_DISPLAY (f), False); unblock_input (); } @@ -24769,7 +24774,6 @@ x_sync_with_move (struct frame *f, int left, int top, bool fuzzy) wait_reading_process_output (0, 500000000, 0, false, Qnil, NULL, 0); } - /* Wait for an event on frame F matching EVENTTYPE. */ void x_wait_for_event (struct frame *f, int eventtype) commit 6791165b2a0e707f719efec08aad62cdf6ed8ad3 Author: Mattias Engdegård Date: Fri Jul 8 15:09:16 2022 +0200 Fix file-name-case-insensitive-p in ffap (bug#56443) Don't crash if the file name argument to file-name-case-insensitive-p, after expansion, doesn't have a parent directory. This occurs when calling ffap on something that looks like an email address. * src/fileio.c (Ffile_name_case_insensitive_p): Return nil if no file or parent directory could be found. * test/src/fileio-tests.el (fileio-tests--identity-expand-handler) (fileio--file-name-case-insensitive-p): New test. diff --git a/src/fileio.c b/src/fileio.c index d07e62a121..9697f6c8cf 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -2601,9 +2601,9 @@ is case-insensitive. */) if (err <= 0) return err < 0 ? Qt : Qnil; Lisp_Object parent = file_name_directory (filename); - /* Avoid infinite loop if the root has trouble - (impossible?). */ - if (!NILP (Fstring_equal (parent, filename))) + /* Avoid infinite loop if the root has trouble (if that's even possible). + Without a parent, we just don't know and return nil as well. */ + if (!STRINGP (parent) || !NILP (Fstring_equal (parent, filename))) return Qnil; filename = parent; } diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el index c137ce06f1..08582c8a86 100644 --- a/test/src/fileio-tests.el +++ b/test/src/fileio-tests.el @@ -201,4 +201,20 @@ Also check that an encoding error can appear in a symlink." (insert-file-contents "/dev/urandom" nil nil 10) (should (= (buffer-size) 10)))) +(defun fileio-tests--identity-expand-handler (_ file &rest _) + file) +(put 'fileio-tests--identity-expand-handler 'operations '(expand-file-name)) + +(ert-deftest fileio--file-name-case-insensitive-p () + ;; Check that we at least don't crash if given nonexisting files + ;; without a directory (bug#56443). + + ;; Use an identity file-name handler, as if called by `ffap'. + (let* ((file-name-handler-alist + '(("^mailto:" . fileio-tests--identity-expand-handler))) + (file "mailto:snowball@hell.com")) + ;; Check that `expand-file-name' is identity for this name. + (should (equal (expand-file-name file nil) file)) + (file-name-case-insensitive-p file))) + ;;; fileio-tests.el ends here commit 739e3dbe050468e1d9aa0a48bfc656ae20fd8f9d Author: Stefan Kangas Date: Fri Dec 3 23:17:04 2021 +0100 Remove many items obsolete since 24.1 * lisp/allout.el (allout-abbreviate-flattened-numbering) (allout-mode-deactivate-hook): * lisp/ansi-color.el (ansi-color-unfontify-region): * lisp/auth-source.el (auth-source-hide-passwords) (auth-source-user-or-password) (auth-source-forget-user-or-password): * lisp/cedet/data-debug.el (data-debug-map): * lisp/cedet/semantic/grammar.el (semantic-grammar-syntax-table) (semantic-grammar-map): * lisp/chistory.el (command-history-map): * lisp/comint.el (comint-dynamic-complete) (comint-dynamic-complete-as-filename) (comint-dynamic-simple-complete): * lisp/dired-x.el (read-filename-at-point) (dired-x-submit-report): * lisp/dos-fns.el (register-name-alist, make-register) (register-value, set-register-value, intdos, mode25, mode4350): * lisp/emacs-lisp/bytecomp.el (byte-compile-disable-print-circle): * lisp/emacs-lisp/chart.el (chart-map): * lisp/emacs-lisp/package.el (package-menu-view-commentary): * lisp/emacs-lock.el (toggle-emacs-lock, emacs-lock-from-exiting): * lisp/erc/erc.el (erc-complete-word): * lisp/eshell/em-cmpl.el (eshell-cmpl-suffix-list): * lisp/eshell/esh-util.el (eshell-for): * lisp/files.el (inhibit-first-line-modes-regexps) (inhibit-first-line-modes-suffixes): * lisp/gnus/gnus-msg.el (gnus-outgoing-message-group) (gnus-debug-files, gnus-debug-exclude-variables): * lisp/gnus/gnus-registry.el (gnus-registry-user-format-function-M): * lisp/gnus/gnus.el (gnus-local-domain, gnus-carpal): * lisp/gnus/nnimap.el (nnimap-split-rule): * lisp/iimage.el (turn-on-iimage-mode): * lisp/image.el (image-extension-data, image-library-alist): * lisp/mail/emacsbug.el (report-emacs-bug-pretest-address): * lisp/mail/mail-utils.el (rmail-dont-reply-to): * lisp/mail/mailalias.el (mail-complete-function) (mail-completion-at-point-function): * lisp/mail/rmail.el (rmail-dont-reply-to-names) (rmail-default-dont-reply-to-names): * lisp/mail/sendmail.el (mail-mailer-swallows-blank-line) (mail-sent-via): * lisp/menu-bar.el (menu-bar-kill-ring-save): * lisp/minibuffer.el (completion-annotate-function) (minibuffer-local-filename-must-match-map): * lisp/msb.el (msb-after-load-hooks): * lisp/obsolete/eieio-compat.el (eieio-defmethod) (eieio-defgeneric): * lisp/obsolete/info-edit.el (Info-edit-map): * lisp/obsolete/starttls.el (starttls-any-program-available): * lisp/progmodes/cfengine.el (cfengine-mode-abbrevs): * lisp/progmodes/cwarn.el (turn-on-cwarn-mode): * lisp/progmodes/make-mode.el (makefile-complete): * lisp/progmodes/meta-mode.el (meta-complete-symbol) (meta-mode-map): * lisp/progmodes/pascal.el (pascal-toggle-completions) (pascal-last-completions, pascal-show-completions): * lisp/progmodes/prolog.el (prolog-char-quote-workaround): * lisp/progmodes/which-func.el (which-func-mode): [FUNCTION] * lisp/simple.el (count-lines-region, minibuffer-completing-symbol): * lisp/speedbar.el (speedbar-syntax-table, speedbar-key-map): * lisp/strokes.el (strokes-report-bug): * lisp/subr.el (condition-case-no-debug): * lisp/term/ns-win.el (ns-alternatives-map) (ns-store-cut-buffer-internal): * lisp/term/w32-win.el (w32-default-color-map): * lisp/term/x-win.el (x-cut-buffer-or-selection-value): * lisp/textmodes/bibtex.el (bibtex-complete) (bibtex-entry-field-alist): * lisp/textmodes/reftex-index.el (reftex-index-map) (reftex-index-phrases-map): * lisp/textmodes/reftex-sel.el (reftex-select-label-map) (reftex-select-bib-map): * lisp/textmodes/reftex-toc.el (reftex-toc-map): * lisp/textmodes/rst.el (rst-block-face, rst-external-face) (rst-definition-face, rst-directive-face, rst-comment-face) (rst-emphasis1-face, rst-emphasis2-face, rst-literal-face) (rst-reference-face): * lisp/vc/vc-hooks.el (vc-toggle-read-only): * lisp/view.el (view-return-to-alist) (view-return-to-alist-update): Remove many functions and variables obsolete since 24.1. * lisp/textmodes/bibtex.el (bibtex-entry-alist): Don't use above removed variable 'bibtex-entry-field-alist'. * lisp/cedet/data-debug.el (data-debug-edebug-expr) (data-debug-eval-expression): * lisp/emacs-lisp/trace.el (trace--read-args): * lisp/files-x.el (read-file-local-variable-value): * lisp/simple.el (read--expression): Don't use above removed variable 'minibuffer-completing-symbol'. * lisp/textmodes/rst.el (rst-font-lock-keywords): Don't use above removed variables. * src/w32fns.c (Fw32_default_color_map): Delete obsolete function. (syms_of_w32fns): Delete defsubr for above defun. * src/keyboard.c (syms_of_keyboard) : Delete DEFVARs. : Delete DEFSYM. (syms_of_keyboard_for_pdumper): Adjust for above change. (command_loop_1): Don't run deferred-action-function hook. * lisp/subr.el (deferred-action-list, deferred-action-function): Delete obsoletion statements. * lisp/emacs-lisp/ert-x.el (ert-simulate-command): Don't run 'deferred-action-list' hook. * doc/lispref/hooks.texi (Standard Hooks): Delete 'deferred-action-function'. * lisp/emacs-lisp/lisp.el (field-complete): * lisp/eshell/em-cmpl.el (eshell-cmpl-initialize): * lisp/gnus/gnus-msg.el (gnus-inews-insert-gcc): * lisp/gnus/nnmail.el (nnmail-fancy-expiry-target): * lisp/mail/mail-utils.el (mail-dont-reply-to): * lisp/mail/sendmail.el (sendmail-send-it): * lisp/mail/smtpmail.el (smtpmail-send-it): * lisp/minibuffer.el (minibuffer-completion-help): * lisp/progmodes/python.el: Don't use above removed items. * lisp/emacs-lisp/eieio-core.el: * lisp/mail/mailalias.el (mail-complete-alist): Doc fixes; don't refer to above removed items. ; * etc/NEWS: List removed items. diff --git a/doc/lispref/hooks.texi b/doc/lispref/hooks.texi index 107d036202..59b7930732 100644 --- a/doc/lispref/hooks.texi +++ b/doc/lispref/hooks.texi @@ -290,7 +290,6 @@ auto-fill-function command-error-function compose-chars-after-function composition-function-table -deferred-action-function input-method-function load-read-function load-source-file-function diff --git a/etc/NEWS b/etc/NEWS index 226af8d7d6..1e6fb06bdc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2247,6 +2247,53 @@ Use 'exif-parse-file' and 'exif-field' instead. ** 'insert-directory' alternatives should not change the free disk space line. This change is now applied in 'dired-insert-directory'. +--- +** Some functions and variables obsolete since Emacs 24 have been removed: +'Info-edit-map', 'allout-abbreviate-flattened-numbering', +'allout-mode-deactivate-hook', 'ansi-color-unfontify-region', +'auth-source-forget-user-or-password', 'auth-source-hide-passwords', +'auth-source-user-or-password', 'bibtex-complete', +'bibtex-entry-field-alist', 'byte-compile-disable-print-circle', +'cfengine-mode-abbrevs', 'chart-map', 'comint-dynamic-complete', +'comint-dynamic-complete-as-filename', +'comint-dynamic-simple-complete', 'command-history-map', +'completion-annotate-function', 'condition-case-no-debug', +'count-lines-region', 'data-debug-map', 'deferred-action-list', +'deferred-action-function', 'dired-x-submit-report', +'eieio-defgeneric', 'eieio-defmethod', 'emacs-lock-from-exiting', +'erc-complete-word', 'eshell-cmpl-suffix-list', 'eshell-for', +'gnus-carpal', 'gnus-debug-exclude-variables', 'gnus-debug-files', +'gnus-local-domain', 'gnus-outgoing-message-group', +'gnus-registry-user-format-function-M', 'image-extension-data', +'image-library-alist', 'inhibit-first-line-modes-regexps', +'inhibit-first-line-modes-suffixes', 'intdos', +'mail-complete-function', 'mail-completion-at-point-function', +'mail-mailer-swallows-blank-line', 'mail-sent-via', 'make-register', +'makefile-complete', 'menu-bar-kill-ring-save', +'meta-complete-symbol', 'meta-mode-map', +'minibuffer-completing-symbol', +'minibuffer-local-filename-must-match-map', 'mode25', 'mode4350', +'msb-after-load-hooks', 'nnimap-split-rule', 'ns-alternatives-map', +'ns-store-cut-buffer-internal', 'package-menu-view-commentary', +'pascal-last-completions', 'pascal-show-completions', +'pascal-toggle-completions', 'prolog-char-quote-workaround', +'read-filename-at-point', 'reftex-index-map', +'reftex-index-phrases-map', 'reftex-select-bib-map', +'reftex-select-label-map', 'reftex-toc-map', 'register-name-alist', +'register-value', 'report-emacs-bug-pretest-address', +'rmail-default-dont-reply-to-names', 'rmail-dont-reply-to', +'rmail-dont-reply-to-names', 'rst-block-face', 'rst-comment-face', +'rst-definition-face', 'rst-directive-face', 'rst-emphasis1-face', +'rst-emphasis2-face', 'rst-external-face', 'rst-literal-face', +'rst-reference-face', 'semantic-grammar-map', +'semantic-grammar-syntax-table', 'set-register-value', +'speedbar-key-map', 'speedbar-syntax-table', +'starttls-any-program-available', 'strokes-report-bug', +'toggle-emacs-lock', 'turn-on-cwarn-mode', 'turn-on-iimage-mode', +'vc-toggle-read-only', 'view-return-to-alist', +'view-return-to-alist-update', 'w32-default-color-map' (function), +'which-func-mode' (function), 'x-cut-buffer-or-selection-value'. + --- ** Some functions and variables obsolete since Emacs 23 have been removed: 'find-emacs-lisp-shadows', 'newsticker-cache-filename', diff --git a/lisp/allout.el b/lisp/allout.el index de8ee85b39..e07bac4ef9 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -733,8 +733,6 @@ Set this var to the bullet you want to use for file cross-references." (put 'allout-presentation-padding 'safe-local-variable #'integerp) ;;;_ = allout-flattened-numbering-abbreviation -(define-obsolete-variable-alias 'allout-abbreviate-flattened-numbering - 'allout-flattened-numbering-abbreviation "24.1") (defcustom allout-flattened-numbering-abbreviation nil "If non-nil, `allout-flatten-exposed-to-buffer' abbreviates topic numbers to minimal amount with some context. Otherwise, entire @@ -1350,11 +1348,6 @@ their settings before `allout-mode' was started." ;;;_ = allout-mode-hook (defvar allout-mode-hook nil "Hook run when allout mode starts.") -;;;_ = allout-mode-deactivate-hook -(define-obsolete-variable-alias 'allout-mode-deactivate-hook - 'allout-mode-off-hook "24.1") -(defvar allout-mode-deactivate-hook nil - "Hook run when allout mode ends.") ;;;_ = allout-exposure-category (defvar allout-exposure-category nil "Symbol for use as allout invisible-text overlay category.") @@ -1779,7 +1772,6 @@ hooks, by which independent code can cooperate with allout without changes to the allout core. Here are key ones: `allout-mode-hook' -`allout-mode-deactivate-hook' (deprecated) `allout-mode-off-hook' `allout-exposure-change-functions' `allout-structure-added-functions' diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index d5db9ecfed..6f1c270c23 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -456,9 +456,6 @@ variable, and is meant to be used in `compilation-filter-hook'." (_ (ansi-color-apply-on-region compilation-filter-start (point)))))) -(define-obsolete-function-alias 'ansi-color-unfontify-region - 'font-lock-default-unfontify-region "24.1") - ;; Working with strings (defvar-local ansi-color-context nil "Context saved between two calls to `ansi-color-apply'. diff --git a/lisp/auth-source.el b/lisp/auth-source.el index fc62e36dfc..12da2c3d73 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -164,8 +164,6 @@ Overrides `password-cache-expiry' through a let-binding." (defvar auth-source-creation-prompts nil "Default prompts for token values. Usually let-bound.") -(make-obsolete 'auth-source-hide-passwords nil "24.1") - (defcustom auth-source-save-behavior 'ask "If set, auth-source will respect it for save behavior." :version "23.2" ;; No Gnus @@ -2325,89 +2323,6 @@ See `auth-source-search' for details on SPEC." (push item all))) (nreverse all))) -;;; older API - -;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz") - -;; deprecate the old interface -(make-obsolete 'auth-source-user-or-password - 'auth-source-search "24.1") -(make-obsolete 'auth-source-forget-user-or-password - 'auth-source-forget "24.1") - -(defun auth-source-user-or-password - (mode host port &optional username create-missing delete-existing) - "Find MODE (string or list of strings) matching HOST and PORT. - -DEPRECATED in favor of `auth-source-search'! - -USERNAME is optional and will be used as \"login\" in a search -across the Secret Service API (see secrets.el) if the resulting -items don't have a username. This means that if you search for -username \"joe\" and it matches an item but the item doesn't have -a :user attribute, the username \"joe\" will be returned. - -A non-nil DELETE-EXISTING means deleting any matching password -entry in the respective sources. This is useful only when -CREATE-MISSING is non-nil as well; the intended use case is to -remove wrong password entries. - -If no matching entry is found, and CREATE-MISSING is non-nil, -the password will be retrieved interactively, and it will be -stored in the password database which matches best (see -`auth-sources'). - -MODE can be \"login\" or \"password\"." - (auth-source-do-debug - "auth-source-user-or-password: DEPRECATED get %s for %s (%s) + user=%s" - mode host port username) - - (let* ((listy (listp mode)) - (mode (if listy mode (list mode))) - ;; (cname (if username - ;; (format "%s %s:%s %s" mode host port username) - ;; (format "%s %s:%s" mode host port))) - (search (list :host host :port port)) - (search (if username (append search (list :user username)) search)) - (search (if create-missing - (append search (list :create t)) - search)) - (search (if delete-existing - (append search (list :delete t)) - search)) - ;; (found (if (not delete-existing) - ;; (gethash cname auth-source-cache) - ;; (remhash cname auth-source-cache) - ;; nil))) - (found nil)) - (if found - (progn - (auth-source-do-debug - "auth-source-user-or-password: DEPRECATED cached %s=%s for %s (%s) + %s" - mode - ;; don't show the password - (if (and (member "password" mode) t) - "SECRET" - found) - host port username) - found) ; return the found data - ;; else, if not found, search with a max of 1 - (let ((choice (nth 0 (apply #'auth-source-search - (append '(:max 1) search))))) - (when choice - (dolist (m mode) - (cond - ((equal "password" m) - (push (if (plist-get choice :secret) - (funcall (plist-get choice :secret)) - nil) found)) - ((equal "login" m) - (push (plist-get choice :user) found))))) - (setq found (nreverse found)) - (setq found (if listy found (car-safe found))))) - - found)) - (defun auth-source-user-and-password (host &optional user) (let* ((auth-info (car (if user diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el index 0edc853edd..e7635c0aec 100644 --- a/lisp/cedet/data-debug.el +++ b/lisp/cedet/data-debug.el @@ -854,7 +854,6 @@ If PARENT is non-nil, it is somehow related as a parent to thing." table) "Syntax table used in data-debug macro buffers.") -(define-obsolete-variable-alias 'data-debug-map 'data-debug-mode-map "24.1") (defvar data-debug-mode-map (let ((km (make-sparse-keymap))) (suppress-keymap km) @@ -1028,11 +1027,9 @@ Do nothing if already contracted." (defun data-debug-edebug-expr (expr) "Dump out the contents of some expression EXPR in edebug with ddebug." (interactive - (list (let ((minibuffer-completing-symbol t)) - (read-from-minibuffer "Eval: " - nil read-expression-map t - 'read-expression-history)) - )) + (list (read-from-minibuffer "Eval: " + nil read-expression-map t + 'read-expression-history))) (let ((v (eval expr t))) (if (not v) (message "Expression %s is nil." expr) @@ -1043,10 +1040,9 @@ Do nothing if already contracted." If the result is something simple, show it in the echo area. If the result is a list or vector, then use the data debugger to display it." (interactive - (list (let ((minibuffer-completing-symbol t)) - (read-from-minibuffer "Eval: " - nil read-expression-map t - 'read-expression-history)))) + (list (read-from-minibuffer "Eval: " + nil read-expression-map t + 'read-expression-history))) (let (result) (if (null eval-expression-debug-on-error) diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index 74d4a229fa..97456265ea 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -1123,8 +1123,6 @@ END is the limit of the search." ;;;; Define major mode ;;;; -(define-obsolete-variable-alias 'semantic-grammar-syntax-table - 'semantic-grammar-mode-syntax-table "24.1") (defvar semantic-grammar-mode-syntax-table (let ((table (make-syntax-table (standard-syntax-table)))) (modify-syntax-entry ?\: "." table) ;; COLON @@ -1197,8 +1195,6 @@ END is the limit of the search." semantic-grammar-mode-keywords-1 "Font Lock keywords used to highlight Semantic grammar buffers.") -(define-obsolete-variable-alias 'semantic-grammar-map - 'semantic-grammar-mode-map "24.1") (defvar semantic-grammar-mode-map (let ((km (make-sparse-keymap))) diff --git a/lisp/chistory.el b/lisp/chistory.el index 33b2142211..9dce60a19f 100644 --- a/lisp/chistory.el +++ b/lisp/chistory.el @@ -119,8 +119,6 @@ The buffer is left in Command History mode." (error "No command history") (command-history-mode))))) -(define-obsolete-variable-alias 'command-history-map - 'command-history-mode-map "24.1") (defvar command-history-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map (make-composed-keymap lisp-mode-shared-map diff --git a/lisp/comint.el b/lisp/comint.el index 7e22aa78fc..d52623c00a 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -3299,10 +3299,6 @@ Magic characters are those in `comint-file-name-quote-list'." (defun comint-completion-at-point () (run-hook-with-args-until-success 'comint-dynamic-complete-functions)) -(define-obsolete-function-alias - 'comint-dynamic-complete - 'completion-at-point "24.1") - (defun comint-dynamic-complete-filename () "Dynamically complete the filename at point. Completes if after a filename. @@ -3383,13 +3379,6 @@ See `completion-table-with-quoting' and `comint-unquote-function'.") (goto-char (match-end 0)) (insert filesuffix))))))))) -(defun comint-dynamic-complete-as-filename () - "Dynamically complete at point as a filename. -See `comint-dynamic-complete-filename'. Returns t if successful." - (declare (obsolete comint-filename-completion "24.1")) - (let ((data (comint--complete-file-name-data))) - (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)))) - (defun comint-replace-by-expanded-filename () "Dynamically expand and complete the filename at point. Replace the filename with an expanded, canonicalized and @@ -3404,65 +3393,6 @@ filename absolute. For expansion see `expand-file-name' and (replace-match (expand-file-name filename) t t) (comint-dynamic-complete-filename)))) - -(defun comint-dynamic-simple-complete (stub candidates) - "Dynamically complete STUB from CANDIDATES list. -This function inserts completion characters at point by -completing STUB from the strings in CANDIDATES. If completion is -ambiguous, possibly show a completions listing in a separate -buffer. - -Return nil if no completion was inserted. -Return `sole' if completed with the only completion match. -Return `shortest' if completed with the shortest match. -Return `partial' if completed as far as possible. -Return `listed' if a completion listing was shown. - -See also `comint-dynamic-complete-filename'." - (declare (obsolete completion-in-region "24.1")) - (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt cygwin))) - (minibuffer-p (window-minibuffer-p)) - (suffix (cond ((not comint-completion-addsuffix) "") - ((not (consp comint-completion-addsuffix)) " ") - (t (cdr comint-completion-addsuffix)))) - (completions (all-completions stub candidates))) - (cond ((null completions) - (if minibuffer-p - (minibuffer-message "No completions of %s" stub) - (message "No completions of %s" stub)) - nil) - ((= 1 (length completions)) ; Gotcha! - (let ((completion (car completions))) - (if (string-equal completion stub) - (unless minibuffer-p - (message "Sole completion")) - (insert (substring completion (length stub))) - (unless minibuffer-p - (message "Completed"))) - (insert suffix) - 'sole)) - (t ; There's no unique completion. - (let ((completion (try-completion stub candidates))) - ;; Insert the longest substring. - (insert (substring completion (length stub))) - (cond ((and comint-completion-recexact comint-completion-addsuffix - (string-equal stub completion) - (member completion completions)) - ;; It's not unique, but user wants shortest match. - (insert suffix) - (unless minibuffer-p - (message "Completed shortest")) - 'shortest) - ((or comint-completion-autolist - (string-equal stub completion)) - ;; It's not unique, list possible completions. - (comint-dynamic-list-completions completions stub) - 'listed) - (t - (unless minibuffer-p - (message "Partially completed")) - 'partial))))))) - (defun comint-dynamic-list-filename-completions () "Display a list of possible completions for the filename at point." (interactive) diff --git a/lisp/dired-x.el b/lisp/dired-x.el index db5a93b60c..1e1bf9efd6 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -1531,13 +1531,6 @@ If `current-prefix-arg' is non-nil, uses name at point as guess." nil (file-name-nondirectory guess))) (read-file-name prompt default-directory))) -(define-obsolete-function-alias 'read-filename-at-point - 'dired-x-read-filename-at-point "24.1") ; is this even needed? - - -;;; Epilog - -(define-obsolete-function-alias 'dired-x-submit-report 'report-emacs-bug "24.1") (define-obsolete-function-alias 'dired-man #'dired-do-man "29.1") (define-obsolete-function-alias 'dired-info #'dired-do-info "29.1") diff --git a/lisp/dos-fns.el b/lisp/dos-fns.el index ea54eea603..edbe9e494f 100644 --- a/lisp/dos-fns.el +++ b/lisp/dos-fns.el @@ -231,9 +231,6 @@ returned unaltered." (add-hook 'before-init-hook 'dos-reevaluate-defcustoms) -(define-obsolete-variable-alias - 'register-name-alist 'dos-register-name-alist "24.1") - (defvar dos-register-name-alist '((ax . 0) (bx . 1) (cx . 2) (dx . 3) (si . 4) (di . 5) (cflag . 6) (flags . 7) @@ -243,8 +240,6 @@ returned unaltered." (defun dos-make-register () (make-vector 8 0)) -(define-obsolete-function-alias 'make-register 'dos-make-register "24.1") - (defun dos-register-value (regs name) (let ((where (cdr (assoc name dos-register-name-alist)))) (cond ((consp where) @@ -256,8 +251,6 @@ returned unaltered." (aref regs where)) (t nil)))) -(define-obsolete-function-alias 'register-value 'dos-register-value "24.1") - (defun dos-set-register-value (regs name value) (and (numberp value) (>= value 0) @@ -274,9 +267,6 @@ returned unaltered." (aset regs where (logand value 65535)))))) regs) -(define-obsolete-function-alias - 'set-register-value 'dos-set-register-value "24.1") - (defsubst dos-intdos (regs) "Issue the DOS Int 21h with registers REGS. @@ -284,8 +274,6 @@ REGS should be a vector produced by `dos-make-register' and `dos-set-register-value', which see." (int86 33 regs)) -(define-obsolete-function-alias 'intdos 'dos-intdos "24.1") - ;; Backward compatibility for obsolescent functions which ;; set screen size. @@ -294,8 +282,6 @@ and `dos-set-register-value', which see." (interactive) (set-frame-size (selected-frame) 80 25)) -(define-obsolete-function-alias 'mode25 'dos-mode25 "24.1") - (defun dos-mode4350 () "Change the number of rows to 43 or 50. Emacs always tries to set the screen height to 50 rows first. @@ -307,8 +293,6 @@ that your video hardware might not support 50-line mode." nil ; the original built-in function returned nil (set-frame-size (selected-frame) 80 43))) -(define-obsolete-function-alias 'mode4350 'dos-mode4350 "24.1") - (provide 'dos-fns) ;;; dos-fns.el ends here diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 5ef517d7e3..8df4133b6b 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -244,11 +244,6 @@ the functions you loaded will not be able to run.") (make-obsolete-variable 'byte-compile-dynamic "not worthwhile any more." "27.1") ;;;###autoload(put 'byte-compile-dynamic 'safe-local-variable 'booleanp) -(defvar byte-compile-disable-print-circle nil - "If non-nil, disable `print-circle' on printing a byte-compiled code.") -(make-obsolete-variable 'byte-compile-disable-print-circle nil "24.1") -;;;###autoload(put 'byte-compile-disable-print-circle 'safe-local-variable 'booleanp) - (defcustom byte-compile-dynamic-docstrings t "If non-nil, compile doc strings for lazy access. We bury the doc strings of functions and variables inside comments in @@ -2423,8 +2418,7 @@ Call from the source buffer." (print-level nil) (print-quoted t) (print-gensym t) - (print-circle ; Handle circular data structures. - (not byte-compile-disable-print-circle))) + (print-circle t)) ; Handle circular data structures. (if (and (memq (car-safe form) '(defvar defvaralias defconst autoload custom-declare-variable)) (stringp (nth 3 form))) @@ -2482,8 +2476,7 @@ list that represents a doc string reference. (print-level nil) (print-quoted t) (print-gensym t) - (print-circle ; Handle circular data structures. - (not byte-compile-disable-print-circle))) + (print-circle t)) ; Handle circular data structures. (if preface (progn ;; FIXME: We don't handle uninterned names correctly. diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el index 29fbcce773..716b236d3a 100644 --- a/lisp/emacs-lisp/chart.el +++ b/lisp/emacs-lisp/chart.el @@ -63,7 +63,6 @@ (eval-when-compile (require 'cl-generic)) ;;; Code: -(define-obsolete-variable-alias 'chart-map 'chart-mode-map "24.1") (defvar chart-mode-map (make-sparse-keymap) "Keymap used in chart mode.") (defvar-local chart-local-object nil diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index d9864e6965..25f2dd4098 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -24,8 +24,8 @@ ;;; Commentary: ;; ;; The "core" part of EIEIO is the implementation for the object -;; system (such as eieio-defclass, or eieio-defmethod) but not the -;; base classes for the object system, which are defined in EIEIO. +;; system (such as eieio-defclass-internal, or cl-defmethod) but not +;; the base classes for the object system, which are defined in EIEIO. ;; ;; See the commentary for eieio.el for more about EIEIO itself. diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index de18adff5b..ae72a47c2f 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -158,9 +158,6 @@ test for `called-interactively' in the command will fail." (run-hooks 'pre-command-hook) (setq return-value (apply (car command) (cdr command))) (run-hooks 'post-command-hook) - (and (boundp 'deferred-action-list) - deferred-action-list - (run-hooks 'deferred-action-function)) (setq real-last-command (car command) last-command this-command) (when (boundp 'last-repeatable-command) diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 641ce0d5c0..4b85414943 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -943,14 +943,7 @@ character." (defun field-complete (table &optional predicate) (declare (obsolete completion-in-region "24.4")) (let ((minibuffer-completion-table table) - (minibuffer-completion-predicate predicate) - ;; This made sense for lisp-complete-symbol, but for - ;; field-complete, this is out of place. --Stef - ;; (completion-annotate-function - ;; (unless (eq predicate 'fboundp) - ;; (lambda (str) - ;; (if (fboundp (intern-soft str)) " ")))) - ) + (minibuffer-completion-predicate predicate)) (call-interactively 'minibuffer-complete))) (defun lisp-complete-symbol (&optional _predicate) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index c8b6667597..8d0d5d57a2 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -3520,9 +3520,6 @@ The full list of keys can be viewed with \\[describe-mode]." (message (mapconcat #'package--prettify-quick-help-key package--quick-help-keys "\n"))) -(define-obsolete-function-alias - 'package-menu-view-commentary 'package-menu-describe-package "24.1") - (defun package-menu-get-status () "Return status text of package at point in Package Menu." (package--ensure-package-menu-mode) diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el index 7377ac9403..c2f6c16226 100644 --- a/lisp/emacs-lisp/trace.el +++ b/lisp/emacs-lisp/trace.el @@ -275,10 +275,9 @@ If `current-prefix-arg' is non-nil, also read a buffer and a \"context\" (list (read-buffer "Output to buffer" trace-buffer) (let ((exp - (let ((minibuffer-completing-symbol t)) - (read-from-minibuffer "Context expression: " - nil read-expression-map t - 'read-expression-history)))) + (read-from-minibuffer "Context expression: " + nil read-expression-map t + 'read-expression-history))) (lambda () (let ((print-circle t) (print-escape-newlines t)) diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el index 3d2eda99a9..1818e22a92 100644 --- a/lisp/emacs-lock.el +++ b/lisp/emacs-lock.el @@ -88,9 +88,6 @@ The functions get one argument, the first locked buffer found." :group 'emacs-lock :version "24.3") -(define-obsolete-variable-alias 'emacs-lock-from-exiting - 'emacs-lock-mode "24.1") - (defvar-local emacs-lock-mode nil "If non-nil, the current buffer is locked. It can be one of the following values: @@ -247,14 +244,6 @@ some major modes from being locked under some circumstances." ;; continue standard unloading nil)) -;;; Compatibility - -(defun toggle-emacs-lock () - "Toggle `emacs-lock-from-exiting' for the current buffer." - (declare (obsolete emacs-lock-mode "24.1")) - (interactive) - (call-interactively 'emacs-lock-mode)) - (provide 'emacs-lock) ;;; emacs-lock.el ends here diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 239d8ebdcb..0a16831fba 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -4566,8 +4566,6 @@ This places `point' just after the prompt, or at the beginning of the line." (defun erc-complete-word-at-point () (run-hook-with-args-until-success 'erc-complete-functions)) -(define-obsolete-function-alias 'erc-complete-word #'completion-at-point "24.1") - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; IRC SERVER INPUT HANDLING diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index f4c1302629..822cc94149 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el @@ -158,14 +158,6 @@ to writing a completion function." (eshell-cmpl--custom-variable-docstring 'pcomplete-autolist) :type (get 'pcomplete-autolist 'custom-type)) -(defcustom eshell-cmpl-suffix-list (list ?/ ?:) - (eshell-cmpl--custom-variable-docstring 'pcomplete-suffix-list) - :type (get 'pcomplete-suffix-list 'custom-type) - :group 'pcomplete) -;; Only labeled obsolete in 26.1, but all it does it set -;; pcomplete-suffix-list, which is itself obsolete since 24.1. -(make-obsolete-variable 'eshell-cmpl-suffix-list nil "24.1") - (defcustom eshell-cmpl-recexact nil (eshell-cmpl--custom-variable-docstring 'pcomplete-recexact) :type (get 'pcomplete-recexact 'custom-type)) @@ -262,9 +254,6 @@ to writing a completion function." eshell-cmpl-ignore-case) (setq-local pcomplete-autolist eshell-cmpl-autolist) - (if (boundp 'pcomplete-suffix-list) - (setq-local pcomplete-suffix-list - eshell-cmpl-suffix-list)) (setq-local pcomplete-recexact eshell-cmpl-recexact) (setq-local pcomplete-man-function diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 6b86498399..5144e30512 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -301,15 +301,6 @@ Prepend remote identification of `default-directory', if any." (setq text (replace-match " " t t text))) text)) -(defmacro eshell-for (for-var for-list &rest forms) - "Iterate through a list." - (declare (obsolete dolist "24.1") (indent 2)) - `(let ((list-iter ,for-list)) - (while list-iter - (let ((,for-var (car list-iter))) - ,@forms) - (setq list-iter (cdr list-iter))))) - (define-obsolete-function-alias 'eshell-flatten-list #'flatten-tree "27.1") (defun eshell-stringify (object) diff --git a/lisp/files-x.el b/lisp/files-x.el index 8224a57450..da1e44e250 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -81,8 +81,7 @@ Intended to be used in the `interactive' spec of (let ((default (format "%S" (cond ((eq variable 'unibyte) t) ((boundp variable) - (symbol-value variable))))) - (minibuffer-completing-symbol t)) + (symbol-value variable)))))) (read-from-minibuffer (format "Add %s with value: " variable) nil read-expression-map t 'set-variable-value-history diff --git a/lisp/files.el b/lisp/files.el index 992f987943..2ea9d1e467 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3161,9 +3161,6 @@ major mode MODE. See also `auto-mode-alist'.") -(define-obsolete-variable-alias 'inhibit-first-line-modes-regexps - 'inhibit-file-local-variables-regexps "24.1") - ;; TODO really this should be a list of modes (eg tar-mode), not regexps, ;; because we are duplicating info from auto-mode-alist. ;; TODO many elements of this list are also in auto-coding-alist. @@ -3184,9 +3181,6 @@ member files with their own local variable sections, which are not appropriate for the containing file. The function `inhibit-local-variables-p' uses this.") -(define-obsolete-variable-alias 'inhibit-first-line-modes-suffixes - 'inhibit-local-variables-suffixes "24.1") - (defvar inhibit-local-variables-suffixes nil "List of regexps matching suffixes to remove from file names. The function `inhibit-local-variables-p' uses this: when checking diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index 17a87134be..3fc5ce2408 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -52,24 +52,6 @@ method to use when posting." (const current) (sexp :tag "Methods" ,gnus-select-method))) -(defcustom gnus-outgoing-message-group nil - "All outgoing messages will be put in this group. -If you want to store all your outgoing mail and articles in the group -\"nnml:archive\", you set this variable to that value. This variable -can also be a list of group names. - -If you want to have greater control over what group to put each -message in, you can set this variable to a function that checks the -current newsgroup name and then returns a suitable group name (or list -of names)." - :group 'gnus-message - :type '(choice (const nil) - (function) - (string :tag "Group") - (repeat :tag "List of groups" (string :tag "Group")))) - -(make-obsolete-variable 'gnus-outgoing-message-group 'gnus-message-archive-group "24.1") - (defcustom gnus-mailing-list-groups nil "If non-nil a regexp matching groups that are really mailing lists. This is useful when you're reading a mailing list that has been @@ -215,30 +197,6 @@ use this option with care." :parameter-document "\ List of charsets that are permitted to be unencoded.") -(defcustom gnus-debug-files - '("gnus.el" "gnus-sum.el" "gnus-group.el" - "gnus-art.el" "gnus-start.el" "gnus-async.el" - "gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el" - "gnus-agent.el" "gnus-cache.el" "gnus-srvr.el" - "mm-util.el" "mm-decode.el" "nnmail.el" "message.el") - "Files whose variables will be reported in `gnus-bug'." - :version "22.1" - :group 'gnus-message - :type '(repeat file)) - -(make-obsolete-variable 'gnus-debug-files "it is no longer used." "24.1") - -(defcustom gnus-debug-exclude-variables - '(mm-mime-mule-charset-alist - nnmail-split-fancy message-minibuffer-local-map) - "Variables that should not be reported in `gnus-bug'." - :version "22.1" - :group 'gnus-message - :type '(repeat variable)) - -(make-obsolete-variable - 'gnus-debug-exclude-variables "it is no longer used." "24.1") - (defcustom gnus-discouraged-post-methods '(nndraft nnml nnimap nnmaildir nnmh nnfolder nndir) "A list of back ends that are not used in \"real\" newsgroups. @@ -1665,7 +1623,7 @@ this is a reply." (defun gnus-inews-insert-gcc (&optional group) "Insert the Gcc to say where the article is to be archived." (let* ((group (or group gnus-newsgroup-name)) - (var (or gnus-outgoing-message-group gnus-message-archive-group)) + (var gnus-message-archive-group) (gcc-self-val (and group (not (gnus-virtual-group-p group)) (gnus-group-find-parameter group 'gcc-self t))) diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 8cefb09b66..ceeb184854 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -1004,9 +1004,6 @@ Uses `gnus-registry-marks' to find what shortcuts to install." nil (cons "Registry Marks" gnus-registry-misc-menus))))) -(define-obsolete-function-alias 'gnus-registry-user-format-function-M - #'gnus-registry-article-marks-to-chars "24.1") - ;; use like this: ;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-chars) (defun gnus-registry-article-marks-to-chars (headers) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 2119e68509..7eea08f174 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1130,16 +1130,6 @@ you could set this variable: :group 'gnus-server :type '(repeat gnus-select-method)) -(defcustom gnus-local-domain nil - "Local domain name without a host name. -The DOMAINNAME environment variable is used instead if it is defined. -If the function `system-name' returns the full Internet name, there is -no need to set this variable." - :group 'gnus-message - :type '(choice (const :tag "default" nil) - string)) -(make-obsolete-variable 'gnus-local-domain nil "24.1") - ;; Customization variables (defcustom gnus-refer-article-method 'current @@ -2316,11 +2306,6 @@ automatically cache the article in the agent cache." (defvar gnus-server-method-cache nil) (defvar gnus-extended-servers nil) -;; The carpal mode has been removed, but define the variable for -;; backwards compatibility. -(defvar gnus-carpal nil) -(make-obsolete-variable 'gnus-carpal nil "24.1") - (defvar gnus-agent-fetching nil "Whether Gnus agent is in fetching mode.") diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index c629cb85d9..746109f26f 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -95,9 +95,6 @@ Uses the same syntax as `nnmail-split-methods'.") (defvoo nnimap-unsplittable-articles '(%Deleted %Seen) "Articles with the flags in the list will not be considered when splitting.") -(make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'." - "24.1") - (defvoo nnimap-authenticator nil "How nnimap authenticate itself to the server. Possible choices are nil (use default methods), `anonymous', diff --git a/lisp/iimage.el b/lisp/iimage.el index 8a765d5e5d..baeb4bb6a7 100644 --- a/lisp/iimage.el +++ b/lisp/iimage.el @@ -87,9 +87,6 @@ Examples of image filename patterns to match: (iimage-mode-buffer t) (recenter-top-bottom arg)) -;;;###autoload -(define-obsolete-function-alias 'turn-on-iimage-mode 'iimage-mode "24.1") - (defun turn-off-iimage-mode () "Unconditionally turn off iimage mode." (interactive) diff --git a/lisp/image.el b/lisp/image.el index e90cccaa09..bdaaec608e 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -446,15 +446,6 @@ type if we can't otherwise guess it." (error "Invalid image type `%s'" type)) type) - -(if (fboundp 'image-metadata) ; eg not --without-x - (define-obsolete-function-alias 'image-extension-data - 'image-metadata "24.1")) - -(define-obsolete-variable-alias - 'image-library-alist - 'dynamic-library-alist "24.1") - ;;;###autoload (defun image-type-available-p (type) "Return t if image type TYPE is available. diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index 9d2e20ae04..d743802ead 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -42,9 +42,6 @@ :group 'maint :group 'mail) -(define-obsolete-variable-alias 'report-emacs-bug-pretest-address - 'report-emacs-bug-address "24.1") - (defcustom report-emacs-bug-no-confirmation nil "If non-nil, suppress the confirmations asked for the sake of novice users." :type 'boolean) diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el index 952970d07c..9ea2cc92e9 100644 --- a/lisp/mail/mail-utils.el +++ b/lisp/mail/mail-utils.el @@ -239,12 +239,8 @@ comma-separated list, and return the pruned list." ;; Or just set the default directly in the defcustom. (if (null mail-dont-reply-to-names) (setq mail-dont-reply-to-names - ;; `rmail-default-dont-reply-to-names' is obsolete. - (let ((a (bound-and-true-p rmail-default-dont-reply-to-names)) - (b (if (> (length user-mail-address) 0) - (concat "\\`" (regexp-quote user-mail-address) "\\'")))) - (cond ((and a b) (concat a "\\|" b)) - ((or a b)))))) + (if (> (length user-mail-address) 0) + (concat "\\`" (regexp-quote user-mail-address) "\\'")))) ;; Split up DESTINATIONS and match each element separately. (let ((start-pos 0) (cur-pos 0) (case-fold-search t)) @@ -281,9 +277,6 @@ comma-separated list, and return the pruned list." (substring destinations (match-end 0)) destinations)) -;; Legacy name -(define-obsolete-function-alias 'rmail-dont-reply-to #'mail-dont-reply-to "24.1") - ;;;###autoload (defun mail-fetch-field (field-name &optional last all list delete) diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el index ba7cf58d38..c97786190c 100644 --- a/lisp/mail/mailalias.el +++ b/lisp/mail/mailalias.el @@ -72,8 +72,7 @@ When t this still needs to be initialized.") ) "Alist of header field and expression to return alist for completion. The expression may reference the variable `pattern' -which will hold the string being completed. -If not on matching header, `mail-complete-function' gets called instead." +which will hold the string being completed." :type 'alist :group 'mailalias) (put 'mail-complete-alist 'risky-local-variable t) @@ -90,13 +89,6 @@ If `angles', they look like: :type '(choice (const angles) (const parens) (const nil)) :group 'mailalias) -(defcustom mail-complete-function 'ispell-complete-word - "Function to call when completing outside `mail-complete-alist'-header." - :type '(choice function (const nil)) - :group 'mailalias) -(make-obsolete-variable 'mail-complete-function - 'completion-at-point-functions "24.1") - (defcustom mail-directory-function nil "Function to get completions from directory service or nil for none. See `mail-directory-requery'." @@ -433,25 +425,6 @@ For use on `completion-at-point-functions'." (let ((pattern prefix)) (eval list-exp)))))) (list beg end table))))) -;;;###autoload -(defun mail-complete (arg) - "Perform completion on header field or word preceding point. -Completable headers are according to `mail-complete-alist'. If none matches -current header, calls `mail-complete-function' and passes prefix ARG if any." - (declare (obsolete mail-completion-at-point-function "24.1")) - (interactive "P") - ;; Read the defaults first, if we have not done so. - (sendmail-sync-aliases) - (if (eq mail-aliases t) - (progn - (setq mail-aliases nil) - (if (file-exists-p mail-personal-alias-file) - (build-mail-aliases)))) - (let ((data (mail-completion-at-point-function))) - (if data - (apply #'completion-in-region data) - (funcall mail-complete-function arg)))) - (defun mail-completion-expand (table) "Build new completion table that expands aliases. Completes like TABLE except that if the completion is a valid alias, diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index b2b21b88ef..467375dbe1 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -314,20 +314,6 @@ Setting this variable has an effect only before reading a mail." :group 'rmail-retrieve :version "21.1") -;;;###autoload -(define-obsolete-variable-alias 'rmail-dont-reply-to-names - 'mail-dont-reply-to-names "24.1") - -;; Prior to 24.1, this used to contain "\\`info-". -;;;###autoload -(defvar rmail-default-dont-reply-to-names nil - "Regexp specifying part of the default value of `mail-dont-reply-to-names'. -This is used when the user does not set `mail-dont-reply-to-names' -explicitly.") -;;;###autoload -(make-obsolete-variable 'rmail-default-dont-reply-to-names - 'mail-dont-reply-to-names "24.1") - ;;;###autoload (defcustom rmail-ignored-headers (purecopy diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index c55cdc8412..6afadca6bb 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -430,20 +430,6 @@ support Delivery Status Notification." (const :tag "Success" success))) :version "22.1") -;; Note: could use /usr/ucb/mail instead of sendmail; -;; options -t, and -v if not interactive. -(defvar mail-mailer-swallows-blank-line nil - "Set this non-nil if the system's mailer runs the header and body together. -The actual value should be an expression to evaluate that returns -non-nil if the problem will actually occur. -\(As far as we know, this is not an issue on any system still supported -by Emacs.)") - -(put 'mail-mailer-swallows-blank-line 'risky-local-variable t) ; gets evalled -(make-obsolete-variable 'mail-mailer-swallows-blank-line - "no need to set this on any modern system." - "24.1" 'set) - (defvar mail-mode-syntax-table ;; define-derived-mode will make it inherit from text-mode-syntax-table. (let ((st (make-syntax-table))) @@ -1309,8 +1295,6 @@ external program defined by `sendmail-program'." ;; Insert an extra newline if we need it to work around ;; Sun's bug that swallows newlines. (goto-char (1+ delimline)) - (if (eval mail-mailer-swallows-blank-line) - (newline)) ;; Find and handle any Fcc fields. (goto-char (point-min)) (if (re-search-forward "^Fcc:" delimline t) @@ -1495,28 +1479,6 @@ just append to the file, in Babyl format if necessary." (with-current-buffer buffer (set-visited-file-modtime))))))))) -(defun mail-sent-via () - "Make a Sent-via header line from each To or Cc header line." - (declare (obsolete "nobody can remember what it is for." "24.1")) - (interactive) - (save-excursion - ;; put a marker at the end of the header - (let ((end (copy-marker (mail-header-end))) - (case-fold-search t)) - (goto-char (point-min)) - ;; search for the To: lines and make Sent-via: lines from them - ;; search for the next To: line - (while (re-search-forward "^\\(to\\|cc\\):" end t) - ;; Grab this line plus all its continuations, sans the `to:'. - (let ((to-line - (buffer-substring (point) - (progn - (if (re-search-forward "^[^ \t\n]" end t) - (backward-char 1) - (goto-char end)) - (point))))) - ;; Insert a copy, with altered header field name. - (insert-before-markers "Sent-via:" to-line)))))) (defun mail-to () "Move point to end of To field, creating it if necessary." @@ -1839,8 +1801,6 @@ If the current line has `mail-yank-prefix', insert it on the new line." (or (bolp) (newline)) (goto-char start)))) -(define-obsolete-function-alias 'mail-attach-file #'mail-insert-file "24.1") - (declare-function mml-attach-file "mml" (file &optional type description disposition)) diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index da786dec00..8cba2b14e1 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -342,8 +342,6 @@ for `smtpmail-try-auth-method'.") ;; Insert an extra newline if we need it to work around ;; Sun's bug that swallows newlines. (goto-char (1+ delimline)) - (if (eval mail-mailer-swallows-blank-line t) - (newline)) ;; Find and handle any Fcc fields. (goto-char (point-min)) (if (re-search-forward "^Fcc:" delimline t) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index a134654a02..12a0b4d328 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -584,9 +584,6 @@ menu)) -(define-obsolete-function-alias - 'menu-bar-kill-ring-save 'kill-ring-save "24.1") - ;; These are alternative definitions for the cut, paste and copy ;; menu items. Use them if your system expects these to use the clipboard. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index e029dfe414..9d2abbd118 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2225,25 +2225,6 @@ These include: `exact' - text is a valid completion but may be further completed.") -(defvar completion-annotate-function - nil - ;; Note: there's a lot of scope as for when to add annotations and - ;; what annotations to add. E.g. completing-help.el allowed adding - ;; the first line of docstrings to M-x completion. But there's - ;; a tension, since such annotations, while useful at times, can - ;; actually drown the useful information. - ;; So completion-annotate-function should be used parsimoniously, or - ;; else only used upon a user's request (e.g. we could add a command - ;; to completion-list-mode to add annotations to the current - ;; completions). - "Function to add annotations in the *Completions* buffer. -The function takes a completion and should either return nil, or a string that -will be displayed next to the completion. The function can access the -completion table and predicates via `minibuffer-completion-table' and related -variables.") -(make-obsolete-variable 'completion-annotate-function - 'completion-extra-properties "24.1") - (defun completion--done (string &optional finished message) (let* ((exit-fun (plist-get completion-extra-properties :exit-function)) (pre-msg (and exit-fun (current-message)))) @@ -2314,8 +2295,7 @@ variables.") minibuffer-completion-predicate)) (ann-fun (or (completion-metadata-get all-md 'annotation-function) (plist-get completion-extra-properties - :annotation-function) - completion-annotate-function)) + :annotation-function))) (aff-fun (or (completion-metadata-get all-md 'affixation-function) (plist-get completion-extra-properties :affixation-function))) @@ -2790,9 +2770,6 @@ Gets combined either with `minibuffer-local-completion-map' or with `minibuffer-local-must-match-map'." "SPC" nil) -(defvar minibuffer-local-filename-must-match-map (make-sparse-keymap)) -(make-obsolete-variable 'minibuffer-local-filename-must-match-map nil "24.1") - (defvar-keymap minibuffer-local-ns-map :doc "Local keymap for the minibuffer when spaces are not allowed." :parent minibuffer-local-map diff --git a/lisp/msb.el b/lisp/msb.el index 616799f067..19f0afed73 100644 --- a/lisp/msb.el +++ b/lisp/msb.el @@ -353,9 +353,6 @@ This is instead of the groups in `msb-menu-cond'." :type 'boolean :set #'msb-custom-set) -(define-obsolete-variable-alias 'msb-after-load-hooks - 'msb-after-load-hook "24.1") - (defcustom msb-after-load-hook nil "Hook run after the msb package has been loaded." :type 'hook diff --git a/lisp/obsolete/eieio-compat.el b/lisp/obsolete/eieio-compat.el index b31bde4efb..2ac75293fc 100644 --- a/lisp/obsolete/eieio-compat.el +++ b/lisp/obsolete/eieio-compat.el @@ -248,21 +248,6 @@ Summary: (message "next-method-p called outside of a primary or around method") nil) -;;;###autoload -(defun eieio-defmethod (method args) - "Obsolete work part of an old version of the `defmethod' macro." - (declare (obsolete cl-defmethod "24.1")) - (eval `(defmethod ,method ,@args)) - method) - -;;;###autoload -(defun eieio-defgeneric (method doc-string) - "Obsolete work part of an old version of the `defgeneric' macro." - (declare (obsolete cl-defgeneric "24.1")) - (eval `(defgeneric ,method (x) ,@(if doc-string `(,doc-string)))) - ;; Return the method - 'method) - ;;;###autoload (defun eieio-defclass (cname superclasses slots options) (declare (obsolete eieio-defclass-internal "25.1")) diff --git a/lisp/obsolete/info-edit.el b/lisp/obsolete/info-edit.el index 6c1be1078f..6c4c10ca6c 100644 --- a/lisp/obsolete/info-edit.el +++ b/lisp/obsolete/info-edit.el @@ -33,7 +33,6 @@ (make-obsolete-variable 'Info-edit-mode-hook "editing Info nodes by hand is not recommended." "24.4") -(define-obsolete-variable-alias 'Info-edit-map 'Info-edit-mode-map "24.1") (defvar Info-edit-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map text-mode-map) (define-key map "\C-c\C-c" #'Info-cease-edit) diff --git a/lisp/obsolete/starttls.el b/lisp/obsolete/starttls.el index 6f0685d3dd..2f1f0e9773 100644 --- a/lisp/obsolete/starttls.el +++ b/lisp/obsolete/starttls.el @@ -287,9 +287,6 @@ GnuTLS requires a port number." starttls-gnutls-program starttls-program)))) -(define-obsolete-function-alias 'starttls-any-program-available - #'starttls-available-p "24.1") - (provide 'starttls) ;;; starttls.el ends here diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el index 00348ac0bb..32031d1946 100644 --- a/lisp/progmodes/cfengine.el +++ b/lisp/progmodes/cfengine.el @@ -793,14 +793,6 @@ bundle agent rcfiles (cdr (assq 'functions cfengine3-fallback-syntax))) 'symbols)) -(defcustom cfengine-mode-abbrevs nil - "Abbrevs for CFEngine2 mode." - :type '(repeat (list (string :tag "Name") - (string :tag "Expansion") - (choice :tag "Hook" (const nil) function)))) - -(make-obsolete-variable 'cfengine-mode-abbrevs 'edit-abbrevs "24.1") - ;; Taken from the doc for pre-release 2.1. (eval-and-compile (defconst cfengine2-actions @@ -1409,7 +1401,6 @@ to the action header." (setq-local outline-regexp "[ \t]*\\(\\sw\\|\\s_\\)+:+") (setq-local outline-level #'cfengine2-outline-level) (setq-local fill-paragraph-function #'cfengine-fill-paragraph) - (define-abbrev-table 'cfengine2-mode-abbrev-table cfengine-mode-abbrevs) (setq font-lock-defaults '(cfengine2-font-lock-keywords nil nil nil beginning-of-line)) ;; Fixme: set the args of functions in evaluated classes to string diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el index 971e3f6174..03469b9f55 100644 --- a/lisp/progmodes/cwarn.el +++ b/lisp/progmodes/cwarn.el @@ -180,9 +180,6 @@ C++ modes are included." (cwarn-font-lock-keywords cwarn-mode) (font-lock-flush)) -;;;###autoload -(define-obsolete-function-alias 'turn-on-cwarn-mode 'cwarn-mode "24.1") - ;;}}} ;;{{{ Help functions diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 91307f6c09..bd01786e08 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -1170,7 +1170,6 @@ and adds all qualifying names to the list of known targets." (goto-char (match-end 0)) (insert suffix)))))))) -(define-obsolete-function-alias 'makefile-complete 'completion-at-point "24.1") ;; Backslashification. Stolen from cc-mode.el. diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el index 34288e0e4f..f0fd23f3bc 100644 --- a/lisp/progmodes/meta-mode.el +++ b/lisp/progmodes/meta-mode.el @@ -438,8 +438,6 @@ If the list was changed, sort the list and remove duplicates first." (insert close))))))) (nth 1 entry)))) -(define-obsolete-function-alias 'meta-complete-symbol - 'completion-at-point "24.1") ;;; Indentation. @@ -803,7 +801,6 @@ The environment marked is the one that contains point or follows point." st) "Syntax table used in Metafont or MetaPost mode.") -(define-obsolete-variable-alias 'meta-mode-map 'meta-common-mode-map "24.1") (defvar meta-common-mode-map (let ((map (make-sparse-keymap))) ;; Comment Paragraphs: diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el index 351ea6e3a9..8d3194e6a4 100644 --- a/lisp/progmodes/pascal.el +++ b/lisp/progmodes/pascal.el @@ -239,14 +239,6 @@ will do all lineups." (const :tag "Declarations" declaration) (const :tag "Case statements" case))) -(defvar pascal-toggle-completions nil - "If non-nil, `pascal-complete-word' tries all possible completions. -Repeated use of \\[pascal-complete-word] then shows all -completions in turn, instead of displaying a list of all possible -completions.") -(make-obsolete-variable 'pascal-toggle-completions - 'completion-cycle-threshold "24.1") - (defcustom pascal-type-keywords '("array" "file" "packed" "char" "integer" "real" "string" "record") "Keywords for types used when completing a word in a declaration or parmlist. @@ -1297,13 +1289,6 @@ indent of the current line in parameterlist." (when (> e b) (list b e #'pascal-completion)))) -(define-obsolete-function-alias 'pascal-complete-word - 'completion-at-point "24.1") - -(define-obsolete-function-alias 'pascal-show-completions - 'completion-help-at-point "24.1") - - (defun pascal-get-default-symbol () "Return symbol around current point as a string." (save-excursion diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 9598209f5e..5aba95d4c7 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -742,14 +742,6 @@ Relevant only when `prolog-imenu-flag' is non-nil." :group 'prolog-other :type 'boolean) -(defcustom prolog-char-quote-workaround nil - "If non-nil, declare 0 as a quote character to handle 0'. -This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24." - :version "24.1" - :group 'prolog-other - :type 'boolean) -(make-obsolete-variable 'prolog-char-quote-workaround nil "24.1") - ;;------------------------------------------------------------------- ;; Internal variables @@ -1303,7 +1295,7 @@ To find out what version of Prolog mode you are running, enter (t t))) ;; This statement was missing in Emacs 24.1, 24.2, 24.3. -(define-obsolete-function-alias 'switch-to-prolog 'run-prolog "24.1") +(define-obsolete-function-alias 'switch-to-prolog 'run-prolog "24.1") ; "24.4" ; for grep ;;;###autoload (defun run-prolog (arg) "Run an inferior Prolog process, input and output via buffer *prolog*. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index f1191b8faa..1c99937c4b 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -248,7 +248,6 @@ (eval-when-compile (require 'subr-x)) ;For `string-empty-p'. ;; Avoid compiler warnings -(defvar view-return-to-alist) (defvar compilation-error-regexp-alist) (defvar outline-heading-end-regexp) diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 3c8d4f43db..2e8e8d2319 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -234,9 +234,6 @@ It creates the Imenu index for the buffer, if necessary." (setq which-func-mode nil) (error "Error in which-func-update: %S" info)))))) -;;;###autoload -(define-obsolete-function-alias 'which-func-mode 'which-function-mode "24.1") - (defvar which-func-update-timer nil) (unless (or (assq 'which-func-mode mode-line-misc-info) diff --git a/lisp/simple.el b/lisp/simple.el index 66640916a2..1d251dbf5e 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1732,8 +1732,6 @@ from Lisp." words (if (= words 1) "" "s") chars (if (= chars 1) "" "s")))) -(define-obsolete-function-alias 'count-lines-region 'count-words-region "24.1") - (defun what-line () "Print the current buffer line number and narrowed line number of point." (interactive) @@ -1951,10 +1949,6 @@ Such arguments are used as in `read-from-minibuffer'.)" ;; Used for interactive spec `X'. (eval (read--expression prompt initial-contents))) -(defvar minibuffer-completing-symbol nil - "Non-nil means completing a Lisp symbol in the minibuffer.") -(make-obsolete-variable 'minibuffer-completing-symbol nil "24.1" 'get) - (defvar minibuffer-default nil "The current default value or list of default values in the minibuffer. The functions `read-from-minibuffer' and `completing-read' bind @@ -2015,20 +2009,19 @@ display the result of expression evaluation." PROMPT and optional argument INITIAL-CONTENTS do the same as in function `read-from-minibuffer'." - (let ((minibuffer-completing-symbol t)) - (minibuffer-with-setup-hook - (lambda () - ;; FIXME: instead of just applying the syntax table, maybe - ;; use a special major mode tailored to reading Lisp - ;; expressions from the minibuffer? (`emacs-lisp-mode' - ;; doesn't preserve the necessary keybindings.) - (set-syntax-table emacs-lisp-mode-syntax-table) - (add-hook 'completion-at-point-functions - #'elisp-completion-at-point nil t) - (run-hooks 'eval-expression-minibuffer-setup-hook)) - (read-from-minibuffer prompt initial-contents - read-expression-map t - 'read-expression-history)))) + (minibuffer-with-setup-hook + (lambda () + ;; FIXME: instead of just applying the syntax table, maybe + ;; use a special major mode tailored to reading Lisp + ;; expressions from the minibuffer? (`emacs-lisp-mode' + ;; doesn't preserve the necessary keybindings.) + (set-syntax-table emacs-lisp-mode-syntax-table) + (add-hook 'completion-at-point-functions + #'elisp-completion-at-point nil t) + (run-hooks 'eval-expression-minibuffer-setup-hook)) + (read-from-minibuffer prompt initial-contents + read-expression-map t + 'read-expression-history))) (defun read--expression-try-read () "Try to read an Emacs Lisp expression in the minibuffer. diff --git a/lisp/speedbar.el b/lisp/speedbar.el index da85d54863..9184d6c525 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -703,8 +703,6 @@ If you want to change this while speedbar is active, either use (defvar speedbar-update-flag-disable nil "Permanently disable changing of the update flag.") -(define-obsolete-variable-alias - 'speedbar-syntax-table 'speedbar-mode-syntax-table "24.1") (defvar speedbar-mode-syntax-table (let ((st (make-syntax-table))) ;; Turn off paren matching around here. @@ -719,8 +717,6 @@ If you want to change this while speedbar is active, either use st) "Syntax-table used on the speedbar.") - -(define-obsolete-variable-alias 'speedbar-key-map 'speedbar-mode-map "24.1") (defvar speedbar-mode-map (let ((map (make-keymap))) (suppress-keymap map t) diff --git a/lisp/strokes.el b/lisp/strokes.el index 376cbc0cfe..d7a9539316 100644 --- a/lisp/strokes.el +++ b/lisp/strokes.el @@ -1031,8 +1031,6 @@ o Strokes are a bit computer-dependent in that they depend somewhat on (help-mode) (help-print-return-message))) -(define-obsolete-function-alias 'strokes-report-bug #'report-emacs-bug "24.1") - (defun strokes-window-configuration-changed-p () "Non-nil if the `strokes-window-configuration' frame properties changed. This is based on the last time `strokes-window-configuration' was updated." diff --git a/lisp/subr.el b/lisp/subr.el index 6bf12fd757..f8b386e563 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1856,8 +1856,6 @@ be a list of the form returned by `event-start' and `event-end'." ;;;; Obsolescence declarations for variables, and aliases. (make-obsolete-variable 'redisplay-end-trigger-functions 'jit-lock-register "23.1") -(make-obsolete-variable 'deferred-action-list 'post-command-hook "24.1") -(make-obsolete-variable 'deferred-action-function 'post-command-hook "24.1") (make-obsolete-variable 'redisplay-dont-pause nil "24.5") (make-obsolete 'window-redisplay-end-trigger nil "23.1") (make-obsolete 'set-window-redisplay-end-trigger nil "23.1") @@ -4707,9 +4705,6 @@ even if this catches the signal." ,@(cdr handler))) handlers))) -(define-obsolete-function-alias 'condition-case-no-debug - 'condition-case-unless-debug "24.1") - (defmacro with-demoted-errors (format &rest body) "Run BODY and demote any errors to simple messages. FORMAT is a string passed to `message' to format any error message. diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 84c5b087b9..e26191b33b 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -97,8 +97,6 @@ The properties returned may include `top', `left', `height', and `width'." ;;;; Keyboard mapping. -(define-obsolete-variable-alias 'ns-alternatives-map 'x-alternatives-map "24.1") - ;; Here are some Nextstep-like bindings for command key sequences. (define-key global-map [?\s-,] 'customize) (define-key global-map [?\s-'] 'next-window-any-frame) @@ -682,10 +680,6 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") ;;;; Pasteboard support. -(define-obsolete-function-alias 'ns-store-cut-buffer-internal - 'gui-set-selection "24.1") - - (defun ns-copy-including-secondary () (interactive) (call-interactively 'kill-ring-save) diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 7eaa604776..993f1d4320 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -81,7 +81,6 @@ (&optional frame exclude-proportional)) (defvar w32-color-map) ;; defined in w32fns.c -(make-obsolete 'w32-default-color-map nil "24.1") (declare-function w32-send-sys-command "w32fns.c") (declare-function set-message-beep "w32fns.c") diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 7c88c85cef..3a0bd65f29 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1171,9 +1171,6 @@ as returned by `x-server-vendor'." ;;;; Selections -(define-obsolete-function-alias 'x-cut-buffer-or-selection-value - 'x-selection-value "24.1") - ;; Arrange for the kill and yank functions to set and check the clipboard. (defun x-clipboard-yank () diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 544e0da827..6763da046f 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -316,8 +316,6 @@ If parsing fails, try to set this variable to nil." (option (choice :tag "Alternative" :value nil (const nil) integer))))))) -(define-obsolete-variable-alias 'bibtex-entry-field-alist - 'bibtex-BibTeX-entry-alist "24.1") (defcustom bibtex-BibTeX-entry-alist '(("Article" "Article in Journal" (("author") @@ -3673,14 +3671,6 @@ if that value is non-nil. (if (not (consp (nth 1 (car entry-alist)))) ;; new format entry-alist - ;; Convert old format of `bibtex-entry-field-alist' - (unless (get var 'entry-list-format) - (put var 'entry-list-format "pre-24") - (message "Old format of `%s' (pre GNU Emacs 24). -Please convert to the new format." - (if (eq (indirect-variable 'bibtex-entry-field-alist) var) - 'bibtex-entry-field-alist var)) - (sit-for 3)) (let (lst) (dolist (entry entry-alist) (let ((fl (nth 1 entry)) req xref opt) @@ -5318,7 +5308,6 @@ entries from minibuffer." (goto-char (point-max)) (message "Buffer is now parsable. Please save it."))) -(define-obsolete-function-alias 'bibtex-complete #'completion-at-point "24.1") (defun bibtex-completion-at-point-function () (let ((pnt (point)) (case-fold-search t) diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index aeae389da6..b517cc1663 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -269,8 +269,6 @@ will prompt for other arguments." (and newtag (cdr cell) (not (member newtag (cdr cell))) (push newtag (cdr cell))))) -(define-obsolete-variable-alias - 'reftex-index-map 'reftex-index-mode-map "24.1") (defvar reftex-index-mode-map (let ((map (make-sparse-keymap))) ;; Index map @@ -1198,8 +1196,6 @@ This gets refreshed in every phrases command.") '((reftex-index-phrases-font-lock-keywords) nil t nil beginning-of-line) "Font lock defaults for `reftex-index-phrases-mode'.") -(define-obsolete-variable-alias - 'reftex-index-phrases-map 'reftex-index-phrases-mode-map "24.1") (defvar reftex-index-phrases-mode-map (let ((map (make-sparse-keymap))) ;; Keybindings and Menu for phrases buffer diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el index d77411483f..5942801a8a 100644 --- a/lisp/textmodes/reftex-sel.el +++ b/lisp/textmodes/reftex-sel.el @@ -59,8 +59,6 @@ (define-key map [follow-link] 'mouse-face) map)) -(define-obsolete-variable-alias - 'reftex-select-label-map 'reftex-select-label-mode-map "24.1") (defvar reftex-select-label-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map reftex-select-shared-map) @@ -109,8 +107,6 @@ During a selection process, these are the local bindings. ;; We do not set a local map - reftex-select-item does this. ) -(define-obsolete-variable-alias - 'reftex-select-bib-map 'reftex-select-bib-mode-map "24.1") (defvar reftex-select-bib-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map reftex-select-shared-map) diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el index 89c734a0d7..5599eaee02 100644 --- a/lisp/textmodes/reftex-toc.el +++ b/lisp/textmodes/reftex-toc.el @@ -28,7 +28,6 @@ (require 'reftex) ;;; -(define-obsolete-variable-alias 'reftex-toc-map 'reftex-toc-mode-map "24.1") (defvar reftex-toc-mode-map (let ((map (make-sparse-keymap))) diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 964baed03c..f6bbda02e6 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -3584,125 +3584,46 @@ Region is from BEG to END. With WITH-EMPTY prefix empty lines too." :version "24.1" :group 'rst-faces) -(defcustom rst-block-face 'rst-block - "All syntax marking up a special block." - :version "24.1" - :group 'rst-faces - :type '(face)) -(make-obsolete-variable 'rst-block-face - "customize the face `rst-block' instead." - "24.1") - (defface rst-external '((t :inherit font-lock-type-face)) "Face used for field names and interpreted text." :version "24.1" :group 'rst-faces) -(defcustom rst-external-face 'rst-external - "Field names and interpreted text." - :version "24.1" - :group 'rst-faces - :type '(face)) -(make-obsolete-variable 'rst-external-face - "customize the face `rst-external' instead." - "24.1") - (defface rst-definition '((t :inherit font-lock-function-name-face)) "Face used for all other defining constructs." :version "24.1" :group 'rst-faces) -(defcustom rst-definition-face 'rst-definition - "All other defining constructs." - :version "24.1" - :group 'rst-faces - :type '(face)) -(make-obsolete-variable 'rst-definition-face - "customize the face `rst-definition' instead." - "24.1") - (defface rst-directive '((t :inherit font-lock-builtin-face)) "Face used for directives and roles." :version "24.1" :group 'rst-faces) -(defcustom rst-directive-face 'rst-directive - "Directives and roles." - :group 'rst-faces - :type '(face)) -(make-obsolete-variable 'rst-directive-face - "customize the face `rst-directive' instead." - "24.1") - (defface rst-comment '((t :inherit font-lock-comment-face)) "Face used for comments." :version "24.1" :group 'rst-faces) -(defcustom rst-comment-face 'rst-comment - "Comments." - :version "24.1" - :group 'rst-faces - :type '(face)) -(make-obsolete-variable 'rst-comment-face - "customize the face `rst-comment' instead." - "24.1") - (defface rst-emphasis1 '((t :inherit italic)) "Face used for simple emphasis." :version "24.1" :group 'rst-faces) -(defcustom rst-emphasis1-face 'rst-emphasis1 - "Simple emphasis." - :version "24.1" - :group 'rst-faces - :type '(face)) -(make-obsolete-variable 'rst-emphasis1-face - "customize the face `rst-emphasis1' instead." - "24.1") - (defface rst-emphasis2 '((t :inherit bold)) "Face used for double emphasis." :version "24.1" :group 'rst-faces) -(defcustom rst-emphasis2-face 'rst-emphasis2 - "Double emphasis." - :group 'rst-faces - :type '(face)) -(make-obsolete-variable 'rst-emphasis2-face - "customize the face `rst-emphasis2' instead." - "24.1") - (defface rst-literal '((t :inherit font-lock-string-face)) "Face used for literal text." :version "24.1" :group 'rst-faces) -(defcustom rst-literal-face 'rst-literal - "Literal text." - :version "24.1" - :group 'rst-faces - :type '(face)) -(make-obsolete-variable 'rst-literal-face - "customize the face `rst-literal' instead." - "24.1") - (defface rst-reference '((t :inherit font-lock-variable-name-face)) "Face used for references to a definition." :version "24.1" :group 'rst-faces) -(defcustom rst-reference-face 'rst-reference - "References to a definition." - :version "24.1" - :group 'rst-faces - :type '(face)) -(make-obsolete-variable 'rst-reference-face - "customize the face `rst-reference' instead." - "24.1") - (defface rst-transition '((t :inherit font-lock-keyword-face)) "Face used for a transition." :package-version '(rst . "1.3.0") @@ -3794,23 +3715,23 @@ of your own." ;; `Bullet Lists`_ ;; FIXME: A bullet directly after a field name is not recognized. (,(rst-re 'lin-beg '(:grp bul-sta)) - 1 rst-block-face) + 1 'rst-block) ;; `Enumerated Lists`_ (,(rst-re 'lin-beg '(:grp enmany-sta)) - 1 rst-block-face) + 1 'rst-block) ;; `Definition Lists`_ ;; FIXME: missing. ;; `Field Lists`_ (,(rst-re 'lin-beg '(:grp fld-tag) 'bli-sfx) - 1 rst-external-face) + 1 'rst-external) ;; `Option Lists`_ (,(rst-re 'lin-beg '(:grp opt-tag (:shy optsep-tag opt-tag) "*") '(:alt "$" (:seq hws-prt "\\{2\\}"))) - 1 rst-block-face) + 1 'rst-block) ;; `Line Blocks`_ ;; Only for lines containing no more bar - to distinguish from tables. (,(rst-re 'lin-beg '(:grp "|" bli-sfx) "[^|\n]*$") - 1 rst-block-face) + 1 'rst-block) ;; `Tables`_ ;; FIXME: missing @@ -3818,22 +3739,22 @@ of your own." ;; All the `Explicit Markup Blocks`_ ;; `Footnotes`_ / `Citations`_ (,(rst-re 'lin-beg 'fnc-sta-2) - (1 rst-definition-face) - (2 rst-definition-face)) + (1 'rst-definition) + (2 'rst-definition)) ;; `Directives`_ / `Substitution Definitions`_ (,(rst-re 'lin-beg 'dir-sta-3) - (1 rst-directive-face) - (2 rst-definition-face) - (3 rst-directive-face)) + (1 'rst-directive) + (2 'rst-definition) + (3 'rst-directive)) ;; `Hyperlink Targets`_ (,(rst-re 'lin-beg '(:grp exm-sta "_" (:alt (:seq "`" ilcbkqdef-tag "`") (:seq (:alt "[^:\\\n]" "\\\\.") "+")) ":") 'bli-sfx) - 1 rst-definition-face) + 1 'rst-definition) (,(rst-re 'lin-beg '(:grp "__") 'bli-sfx) - 1 rst-definition-face) + 1 'rst-definition) ;; All `Inline Markup`_ ;; Most of them may be multiline though this is uninteresting. @@ -3841,16 +3762,16 @@ of your own." ;; FIXME: Condition 5 preventing fontification of e.g. "*" not implemented ;; `Strong Emphasis`_. (,(rst-re 'ilm-pfx '(:grp "\\*\\*" ilcast-tag "\\*\\*") 'ilm-sfx) - 1 rst-emphasis2-face) + 1 'rst-emphasis2) ;; `Emphasis`_ (,(rst-re 'ilm-pfx '(:grp "\\*" ilcast-tag "\\*") 'ilm-sfx) - 1 rst-emphasis1-face) + 1 'rst-emphasis1) ;; `Inline Literals`_ (,(rst-re 'ilm-pfx '(:grp "``" ilcbkq-tag "``") 'ilm-sfx) - 1 rst-literal-face) + 1 'rst-literal) ;; `Inline Internal Targets`_ (,(rst-re 'ilm-pfx '(:grp "_`" ilcbkq-tag "`") 'ilm-sfx) - 1 rst-definition-face) + 1 'rst-definition) ;; `Hyperlink References`_ ;; FIXME: `Embedded URIs and Aliases`_ not considered. ;; FIXME: Directly adjacent marked up words are not fontified correctly @@ -3858,28 +3779,28 @@ of your own." (,(rst-re 'ilm-pfx '(:grp (:alt (:seq "`" ilcbkq-tag "`") (:seq "\\sw" (:alt "\\sw" "-") "+\\sw")) "__?") 'ilm-sfx) - 1 rst-reference-face) + 1 'rst-reference) ;; `Interpreted Text`_ (,(rst-re 'ilm-pfx '(:grp (:shy ":" sym-tag ":") "?") '(:grp "`" ilcbkq-tag "`") '(:grp (:shy ":" sym-tag ":") "?") 'ilm-sfx) - (1 rst-directive-face) - (2 rst-external-face) - (3 rst-directive-face)) + (1 'rst-directive) + (2 'rst-external) + (3 'rst-directive)) ;; `Footnote References`_ / `Citation References`_ (,(rst-re 'ilm-pfx '(:grp fnc-tag "_") 'ilm-sfx) - 1 rst-reference-face) + 1 'rst-reference) ;; `Substitution References`_ ;; FIXME: References substitutions like |this|_ or |this|__ are not ;; fontified correctly. (,(rst-re 'ilm-pfx '(:grp sub-tag) 'ilm-sfx) - 1 rst-reference-face) + 1 'rst-reference) ;; `Standalone Hyperlinks`_ ;; FIXME: This takes it easy by using a whitespace as delimiter. (,(rst-re 'ilm-pfx '(:grp uri-tag ":\\S +") 'ilm-sfx) - 1 rst-definition-face) + 1 'rst-definition) (,(rst-re 'ilm-pfx '(:grp sym-tag "@" sym-tag ) 'ilm-sfx) - 1 rst-definition-face) + 1 'rst-definition) ;; Do all block fontification as late as possible so 'append works. @@ -3906,18 +3827,18 @@ of your own." ;; `Comments`_ ;; This is multiline. (,(rst-re 'lin-beg 'cmt-sta-1) - (1 rst-comment-face) + (1 'rst-comment) (rst-font-lock-find-unindented-line-match (rst-font-lock-find-unindented-line-limit (match-end 1)) nil - (0 rst-comment-face append))) + (0 'rst-comment append))) (,(rst-re 'lin-beg '(:grp exm-tag) '(:grp hws-tag) "$") - (1 rst-comment-face) - (2 rst-comment-face) + (1'rst-comment) + (2'rst-comment) (rst-font-lock-find-unindented-line-match (rst-font-lock-find-unindented-line-limit 'next) nil - (0 rst-comment-face append))) + (0 'rst-comment append))) ;; FIXME: This is not rendered as comment:: ;; .. .. list-table:: @@ -3941,11 +3862,11 @@ of your own." ;; `Indented Literal Blocks`_ ;; This is multiline. (,(rst-re 'lin-beg 'lit-sta-2) - (2 rst-block-face) + (2 'rst-block) (rst-font-lock-find-unindented-line-match (rst-font-lock-find-unindented-line-limit t) nil - (0 rst-literal-face append))) + (0 'rst-literal append))) ;; FIXME: `Quoted Literal Blocks`_ missing. ;; This is multiline. @@ -3972,8 +3893,8 @@ of your own." ;; ;; Indentation is not required for doctest blocks. (,(rst-re 'lin-beg '(:grp (:alt ">>>" ell-tag)) '(:grp ".+")) - (1 rst-block-face) - (2 rst-literal-face))) + (1 'rst-block) + (2 'rst-literal))) "Keywords to highlight in rst mode.") (defvar font-lock-beg) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 46e40f29c0..80508570f3 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -556,15 +556,6 @@ this function." templates)))) -;; toggle-read-only is obsolete since 24.3, but since vc-t-r-o was made -;; obsolete earlier, it is ok for the latter to be an alias to the former, -;; since the latter will be removed first. We can't just make it -;; an alias for read-only-mode, since that is not 100% the same. -(defalias 'vc-toggle-read-only 'toggle-read-only) -(make-obsolete 'vc-toggle-read-only - "use `read-only-mode' instead (or `toggle-read-only' in older versions of Emacs)." - "24.1") - (defun vc-default-make-version-backups-p (_backend _file) "Return non-nil if unmodified versions should be backed up locally. The default is to switch off this feature." diff --git a/lisp/view.el b/lisp/view.el index 17bc46d4c4..287112f2d4 100644 --- a/lisp/view.el +++ b/lisp/view.el @@ -112,18 +112,6 @@ If nil that means use half the window size.") (defvar-local view-last-regexp nil) ; Global is better??? -(defvar-local view-return-to-alist nil - "What to do with used windows and where to go when finished viewing buffer. -This is local in each buffer being viewed. -It is added to by `view-mode-enter' when starting to view a buffer and -subtracted from by `view-mode-exit' when finished viewing the buffer. - -See RETURN-TO-ALIST argument of function `view-mode-exit' for the format of -`view-return-to-alist'.") -(make-obsolete-variable - 'view-return-to-alist "this variable is no longer used." "24.1") -(put 'view-return-to-alist 'permanent-local t) - (defvar-local view-exit-action nil "If non-nil, a function called when finished viewing. The function should take one argument (a buffer). @@ -476,40 +464,6 @@ Entry to view-mode runs the normal hook `view-mode-hook'." (if buffer-read-only (setq buffer-read-only view-old-buffer-read-only))) -;;;###autoload -(defun view-return-to-alist-update (buffer &optional item) - "Update `view-return-to-alist' of buffer BUFFER. -Remove from `view-return-to-alist' all entries referencing dead -windows. Optional argument ITEM non-nil means add ITEM to -`view-return-to-alist' after purging. For a description of items -that can be added see the RETURN-TO-ALIST argument of the -function `view-mode-exit'. If `view-return-to-alist' contains an -entry for the selected window, purge that entry from -`view-return-to-alist' before adding ITEM." - (declare (obsolete "this function has no effect." "24.1")) - (with-current-buffer buffer - (when view-return-to-alist - (let* ((list view-return-to-alist) - entry entry-window last) - (while list - (setq entry (car list)) - (setq entry-window (car entry)) - (if (and (windowp entry-window) - (or (and item (eq entry-window (selected-window))) - (not (window-live-p entry-window)))) - ;; Remove that entry. - (if last - (setcdr last (cdr list)) - (setq view-return-to-alist - (cdr view-return-to-alist))) - ;; Leave entry alone. - (setq last entry)) - (setq list (cdr list))))) - ;; Add ITEM. - (when item - (setq view-return-to-alist - (cons item view-return-to-alist))))) - ;;;###autoload (defun view-mode-enter (&optional quit-restore exit-action) "Enter View mode and set up exit from view mode depending on optional arguments. diff --git a/src/keyboard.c b/src/keyboard.c index 84a7a0a38a..a520e53397 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1305,9 +1305,6 @@ command_loop_1 (void) /* If there are warnings waiting, process them. */ if (!NILP (Vdelayed_warnings_list)) safe_run_hooks (Qdelayed_warnings_hook); - - if (!NILP (Vdeferred_action_list)) - safe_run_hooks (Qdeferred_action_function); } /* Do this after running Vpost_command_hook, for consistency. */ @@ -1537,8 +1534,6 @@ command_loop_1 (void) if (!NILP (Vdelayed_warnings_list)) safe_run_hooks (Qdelayed_warnings_hook); - safe_run_hooks (Qdeferred_action_function); - kset_last_command (current_kboard, Vthis_command); kset_real_last_command (current_kboard, Vreal_this_command); if (!CONSP (last_command_event)) @@ -12089,7 +12084,6 @@ syms_of_keyboard (void) DEFSYM (Qundo_auto__undoably_changed_buffers, "undo-auto--undoably-changed-buffers"); - DEFSYM (Qdeferred_action_function, "deferred-action-function"); DEFSYM (Qdelayed_warnings_hook, "delayed-warnings-hook"); DEFSYM (Qfunction_key, "function-key"); @@ -12807,17 +12801,6 @@ This keymap works like `input-decode-map', but comes after `function-key-map'. Another difference is that it is global rather than terminal-local. */); Vkey_translation_map = Fmake_sparse_keymap (Qnil); - DEFVAR_LISP ("deferred-action-list", Vdeferred_action_list, - doc: /* List of deferred actions to be performed at a later time. -The precise format isn't relevant here; we just check whether it is nil. */); - Vdeferred_action_list = Qnil; - - DEFVAR_LISP ("deferred-action-function", Vdeferred_action_function, - doc: /* Function to call to handle deferred actions, after each command. -This function is called with no arguments after each command -whenever `deferred-action-list' is non-nil. */); - Vdeferred_action_function = Qnil; - DEFVAR_LISP ("delayed-warnings-list", Vdelayed_warnings_list, doc: /* List of warnings to be displayed after this command. Each element must be a list (TYPE MESSAGE [LEVEL [BUFFER-NAME]]), @@ -13072,7 +13055,6 @@ syms_of_keyboard_for_pdumper (void) PDUMPER_RESET (num_input_keys, 0); PDUMPER_RESET (num_nonmacro_input_events, 0); PDUMPER_RESET_LV (Vlast_event_frame, Qnil); - PDUMPER_RESET_LV (Vdeferred_action_list, Qnil); PDUMPER_RESET_LV (Vdelayed_warnings_list, Qnil); /* Create the initial keyboard. Qt means 'unset'. */ diff --git a/src/w32fns.c b/src/w32fns.c index 468073c917..51540e1880 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -797,13 +797,6 @@ w32_default_color_map (void) return (cmap); } -DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map, - 0, 0, 0, doc: /* Return the default color map. */) - (void) -{ - return w32_default_color_map (); -} - static Lisp_Object w32_color_map_lookup (const char *colorname) { @@ -10879,7 +10872,6 @@ keys when IME input is received. */); /* W32 specific functions */ defsubr (&Sw32_define_rgb_color); - defsubr (&Sw32_default_color_map); defsubr (&Sw32_display_monitor_attributes_list); defsubr (&Sw32_send_sys_command); defsubr (&Sw32_shell_execute); commit ca7b5dbfcac36be79e2e1d3a7fb3d14c5404d7ca Author: Stefan Kangas Date: Fri Jul 8 13:07:39 2022 +0200 Put safe-local-variable property on auto-insert * lisp/autoinsert.el (auto-insert): Put safe-local-variable property to allow disabling auto-inserting without a warning. diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el index c12c554498..29d10bc629 100644 --- a/lisp/autoinsert.el +++ b/lisp/autoinsert.el @@ -67,7 +67,7 @@ Possible values: other insert if possible, but mark as unmodified. Insertion is possible when something appropriate is found in `auto-insert-alist'. When the insertion is marked as unmodified, you can -save it with \\[write-file] RET. +save it with \\[write-file] \\`RET'. This variable is used when the function `auto-insert' is called, e.g. when you do (add-hook \\='find-file-hook \\='auto-insert). With \\[auto-insert], this is always treated as if it were t." @@ -76,6 +76,9 @@ With \\[auto-insert], this is always treated as if it were t." (other :tag "insert if possible, mark as unmodified." not-modified))) +;;;###autoload +(put 'auto-insert 'safe-local-variable #'null) + (defcustom auto-insert-query 'function "Non-nil means ask user before auto-inserting. When this is `function', only ask when called non-interactively." commit 9abf841429257a3e1008bedc4d857ea7a25ab9a6 Author: Stefan Kangas Date: Fri Jul 8 12:04:17 2022 +0200 Stop ffap-machine-at-point from pinging random hosts Having this on by default is highly problematic from a security and privacy standpoint, as it risks having outgoing traffic that could potentially reveal sensitive data (passwords, names, etc.). It also seems to be causing issues for users, see e.g. https://github.com/emacs-helm/helm/issues/648 * lisp/ffap.el (ffap-machine-p-known): Change default to 'accept'. diff --git a/etc/NEWS b/etc/NEWS index 39c3aabb11..226af8d7d6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2042,6 +2042,12 @@ back the old behavior. This command prompts for a recently opened file in the minibuffer, and visits it. +--- +*** 'ffap-machine-at-point' no longer pings hosts by default. +It will now simply look at a hostname to determine if it is valid, +instead of also trying to ping it. Customize the user option +'ffap-machine-p-known' to 'ping' to get the old behavior back. + --- *** The 'run-dig' command is now obsolete; use 'dig' instead. diff --git a/lisp/ffap.el b/lisp/ffap.el index 20929c659d..65e0779e40 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1,6 +1,6 @@ ;;; ffap.el --- find file (or url) at point -*- lexical-binding: t -*- -;; Copyright (C) 1995-1997, 2000-2022 Free Software Foundation, Inc. +;; Copyright (C) 1995-2022 Free Software Foundation, Inc. ;; Author: Michelangelo Grigni ;; Maintainer: emacs-devel@gnu.org @@ -394,7 +394,7 @@ Value should be a symbol, one of `ping', `accept', and `reject'." :safe #'ffap--accept-or-reject-p :group 'ffap) -(defcustom ffap-machine-p-known 'ping ; `accept' for higher speed +(defcustom ffap-machine-p-known 'accept "What `ffap-machine-p' does with hostnames that have a known domain. Value should be a symbol, one of `ping', `accept', and `reject'. See `mail-extr.el' for the known domains." @@ -402,7 +402,8 @@ See `mail-extr.el' for the known domains." (const accept) (const reject)) :safe #'ffap--accept-or-reject-p - :group 'ffap) + :group 'ffap + :version "29.1") (defcustom ffap-machine-p-unknown 'reject "What `ffap-machine-p' does with hostnames that have an unknown domain. commit 38697a07c0f2b99b76c41cb1096543681342a405 Author: Stefan Kangas Date: Fri Jul 8 11:30:32 2022 +0200 Add :safe property to ffap-machine-p-* variables * lisp/ffap.el (ffap--accept-or-reject-p): New predicate defun. (ffap-machine-p-local, ffap-machine-p-known) (ffap-machine-p-unknown): Add :safe property using above new predicate. diff --git a/lisp/ffap.el b/lisp/ffap.el index 8628222936..20929c659d 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -377,6 +377,11 @@ Actual search is done by the function `ffap-next-guess'." ;;; Machines (`ffap-machine-p'): +(defun ffap--accept-or-reject-p (symbol) + "Return non-nil if SYMBOL is `accept' or `reject'. +Otherwise, return nil." + (memq symbol '(accept reject))) + ;; I cannot decide a "best" strategy here, so these are variables. In ;; particular, if `Pinging...' is broken or takes too long on your ;; machine, try setting these all to accept or reject. @@ -385,16 +390,20 @@ Actual search is done by the function `ffap-next-guess'." Value should be a symbol, one of `ping', `accept', and `reject'." :type '(choice (const ping) (const accept) - (const reject)) + (const reject)) + :safe #'ffap--accept-or-reject-p :group 'ffap) + (defcustom ffap-machine-p-known 'ping ; `accept' for higher speed "What `ffap-machine-p' does with hostnames that have a known domain. Value should be a symbol, one of `ping', `accept', and `reject'. See `mail-extr.el' for the known domains." :type '(choice (const ping) (const accept) - (const reject)) + (const reject)) + :safe #'ffap--accept-or-reject-p :group 'ffap) + (defcustom ffap-machine-p-unknown 'reject "What `ffap-machine-p' does with hostnames that have an unknown domain. Value should be a symbol, one of `ping', `accept', and `reject'. @@ -402,6 +411,7 @@ See `mail-extr.el' for the known domains." :type '(choice (const ping) (const accept) (const reject)) + :safe #'ffap--accept-or-reject-p :group 'ffap) (defun ffap-what-domain (domain) commit f85683c434ffdb72b4c33bd5231b08d288a0b9b2 Author: Stefan Kangas Date: Fri Jul 8 11:02:17 2022 +0200 Add tests for mail-extr.el * test/lisp/mail/mail-extr-tests.el: New file. diff --git a/test/lisp/mail/mail-extr-tests.el b/test/lisp/mail/mail-extr-tests.el new file mode 100644 index 0000000000..a8f0c605cb --- /dev/null +++ b/test/lisp/mail/mail-extr-tests.el @@ -0,0 +1,41 @@ +;;; mail-extr-tests.el --- Tests for mail-extr.el -*- lexical-binding: t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'mail-extr) + +(defconst mail-extract-test-cases + '(("foo@example.org" . (nil "foo@example.org")) + ("J. Random Hacker " . ("J. Random Hacker" "foo@example.org")) + ("\"J. Random Hacker\" " . ("J. Random Hacker" "foo@example.org")) + ("Ååå Äää " . ("Ååå Äää" "foo@example.org")))) + +(ert-deftest mail-extract-address-components () + (dolist (test mail-extract-test-cases) + (should (equal (mail-extract-address-components (car test)) (cdr test))))) + +(ert-deftest what-domain () + (should (equal (what-domain "cu") "CU: Cuba"))) + +(provide 'mail-extr-tests) +;;; mail-extr-tests.el ends here commit c4e251103b98ffb1bc1e8ddb54c7d9e08e71edc1 Author: Stefan Kangas Date: Fri Jul 8 10:35:31 2022 +0200 ; * lisp/textmodes/rst.el: Update URLs. diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 9d3e9effe6..104812f43c 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -48,10 +48,10 @@ ;; the contents of this package and how to use it. ;; ;; For more information about reStructuredText, see -;; http://docutils.sourceforge.net/rst.html +;; https://docutils.sourceforge.io/rst.html ;; ;; For full details on how to use the contents of this file, see -;; http://docutils.sourceforge.net/docs/user/emacs.html +;; https://docutils.sourceforge.io/docs/user/emacs.html ;; ;; There are a number of convenient key bindings provided by rst-mode. For the ;; bindings, try C-c C-h when in rst-mode. There are also many variables that @@ -72,7 +72,7 @@ ;;; DOWNLOAD ;; The latest release of this file lies in the docutils source code repository: -;; http://docutils.svn.sourceforge.net/svnroot/docutils/trunk/docutils/tools/editors/emacs/rst.el +;; https://sourceforge.net/p/docutils/code/HEAD/tree/trunk/docutils/tools/editors/emacs/rst.el ;;; INSTALLATION @@ -81,7 +81,7 @@ ;; (require 'rst) ;; ;; If you are using `.txt' as a standard extension for reST files as -;; http://docutils.sourceforge.net/FAQ.html#what-s-the-standard-filename-extension-for-a-restructuredtext-file +;; https://docutils.sourceforge.io/FAQ.html#what-s-the-standard-filename-extension-for-a-restructuredtext-file ;; suggests you may use one of the `Local Variables in Files' mechanism Emacs ;; provides to set the major mode automatically. For instance you may use:: ;; @@ -274,7 +274,7 @@ in parentheses follows the development revision and the time stamp.") (defgroup rst nil "Support for reStructuredText documents." :group 'text :version "23.1" - :link '(url-link "http://docutils.sourceforge.net/rst.html")) + :link '(url-link "https://docutils.sourceforge.io/rst.html")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -3786,7 +3786,7 @@ of your own." (defvar rst-font-lock-keywords ;; The reST-links in the comments below all relate to sections in - ;; http://docutils.sourceforge.net/docs/ref/rst/restructuredtext.html. + ;; https://docutils.sourceforge.io/docs/ref/rst/restructuredtext.html. `(;; FIXME: Block markup is not recognized in blocks after explicit markup ;; start. @@ -4402,7 +4402,7 @@ buffer, if the region is not selected." ;; FIXME: Add `rst-compile-html-preview'. -;; FIXME: Add support for `restview` (http://mg.pov.lt/restview/). May be a +;; FIXME: Add support for `restview` (https://mg.pov.lt/restview/). May be a ;; more general facility for calling commands on a reST file would make ;; sense. commit 989908eee8d78d70c5e475a9cb1bb710d7b54b5f Author: Stefan Kangas Date: Fri Jul 8 10:26:35 2022 +0200 Avoid obsolete initial-input argument in net-utils.el * lisp/net/net-utils.el (ping, nslookup-host, dns-lookup-host) (run-dig, ftp, smbclient, smbclient-list-shares, finger) (network-connection-to-service): Don't use obsolete initial-input argument. Use 'format-prompt'. (Bug#56436) diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el index b74400cd96..c7ff175e08 100644 --- a/lisp/net/net-utils.el +++ b/lisp/net/net-utils.el @@ -430,7 +430,8 @@ This variable is only used if the variable If your system's ping continues until interrupted, you can try setting `ping-program-options'." (interactive - (list (read-from-minibuffer "Ping host: " (ffap-machine-at-point)))) + (list (let ((default (ffap-machine-at-point))) + (read-string (format-prompt "Ping host" default) nil nil default)))) (let ((options (if ping-program-options (append ping-program-options (list host)) @@ -463,7 +464,8 @@ See also: `nslookup-host-ipv4', `nslookup-host-ipv6' for non-interactive versions of this function more suitable for use in Lisp code." (interactive - (list (read-from-minibuffer "Lookup host: " (ffap-machine-at-point)) + (list (let ((default (ffap-machine-at-point))) + (read-string (format-prompt "Lookup host" default) nil nil default)) (if current-prefix-arg (read-from-minibuffer "Name server: ")))) (let ((options (append nslookup-program-options (list host) @@ -575,7 +577,8 @@ Interactively, prompt for NAME-SERVER if invoked with prefix argument. This command uses `dns-lookup-program' for looking up the DNS information." (interactive - (list (read-from-minibuffer "Lookup host: " (ffap-machine-at-point)) + (list (let ((default (ffap-machine-at-point))) + (read-string (format-prompt "Lookup host" default) nil nil default)) (if current-prefix-arg (read-from-minibuffer "Name server: ")))) (let ((options (append dns-lookup-program-options (list host) @@ -599,7 +602,8 @@ Interactively, prompt for NAME-SERVER if invoked with prefix argument. This command uses `dig-program' for looking up the DNS information." (declare (obsolete dig "29.1")) (interactive - (list (read-from-minibuffer "Lookup host: " (ffap-machine-at-point)) + (list (let ((default (ffap-machine-at-point))) + (read-string (format-prompt "Lookup host" default) nil nil default)) (if current-prefix-arg (read-from-minibuffer "Name server: ")))) (dig host nil nil nil nil name-server)) @@ -611,9 +615,8 @@ This command uses `dig-program' for looking up the DNS information." (defun ftp (host) "Run `ftp-program' to connect to HOST." (interactive - (list - (read-from-minibuffer - "Ftp to Host: " (ffap-machine-at-point)))) + (list (let ((default (ffap-machine-at-point))) + (read-string (format-prompt "Ftp to Host" default) nil nil default)))) (let ((buf (get-buffer-create (concat "*ftp [" host "]*")))) (set-buffer buf) (ftp-mode) @@ -648,8 +651,8 @@ This command uses `dig-program' for looking up the DNS information." This command uses `smbclient-program' to connect to HOST." (interactive (list - (read-from-minibuffer - "Connect to Host: " (ffap-machine-at-point)) + (let ((default (ffap-machine-at-point))) + (read-string (format-prompt "Connect to Host" default) nil nil default)) (read-from-minibuffer "SMB Service: "))) (let* ((name (format "smbclient [%s\\%s]" host service)) (buf (get-buffer-create (concat "*" name "*"))) @@ -667,8 +670,8 @@ This command uses `smbclient-program' to connect to HOST." This command uses `smbclient-program' to connect to HOST." (interactive (list - (read-from-minibuffer - "Connect to Host: " (ffap-machine-at-point)))) + (let ((default (ffap-machine-at-point))) + (read-string (format-prompt "Connect to Host" default) nil nil default)))) (let ((buf (get-buffer-create (format "*SMB Shares on %s*" host)))) (set-buffer buf) (smbclient-mode) @@ -767,15 +770,15 @@ and `network-connection-service-alist', which see." ;; uses a string like "pbreton@cs.umb.edu", we won't ask for the ;; host name. If we don't see an "@", we'll prompt for the host. (interactive - (let* ((answer (read-from-minibuffer "Finger User: " - (ffap-url-at-point))) + (let* ((answer (let ((default (ffap-url-at-point))) + (read-string (format-prompt "Finger User" default) nil nil default))) (index (string-match (regexp-quote "@") answer))) (if index (list (substring answer 0 index) (substring answer (1+ index))) (list answer - (read-from-minibuffer "At Host: " - (ffap-machine-at-point)))))) + (let ((default (ffap-machine-at-point))) + (read-string (format-prompt "At Host" default) nil nil default)))))) (let* ((user-and-host (concat user "@" host)) (process-name (concat "Finger [" user-and-host "]")) (regexps finger-X.500-host-regexps) @@ -908,7 +911,8 @@ The port is deduced from `network-connection-service-alist'." This command uses `network-connection-service-alist', which see." (interactive (list - (read-from-minibuffer "Host: " (ffap-machine-at-point)) + (let ((default (ffap-machine-at-point))) + (read-string (format-prompt "Host" default) nil nil default)) (completing-read "Service: " (mapcar (lambda (elt) commit 0fc9808dedc24e843bfbbfe3d3a3930167873fa7 Author: Po Lu Date: Fri Jul 8 07:34:45 2022 +0000 Improve behavior of sticky tooltips on Haiku * src/haiku_support.cc (class EmacsView, MouseMoved): Remove `tooltip_position'. (class EmacsMotionSuppressionView): New class. (BView_set_and_show_sticky_tooltip): Rename to `be_show_sticky_tooltip'. Add motion suppression view. * src/haiku_support.h: Update prototypes. * src/haikufns.c (Fx_show_tip): Update for renamed function. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 332321e2db..a3d3b7a17d 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -1517,7 +1517,6 @@ class EmacsView : public BView BLocker cr_surface_lock; #endif - BPoint tooltip_position; BMessage *wait_for_release_message; EmacsView () : BView (BRect (0, 0, 0, 0), "Emacs", @@ -1797,11 +1796,8 @@ class EmacsView : public BView struct haiku_mouse_motion_event rq; int32 windowid; EmacsWindow *window; - BToolTip *tooltip; - BPoint target_tooltip_position; window = (EmacsWindow *) Window (); - tooltip = ToolTip (); if (transit == B_EXITED_VIEW) rq.just_exited_p = true; @@ -1821,16 +1817,6 @@ class EmacsView : public BView else rq.dnd_message = false; - if (tooltip) - { - target_tooltip_position - = BPoint (-(point.x - tooltip_position.x), - -(point.y - tooltip_position.y)); - tooltip->SetMouseRelativeLocation (target_tooltip_position); - tooltip->SetSticky (true); - ShowToolTip (tooltip); - } - if (!grab_view_locker.Lock ()) gui_abort ("Couldn't lock grab view locker"); @@ -3282,6 +3268,41 @@ class EmacsFilePanelCallbackLooper : public BLooper } }; +/* A view that is added as a child of a tooltip's text view, and + prevents motion events from reaching it (thereby moving the + tooltip). */ +class EmacsMotionSuppressionView : public BView +{ + void + AttachedToWindow (void) + { + BView *text_view, *tooltip_view; + + /* We know that this view is a child of the text view, whose + parent is the tooltip view, and that the tooltip view has + already set its mouse event mask. */ + + text_view = Parent (); + + if (!text_view) + return; + + tooltip_view = text_view->Parent (); + + if (!tooltip_view) + return; + + tooltip_view->SetEventMask (B_KEYBOARD_EVENTS, 0); + } + +public: + EmacsMotionSuppressionView (void) : BView (BRect (-1, -1, 1, 1), + NULL, 0, 0) + { + return; + } +}; + static int32 start_running_application (void *data) { @@ -4320,36 +4341,46 @@ BView_set_tooltip (void *view, const char *tooltip) /* Set VIEW's tooltip to a sticky tooltip at X by Y. */ void -BView_set_and_show_sticky_tooltip (void *view, const char *tooltip_text, - int x, int y) +be_show_sticky_tooltip (void *view, const char *tooltip_text, + int x, int y) { BToolTip *tooltip; - BView *vw; - EmacsView *ev; - BPoint pt; + BView *vw, *tooltip_view; + BPoint point; vw = (BView *) view; if (!vw->LockLooper ()) gui_abort ("Failed to lock view while showing sticky tooltip"); + vw->SetToolTip ((const char *) NULL); + + /* If the tooltip text is empty, then a tooltip object won't be + created by SetToolTip. */ + if (tooltip_text[0] == '\0') + tooltip_text = " "; + vw->SetToolTip (tooltip_text); + tooltip = vw->ToolTip (); - ev = dynamic_cast (vw); + vw->GetMouse (&point, NULL, 1); + point.x -= x; + point.y -= y; - if (ev) - ev->tooltip_position = BPoint (x, y); + point.x = -point.x; + point.y = -point.y; - vw->GetMouse (&pt, NULL, 1); - pt.x -= x; - pt.y -= y; + /* We don't have to make the tooltip sticky since not receiving + mouse movement is enough to prevent it from being hidden. */ + tooltip->SetMouseRelativeLocation (point); - pt.x = -pt.x; - pt.y = -pt.y; + /* Prevent the tooltip from moving in response to mouse + movement. */ + tooltip_view = tooltip->View (); - tooltip->SetMouseRelativeLocation (pt); - tooltip->SetSticky (true); + if (tooltip_view) + tooltip_view->AddChild (new EmacsMotionSuppressionView); vw->ShowToolTip (tooltip); vw->UnlockLooper (); diff --git a/src/haiku_support.h b/src/haiku_support.h index d73f15560b..5f44494a8d 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -648,8 +648,7 @@ extern int32 BAlert_go (void *, void (*) (void), void (*) (void), extern void BButton_set_enabled (void *, int); extern void BView_set_tooltip (void *, const char *); extern void BView_show_tooltip (void *); -extern void BView_set_and_show_sticky_tooltip (void *, const char *, - int, int); +extern void be_show_sticky_tooltip (void *, const char *, int, int); extern void BAlert_delete (void *); diff --git a/src/haikufns.c b/src/haikufns.c index 878917eeef..e0a65b499f 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -2392,8 +2392,8 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, reliable way to get it. */ compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y); BView_convert_from_screen (FRAME_HAIKU_VIEW (f), &root_x, &root_y); - BView_set_and_show_sticky_tooltip (FRAME_HAIKU_VIEW (f), SSDATA (string), - root_x, root_y); + be_show_sticky_tooltip (FRAME_HAIKU_VIEW (f), SSDATA (string), + root_x, root_y); unblock_input (); goto start_timer; } commit bc015a7b44ab0803cfc35f69987eb28d9f4597e1 Author: Po Lu Date: Fri Jul 8 06:55:01 2022 +0000 Fix flickering system tooltips on Haiku * src/haiku_support.cc (class EmacsView, MouseMoved): Restore sticky status and mouse relative position. (BView_set_and_show_sticky_tooltip): * src/haikufns.c (haiku_hide_tip): Fix coding style. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 9e38d9556f..332321e2db 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -1517,7 +1517,7 @@ class EmacsView : public BView BLocker cr_surface_lock; #endif - BPoint tt_absl_pos; + BPoint tooltip_position; BMessage *wait_for_release_message; EmacsView () : BView (BRect (0, 0, 0, 0), "Emacs", @@ -1798,11 +1798,16 @@ class EmacsView : public BView int32 windowid; EmacsWindow *window; BToolTip *tooltip; + BPoint target_tooltip_position; window = (EmacsWindow *) Window (); tooltip = ToolTip (); - rq.just_exited_p = transit == B_EXITED_VIEW; + if (transit == B_EXITED_VIEW) + rq.just_exited_p = true; + else + rq.just_exited_p = false; + rq.x = point.x; rq.y = point.y; rq.window = window; @@ -1817,8 +1822,14 @@ class EmacsView : public BView rq.dnd_message = false; if (tooltip) - tooltip->SetMouseRelativeLocation (BPoint (-(point.x - tt_absl_pos.x), - -(point.y - tt_absl_pos.y))); + { + target_tooltip_position + = BPoint (-(point.x - tooltip_position.x), + -(point.y - tooltip_position.y)); + tooltip->SetMouseRelativeLocation (target_tooltip_position); + tooltip->SetSticky (true); + ShowToolTip (tooltip); + } if (!grab_view_locker.Lock ()) gui_abort ("Couldn't lock grab view locker"); @@ -4309,19 +4320,26 @@ BView_set_tooltip (void *view, const char *tooltip) /* Set VIEW's tooltip to a sticky tooltip at X by Y. */ void -BView_set_and_show_sticky_tooltip (void *view, const char *tooltip, +BView_set_and_show_sticky_tooltip (void *view, const char *tooltip_text, int x, int y) { - BToolTip *tip; - BView *vw = (BView *) view; + BToolTip *tooltip; + BView *vw; + EmacsView *ev; + BPoint pt; + + vw = (BView *) view; + if (!vw->LockLooper ()) gui_abort ("Failed to lock view while showing sticky tooltip"); - vw->SetToolTip (tooltip); - tip = vw->ToolTip (); - BPoint pt; - EmacsView *ev = dynamic_cast (vw); + + vw->SetToolTip (tooltip_text); + tooltip = vw->ToolTip (); + + ev = dynamic_cast (vw); + if (ev) - ev->tt_absl_pos = BPoint (x, y); + ev->tooltip_position = BPoint (x, y); vw->GetMouse (&pt, NULL, 1); pt.x -= x; @@ -4330,9 +4348,10 @@ BView_set_and_show_sticky_tooltip (void *view, const char *tooltip, pt.x = -pt.x; pt.y = -pt.y; - tip->SetMouseRelativeLocation (pt); - tip->SetSticky (1); - vw->ShowToolTip (tip); + tooltip->SetMouseRelativeLocation (pt); + tooltip->SetSticky (true); + + vw->ShowToolTip (tooltip); vw->UnlockLooper (); } diff --git a/src/haikufns.c b/src/haikufns.c index b79443203f..878917eeef 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -1290,16 +1290,17 @@ compute_tip_xy (struct frame *f, static Lisp_Object haiku_hide_tip (bool delete) { + Lisp_Object it, frame; + if (!NILP (tip_timer)) { call1 (Qcancel_timer, tip_timer); tip_timer = Qnil; } - Lisp_Object it, frame; FOR_EACH_FRAME (it, frame) - if (FRAME_WINDOW_P (XFRAME (frame)) && - FRAME_HAIKU_VIEW (XFRAME (frame))) + if (FRAME_WINDOW_P (XFRAME (frame)) + && FRAME_HAIKU_VIEW (XFRAME (frame))) BView_set_tooltip (FRAME_HAIKU_VIEW (XFRAME (frame)), NULL); if (NILP (tip_frame) commit eb86a375e8ca75c297a1408aa6aa918f92914614 Author: Po Lu Date: Fri Jul 8 13:41:50 2022 +0800 Reduce synchronization setting frame alpha * src/xterm.c (x_set_frame_alpha): Don't synchronize while setting alpha property, and don't ask for the current value of the opacity property, which is much more expensive than changing it. diff --git a/src/xterm.c b/src/xterm.c index 094449e1d5..9651c4e119 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -6450,20 +6450,6 @@ x_set_frame_alpha (struct frame *f) unsigned long opac; Window parent; -#ifndef USE_XCB - unsigned char *data = NULL; - Atom actual; - int rc, format; - unsigned long n, left; - unsigned long value; -#else - xcb_get_property_cookie_t opacity_cookie; - xcb_get_property_reply_t *opacity_reply; - xcb_generic_error_t *error; - bool rc; - uint32_t value; -#endif - if (dpyinfo->highlight_frame == f) alpha = f->alpha[0]; else @@ -6484,8 +6470,6 @@ x_set_frame_alpha (struct frame *f) opac = alpha * OPAQUE; - x_catch_errors (dpy); - /* If there is a parent from the window manager, put the property there also, to work around broken window managers that fail to do that. Do this unconditionally as this function is called on reparent when @@ -6494,77 +6478,23 @@ x_set_frame_alpha (struct frame *f) if (!FRAME_PARENT_FRAME (f)) { parent = x_find_topmost_parent (f); + if (parent != None) - XChangeProperty (dpy, parent, dpyinfo->Xatom_net_wm_window_opacity, - XA_CARDINAL, 32, PropModeReplace, - (unsigned char *) &opac, 1); + { + x_ignore_errors_for_next_request (dpyinfo); + XChangeProperty (dpy, parent, + dpyinfo->Xatom_net_wm_window_opacity, + XA_CARDINAL, 32, PropModeReplace, + (unsigned char *) &opac, 1); + x_stop_ignoring_errors (dpyinfo); + } } - /* return unless necessary */ - { -#ifndef USE_XCB - rc = XGetWindowProperty (dpy, win, dpyinfo->Xatom_net_wm_window_opacity, - 0, 1, False, XA_CARDINAL, - &actual, &format, &n, &left, - &data); - - if (rc == Success && actual != None - && n && format == XA_CARDINAL && data) - { - value = *(unsigned long *) data; - - /* Xlib sign-extends values greater than 0x7fffffff on 64-bit - machines. Get the low bits by ourself. */ - - value &= 0xffffffff; - - if (value == opac) - { - x_uncatch_errors (); - XFree (data); - return; - } - } - - if (data) - XFree (data); -#else - /* Avoid the confusing Xlib sign-extension mess by using XCB - instead. */ - opacity_cookie - = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) win, - (xcb_atom_t) dpyinfo->Xatom_net_wm_window_opacity, - XCB_ATOM_CARDINAL, 0, 1); - opacity_reply - = xcb_get_property_reply (dpyinfo->xcb_connection, - opacity_cookie, &error); - - rc = opacity_reply; - - if (!opacity_reply) - free (error); - else - { - rc = (opacity_reply->format == 32 - && opacity_reply->type == XCB_ATOM_CARDINAL - && (xcb_get_property_value_length (opacity_reply) >= 4)); - - if (rc) - value = *(uint32_t *) xcb_get_property_value (opacity_reply); - } - - if (opacity_reply) - free (opacity_reply); - - if (rc && value == opac) - return; -#endif - } - + x_ignore_errors_for_next_request (dpyinfo); XChangeProperty (dpy, win, dpyinfo->Xatom_net_wm_window_opacity, XA_CARDINAL, 32, PropModeReplace, (unsigned char *) &opac, 1); - x_uncatch_errors (); + x_stop_ignoring_errors (dpyinfo); } /*********************************************************************** commit 7397d0fd1910aee37c287bb02c5bb2b7811be860 Merge: b6a90b71a2 2ac0ddc4ac Author: Stefan Kangas Date: Fri Jul 8 06:31:54 2022 +0200 Merge from origin/emacs-28 2ac0ddc4ac ; * lisp/net/net-utils.el: Minor doc fixes. commit b6a90b71a2e421d3eef52d4d9e9a82592b7ad277 Author: Po Lu Date: Fri Jul 8 10:44:49 2022 +0800 Fix returned action symbol upon "xterm" drop * src/xterm.c (x_dnd_do_unsupported_drop): Set x_dnd_action_symbol. (x_dnd_begin_drag_and_drop): Don't clear it afterwards. diff --git a/src/xterm.c b/src/xterm.c index d057bbf06c..094449e1d5 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -3921,6 +3921,8 @@ x_dnd_do_unsupported_drop (struct x_display_info *dpyinfo, True, ButtonReleaseMask, &event); x_stop_ignoring_errors (dpyinfo); + x_dnd_action_symbol = QXdndActionPrivate; + return; cancel: @@ -11873,8 +11875,7 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, XFIXNUM (Fnth (make_fixnum (4), x_dnd_unsupported_drop_data)), x_dnd_unsupported_drop_time); - - if (SYMBOLP (val)) + else if (SYMBOLP (val)) x_dnd_action_symbol = val; x_dnd_unwind_flag = false; commit 139eb1f845d1ec3e2a26aec5d7fafbcdcbaa5f07 Author: Stefan Kangas Date: Thu Jul 7 23:19:03 2022 +0200 * lisp/emacs-lisp/ert.el (Commentary): Refer to the Info manual. diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 262d85f9b4..21bee4c6d8 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1,6 +1,6 @@ ;;; ert.el --- Emacs Lisp Regression Testing -*- lexical-binding: t -*- -;; Copyright (C) 2007-2008, 2010-2022 Free Software Foundation, Inc. +;; Copyright (C) 2007-2022 Free Software Foundation, Inc. ;; Author: Christian Ohler ;; Keywords: lisp, tools @@ -46,12 +46,10 @@ ;; processing further, this is useful for checking the test ;; environment (like availability of features, external binaries, etc). ;; -;; See ERT's info manual as well as the docstrings for more details. -;; -;; To see some examples of tests written in ERT, see its self-tests in -;; ert-tests.el. Some of these are tricky due to the bootstrapping -;; problem of writing tests for a testing tool, others test simple -;; functions and are straightforward. +;; See ERT's Info manual `(ert) Top' as well as the docstrings for +;; more details. To see some examples of tests written in ERT, see +;; the test suite distributed with the Emacs source distribution (in +;; the "test" directory). ;;; Code: commit cbfd959e26da13ae872ee11a1c8365abd6906d96 Author: Stefan Kangas Date: Thu Jul 7 17:25:39 2022 +0200 Prefer keymap inheritance in shr-image-map * lisp/net/shr.el (shr-image-map): Replace copy-keymap with inheritance. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 63f313bbf4..c4f0d3b940 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -290,11 +290,10 @@ and other things: "O" #'shr-save-contents "RET" #'shr-browse-url) -(defvar shr-image-map - (let ((map (copy-keymap shr-map))) - (when (boundp 'image-map) - (set-keymap-parent map image-map)) - map)) +(defvar-keymap shr-image-map + :parent (if (boundp 'image-map) + (make-composed-keymap shr-map image-map) + shr-map)) ;; Public functions and commands. (declare-function libxml-parse-html-region "xml.c" commit a371298d2a2fd1c24f29c6c4ca8026a62f5bdd33 Author: Lars Ingebrigtsen Date: Thu Jul 7 20:21:38 2022 +0200 Make imenu--create-keymap more resilient * lisp/imenu.el (imenu--create-keymap): Ignore nil items in the alist (bug#56430). diff --git a/lisp/imenu.el b/lisp/imenu.el index 040e373fb4..dcd816cb7a 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -471,7 +471,7 @@ Non-nil arguments are in recursive calls." (t (lambda () (interactive) (if cmd (funcall cmd item) item)))))) - alist))) + (seq-filter #'identity alist)))) (defun imenu--in-alist (str alist) "Check whether the string STR is contained in multi-level ALIST." commit d397b0421567e4e52bccfa15dc23f4a9b8e6e9f0 Author: Eli Zaretskii Date: Thu Jul 7 19:34:30 2022 +0300 Fix buffer-tests * test/src/buffer-tests.el (test-restore-buffer-modified-p): Don't assume turning on auto-save-mode cannot auto-save immediately. diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index 13d48b31a4..cba10a0502 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -1503,9 +1503,12 @@ with parameters from the *Messages* buffer modification." (ert-deftest test-restore-buffer-modified-p () (ert-with-temp-file file + ;; This avoids the annoying "foo and bar are the same file" on + ;; MS-Windows. + (setq file (file-truename file)) (with-current-buffer (find-file file) (auto-save-mode 1) - (should-not (buffer-modified-p)) + (should-not (eq (buffer-modified-p) t)) (insert "foo") (should (buffer-modified-p)) (restore-buffer-modified-p nil) @@ -1522,9 +1525,10 @@ with parameters from the *Messages* buffer modification." (delete-file buffer-auto-save-file-name)))) (ert-with-temp-file file + (setq file (file-truename file)) (with-current-buffer (find-file file) (auto-save-mode 1) - (should-not (buffer-modified-p)) + (should-not (eq (buffer-modified-p) t)) (insert "foo") (should (buffer-modified-p)) (should-not (eq (buffer-modified-p) 'autosaved)) commit 53c0690fa28f338071703f1567d2d1c4054416f0 Author: Mattias Engdegård Date: Wed Jan 26 12:30:39 2022 +0100 Faster append and vconcat By separating the code paths for append and vconcat, each becomes simpler and faster. * src/fns.c (concat_strings): Rename to... (concat_to_string): ...this. (concat): Split into concat_to_list and concat_to_vector. (concat_to_list, concat_to_vector): New, specialised and streamlined from earlier combined code. (concat2, concat3, Fappend, Fconcat, Fvconcat): Adjust calls. diff --git a/src/fns.c b/src/fns.c index f30b2f6fb3..f4ba67b40e 100644 --- a/src/fns.c +++ b/src/fns.c @@ -589,20 +589,21 @@ Do NOT use this function to compare file names for equality. */) #endif /* !__STDC_ISO_10646__, !WINDOWSNT */ } -static Lisp_Object concat (ptrdiff_t nargs, Lisp_Object *args, - Lisp_Object last_tail, bool vector_target); -static Lisp_Object concat_strings (ptrdiff_t nargs, Lisp_Object *args); +static Lisp_Object concat_to_list (ptrdiff_t nargs, Lisp_Object *args, + Lisp_Object last_tail); +static Lisp_Object concat_to_vector (ptrdiff_t nargs, Lisp_Object *args); +static Lisp_Object concat_to_string (ptrdiff_t nargs, Lisp_Object *args); Lisp_Object concat2 (Lisp_Object s1, Lisp_Object s2) { - return concat_strings (2, ((Lisp_Object []) {s1, s2})); + return concat_to_string (2, ((Lisp_Object []) {s1, s2})); } Lisp_Object concat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3) { - return concat_strings (3, ((Lisp_Object []) {s1, s2, s3})); + return concat_to_string (3, ((Lisp_Object []) {s1, s2, s3})); } DEFUN ("append", Fappend, Sappend, 0, MANY, 0, @@ -615,7 +616,7 @@ usage: (append &rest SEQUENCES) */) { if (nargs == 0) return Qnil; - return concat (nargs - 1, args, args[nargs - 1], false); + return concat_to_list (nargs - 1, args, args[nargs - 1]); } DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0, @@ -628,7 +629,7 @@ to be `eq'. usage: (concat &rest SEQUENCES) */) (ptrdiff_t nargs, Lisp_Object *args) { - return concat_strings (nargs, args); + return concat_to_string (nargs, args); } DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0, @@ -638,7 +639,7 @@ Each argument may be a list, vector or string. usage: (vconcat &rest SEQUENCES) */) (ptrdiff_t nargs, Lisp_Object *args) { - return concat (nargs, args, Qnil, true); + return concat_to_vector (nargs, args); } @@ -706,8 +707,8 @@ the same empty object instead of its copy. */) wrong_type_argument (Qsequencep, arg); } -/* This structure holds information of an argument of `concat_strings' that is - a string and has text properties to be copied. */ +/* This structure holds information of an argument of `concat_to_string' + that is a string and has text properties to be copied. */ struct textprop_rec { ptrdiff_t argnum; /* refer to ARGS (arguments of `concat') */ @@ -716,7 +717,7 @@ struct textprop_rec }; static Lisp_Object -concat_strings (ptrdiff_t nargs, Lisp_Object *args) +concat_to_string (ptrdiff_t nargs, Lisp_Object *args) { USE_SAFE_ALLOCA; @@ -912,19 +913,100 @@ concat_strings (ptrdiff_t nargs, Lisp_Object *args) return result; } -/* Concatenate sequences into a list or vector. */ +/* Concatenate sequences into a list. */ +Lisp_Object +concat_to_list (ptrdiff_t nargs, Lisp_Object *args, Lisp_Object last_tail) +{ + /* Copy the contents of the args into the result. */ + Lisp_Object result = Qnil; + Lisp_Object last = Qnil; /* Last cons in result if nonempty. */ + + for (ptrdiff_t i = 0; i < nargs; i++) + { + Lisp_Object arg = args[i]; + /* List arguments are treated specially since this is the common case. */ + if (CONSP (arg)) + { + Lisp_Object head = Fcons (XCAR (arg), Qnil); + Lisp_Object prev = head; + arg = XCDR (arg); + FOR_EACH_TAIL (arg) + { + Lisp_Object next = Fcons (XCAR (arg), Qnil); + XSETCDR (prev, next); + prev = next; + } + CHECK_LIST_END (arg, arg); + if (NILP (result)) + result = head; + else + XSETCDR (last, head); + last = prev; + } + else if (NILP (arg)) + ; + else if (VECTORP (arg) || STRINGP (arg) + || BOOL_VECTOR_P (arg) || COMPILEDP (arg)) + { + ptrdiff_t arglen = XFIXNUM (Flength (arg)); + ptrdiff_t argindex_byte = 0; + /* Copy element by element. */ + for (ptrdiff_t argindex = 0; argindex < arglen; argindex++) + { + /* Fetch next element of `arg' arg into `elt', or break if + `arg' is exhausted. */ + Lisp_Object elt; + if (STRINGP (arg)) + { + int c; + if (STRING_MULTIBYTE (arg)) + { + ptrdiff_t char_idx = argindex; + c = fetch_string_char_advance_no_check (arg, &char_idx, + &argindex_byte); + } + else + c = SREF (arg, argindex); + elt = make_fixed_natnum (c); + } + else if (BOOL_VECTOR_P (arg)) + elt = bool_vector_ref (arg, argindex); + else + elt = AREF (arg, argindex); + + /* Store this element into the result. */ + Lisp_Object node = Fcons (elt, Qnil); + if (NILP (result)) + result = node; + else + XSETCDR (last, node); + last = node; + } + } + else + wrong_type_argument (Qsequencep, arg); + } + + if (NILP (result)) + result = last_tail; + else + XSETCDR (last, last_tail); + + return result; +} + +/* Concatenate sequences into a vector. */ Lisp_Object -concat (ptrdiff_t nargs, Lisp_Object *args, Lisp_Object last_tail, - bool vector_target) +concat_to_vector (ptrdiff_t nargs, Lisp_Object *args) { /* Check argument types and compute total length of arguments. */ EMACS_INT result_len = 0; for (ptrdiff_t i = 0; i < nargs; i++) { Lisp_Object arg = args[i]; - if (!(CONSP (arg) || NILP (arg) || VECTORP (arg) || STRINGP (arg) - || COMPILEDP (arg) || BOOL_VECTOR_P (arg))) + if (!(VECTORP (arg) || CONSP (arg) || NILP (arg) || STRINGP (arg) + || BOOL_VECTOR_P (arg) || COMPILEDP (arg))) wrong_type_argument (Qsequencep, arg); EMACS_INT len = XFIXNAT (Flength (arg)); result_len += len; @@ -932,90 +1014,61 @@ concat (ptrdiff_t nargs, Lisp_Object *args, Lisp_Object last_tail, memory_full (SIZE_MAX); } - /* When the target is a list, return the tail directly if all other - arguments are empty. */ - if (!vector_target && result_len == 0) - return last_tail; - - /* Create the output object. */ - Lisp_Object result = vector_target - ? make_nil_vector (result_len) - : Fmake_list (make_fixnum (result_len), Qnil); + /* Create the output vector. */ + Lisp_Object result = make_uninit_vector (result_len); + Lisp_Object *dst = XVECTOR (result)->contents; /* Copy the contents of the args into the result. */ - Lisp_Object tail = Qnil; - ptrdiff_t toindex = 0; - if (CONSP (result)) - { - tail = result; - toindex = -1; /* -1 in toindex is flag we are making a list */ - } - - Lisp_Object prev = Qnil; for (ptrdiff_t i = 0; i < nargs; i++) { - ptrdiff_t arglen = 0; - ptrdiff_t argindex = 0; - ptrdiff_t argindex_byte = 0; - Lisp_Object arg = args[i]; - if (!CONSP (arg)) - arglen = XFIXNUM (Flength (arg)); - - /* Copy element by element. */ - while (1) + if (VECTORP (arg)) { - /* Fetch next element of `arg' arg into `elt', or break if - `arg' is exhausted. */ - Lisp_Object elt; - if (CONSP (arg)) - { - elt = XCAR (arg); - arg = XCDR (arg); - } - else if (NILP (arg) || argindex >= arglen) - break; - else if (STRINGP (arg)) + ptrdiff_t size = ASIZE (arg); + memcpy (dst, XVECTOR (arg)->contents, size * sizeof *dst); + dst += size; + } + else if (CONSP (arg)) + do + { + *dst++ = XCAR (arg); + arg = XCDR (arg); + } + while (!NILP (arg)); + else if (NILP (arg)) + ; + else if (STRINGP (arg)) + { + ptrdiff_t size = SCHARS (arg); + if (STRING_MULTIBYTE (arg)) { - int c; - if (STRING_MULTIBYTE (arg)) - c = fetch_string_char_advance_no_check (arg, &argindex, - &argindex_byte); - else + ptrdiff_t byte = 0; + for (ptrdiff_t i = 0; i < size;) { - c = SREF (arg, argindex); - argindex++; + int c = fetch_string_char_advance_no_check (arg, &i, &byte); + *dst++ = make_fixnum (c); } - XSETFASTINT (elt, c); - } - else if (BOOL_VECTOR_P (arg)) - { - elt = bool_vector_ref (arg, argindex); - argindex++; - } - else - { - elt = AREF (arg, argindex); - argindex++; - } - - /* Store this element into the result. */ - if (toindex < 0) - { - XSETCAR (tail, elt); - prev = tail; - tail = XCDR (tail); } else - { - ASET (result, toindex, elt); - toindex++; - } + for (ptrdiff_t i = 0; i < size; i++) + *dst++ = make_fixnum (SREF (arg, i)); + } + else if (BOOL_VECTOR_P (arg)) + { + ptrdiff_t size = bool_vector_size (arg); + for (ptrdiff_t i = 0; i < size; i++) + *dst++ = bool_vector_ref (arg, i); + } + else + { + eassert (COMPILEDP (arg)); + ptrdiff_t size = PVSIZE (arg); + memcpy (dst, XVECTOR (arg)->contents, size * sizeof *dst); + dst += size; } } - if (!NILP (prev)) - XSETCDR (prev, last_tail); + eassert (dst == XVECTOR (result)->contents + result_len); return result; } commit 9cd72b02b67e92e89b83791b66fe40c4b50d8357 Author: Alan Mackenzie Date: Thu Jul 7 15:38:09 2022 +0000 Remove obscure, obsolete code from do_switch_frame This is relevant for bug #56305, and might solve that bug. The code being removed went into Emacs between 1992 and 1994, and looks to have been a workaround for switching frames, before the command 'other-frame' had been written. Nowadays, that code has harmful effects, causing frames' focus to be redirected at random, sometimes back to the frame itself. * src/frame.c (do_switch_frame): Remove 53 lines of code. diff --git a/src/frame.c b/src/frame.c index 02c90ea651..4828595b93 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1477,59 +1477,6 @@ do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object nor else if (f == sf) return frame; - /* If a frame's focus has been redirected toward the currently - selected frame, we should change the redirection to point to the - newly selected frame. This means that if the focus is redirected - from a minibufferless frame to a surrogate minibuffer frame, we - can use `other-window' to switch between all the frames using - that minibuffer frame, and the focus redirection will follow us - around. */ -#if 0 - /* This is too greedy; it causes inappropriate focus redirection - that's hard to get rid of. */ - if (track) - { - Lisp_Object tail; - - for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail)) - { - Lisp_Object focus; - - if (!FRAMEP (XCAR (tail))) - emacs_abort (); - - focus = FRAME_FOCUS_FRAME (XFRAME (XCAR (tail))); - - if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ()) - Fredirect_frame_focus (XCAR (tail), frame); - } - } -#else /* ! 0 */ - /* Instead, apply it only to the frame we're pointing to. */ -#ifdef HAVE_WINDOW_SYSTEM - if (track && FRAME_WINDOW_P (f) && FRAME_TERMINAL (f)->get_focus_frame) - { - Lisp_Object focus, gfocus; - - gfocus = FRAME_TERMINAL (f)->get_focus_frame (f); - if (FRAMEP (gfocus)) - { - focus = FRAME_FOCUS_FRAME (XFRAME (gfocus)); - if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ()) - /* Redirect frame focus also when FRAME has its minibuffer - window on the selected frame (see Bug#24500). - - Don't do that: It causes redirection problem with a - separate minibuffer frame (Bug#24803) and problems - when updating the cursor on such frames. - || (NILP (focus) - && EQ (FRAME_MINIBUF_WINDOW (f), sf->selected_window))) */ - Fredirect_frame_focus (gfocus, frame); - } - } -#endif /* HAVE_X_WINDOWS */ -#endif /* ! 0 */ - if (!for_deletion && FRAME_HAS_MINIBUF_P (sf)) resize_mini_window (XWINDOW (FRAME_MINIBUF_WINDOW (sf)), 1); commit f32808ce98d0612bc5ad949f41563001768ab87a Author: Stefan Kangas Date: Thu Jul 7 15:32:48 2022 +0200 * lisp/net/dig.el (dig): Provide default. diff --git a/lisp/net/dig.el b/lisp/net/dig.el index 0ac6399e87..7157d0cb58 100644 --- a/lisp/net/dig.el +++ b/lisp/net/dig.el @@ -154,10 +154,12 @@ for the QUERY-TYPE parameter. If given a \\[universal-argument] \\[universal-argument] \ prefix, also prompt for the SERVER parameter." (interactive - (list (read-string "Host: ") + (list (let ((default (ffap-machine-at-point))) + (read-string (format-prompt "Host" default) nil nil default)) (and current-prefix-arg (read-string "Query type: ")))) - (when (>= (car current-prefix-arg) 16) + (when (and (numberp (car current-prefix-arg)) + (>= (car current-prefix-arg) 16)) (let ((serv (read-from-minibuffer "Name server: "))) (when (not (equal serv "")) (setq server serv)))) commit 6d95b4e6ec35c11820e5733a3a13c05d2debc68a Author: Stefan Kangas Date: Thu Jul 7 14:54:16 2022 +0200 Make net-utils-url at point funs obsolete in favor of ffap * lisp/net/net-utils.el (net-utils-machine-at-point) (net-utils-url-at-point): Redefine as obsolete function alias for 'ffap-machine-at-point' and 'ffap-url-at-point'. Update callers. * lisp/ffap.el (ffap-machine-at-point, ffap-url-at-point): Autoload. diff --git a/lisp/ffap.el b/lisp/ffap.el index ae86e55490..8628222936 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -544,6 +544,7 @@ The optional NOMODIFY argument suppresses the extra search." (string-match ffap-rfs-regexp filename) filename))) +;;;###autoload (defun ffap-machine-at-point () "Return machine name at point if it exists, or nil." (let ((mach (ffap-string-at-point 'machine))) @@ -1329,6 +1330,7 @@ Assumes the buffer has not changed." ;; External. (declare-function w3-view-this-url "ext:w3" (&optional no-show)) +;;;###autoload (defun ffap-url-at-point () "Return URL from around point if it exists, or nil. diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el index 016fdec921..ab7770e04a 100644 --- a/lisp/net/net-utils.el +++ b/lisp/net/net-utils.el @@ -280,31 +280,6 @@ This variable is only used if the variable ;; Utility functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Simplified versions of some at-point functions from ffap.el. -;; It's not worth loading all of ffap just for these. -(defun net-utils-machine-at-point () - (let ((pt (point))) - (buffer-substring-no-properties - (save-excursion - (skip-chars-backward "-a-zA-Z0-9.") - (point)) - (save-excursion - (skip-chars-forward "-a-zA-Z0-9.") - (skip-chars-backward "." pt) - (point))))) - -(defun net-utils-url-at-point () - (let ((pt (point))) - (buffer-substring-no-properties - (save-excursion - (skip-chars-backward "--:=&?$+@-Z_a-z~#,%") - (skip-chars-forward "^A-Za-z0-9" pt) - (point)) - (save-excursion - (skip-chars-forward "--:=&?$+@-Z_a-z~#,%") - (skip-chars-backward ":;.,!?" pt) - (point))))) - (defun net-utils-remove-ctrl-m-filter (process output-string) "Remove trailing control Ms." (with-current-buffer (process-buffer process) @@ -456,7 +431,7 @@ This variable is only used if the variable If your system's ping continues until interrupted, you can try setting `ping-program-options'." (interactive - (list (read-from-minibuffer "Ping host: " (net-utils-machine-at-point)))) + (list (read-from-minibuffer "Ping host: " (ffap-machine-at-point)))) (let ((options (if ping-program-options (append ping-program-options (list host)) @@ -489,7 +464,7 @@ See also: `nslookup-host-ipv4', `nslookup-host-ipv6' for non-interactive versions of this function more suitable for use in Lisp code." (interactive - (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point)) + (list (read-from-minibuffer "Lookup host: " (ffap-machine-at-point)) (if current-prefix-arg (read-from-minibuffer "Name server: ")))) (let ((options (append nslookup-program-options (list host) @@ -601,7 +576,7 @@ Interactively, prompt for NAME-SERVER if invoked with prefix argument. This command uses `dns-lookup-program' for looking up the DNS information." (interactive - (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point)) + (list (read-from-minibuffer "Lookup host: " (ffap-machine-at-point)) (if current-prefix-arg (read-from-minibuffer "Name server: ")))) (let ((options (append dns-lookup-program-options (list host) @@ -625,7 +600,7 @@ Interactively, prompt for NAME-SERVER if invoked with prefix argument. This command uses `dig-program' for looking up the DNS information." (declare (obsolete dig "29.1")) (interactive - (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point)) + (list (read-from-minibuffer "Lookup host: " (ffap-machine-at-point)) (if current-prefix-arg (read-from-minibuffer "Name server: ")))) (dig host nil nil nil nil name-server)) @@ -639,7 +614,7 @@ This command uses `dig-program' for looking up the DNS information." (interactive (list (read-from-minibuffer - "Ftp to Host: " (net-utils-machine-at-point)))) + "Ftp to Host: " (ffap-machine-at-point)))) (let ((buf (get-buffer-create (concat "*ftp [" host "]*")))) (set-buffer buf) (ftp-mode) @@ -675,7 +650,7 @@ This command uses `smbclient-program' to connect to HOST." (interactive (list (read-from-minibuffer - "Connect to Host: " (net-utils-machine-at-point)) + "Connect to Host: " (ffap-machine-at-point)) (read-from-minibuffer "SMB Service: "))) (let* ((name (format "smbclient [%s\\%s]" host service)) (buf (get-buffer-create (concat "*" name "*"))) @@ -694,7 +669,7 @@ This command uses `smbclient-program' to connect to HOST." (interactive (list (read-from-minibuffer - "Connect to Host: " (net-utils-machine-at-point)))) + "Connect to Host: " (ffap-machine-at-point)))) (let ((buf (get-buffer-create (format "*SMB Shares on %s*" host)))) (set-buffer buf) (smbclient-mode) @@ -794,14 +769,14 @@ and `network-connection-service-alist', which see." ;; host name. If we don't see an "@", we'll prompt for the host. (interactive (let* ((answer (read-from-minibuffer "Finger User: " - (net-utils-url-at-point))) + (ffap-url-at-point))) (index (string-match (regexp-quote "@") answer))) (if index (list (substring answer 0 index) (substring answer (1+ index))) (list answer (read-from-minibuffer "At Host: " - (net-utils-machine-at-point)))))) + (ffap-machine-at-point)))))) (let* ((user-and-host (concat user "@" host)) (process-name (concat "Finger [" user-and-host "]")) (regexps finger-X.500-host-regexps) @@ -934,7 +909,7 @@ The port is deduced from `network-connection-service-alist'." This command uses `network-connection-service-alist', which see." (interactive (list - (read-from-minibuffer "Host: " (net-utils-machine-at-point)) + (read-from-minibuffer "Host: " (ffap-machine-at-point)) (completing-read "Service: " (mapcar (lambda (elt) @@ -987,6 +962,9 @@ This command uses `network-connection-service-alist', which see." (and old-comint-input-ring (setq comint-input-ring old-comint-input-ring))))) +(define-obsolete-function-alias 'net-utils-machine-at-point #'ffap-machine-at-point "29.1") +(define-obsolete-function-alias 'net-utils-url-at-point #'ffap-url-at-point "29.1") + (provide 'net-utils) ;;; net-utils.el ends here commit 1fa5f0428fc9f141d7ae9973a9cc92c3e6a2b623 Author: Po Lu Date: Thu Jul 7 21:12:49 2022 +0800 Fix selection disowning upon frame deletion on Wayland * src/pgtkselect.c (pgtk_clear_frame_selections): Manually disown cleared selections. (bug#56434) diff --git a/src/pgtkselect.c b/src/pgtkselect.c index fff163c92a..e0230003b3 100644 --- a/src/pgtkselect.c +++ b/src/pgtkselect.c @@ -790,8 +790,8 @@ pgtk_handle_selection_event (struct selection_input_event *event) void pgtk_clear_frame_selections (struct frame *f) { - Lisp_Object frame; - Lisp_Object rest; + Lisp_Object frame, rest, timestamp, symbol; + guint32 time; struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); struct terminal *t = dpyinfo->terminal; @@ -801,9 +801,22 @@ pgtk_clear_frame_selections (struct frame *f) while (CONSP (t->Vselection_alist) && EQ (frame, XCAR (XCDR (XCDR (XCDR (XCAR (t->Vselection_alist))))))) { + symbol = Fcar (Fcar (t->Vselection_alist)); + /* Run the `pgtk-lost-selection-functions' abnormal hook. */ CALLN (Frun_hook_with_args, Qpgtk_lost_selection_functions, - Fcar (Fcar (t->Vselection_alist))); + symbol); + + timestamp = Fcar (Fcdr (Fcdr (Fcar (t->Vselection_alist)))); + CONS_TO_INTEGER (timestamp, guint32, time); + + /* On Wayland, GDK will still ask the (now non-existent) frame for + selection data, even though we no longer think the selection is + owned by us. Manually relinquish ownership of the selection. */ + gdk_selection_owner_set_for_display (dpyinfo->display, + NULL, + symbol_to_gdk_atom (symbol), + time, TRUE); tset_selection_alist (t, XCDR (t->Vselection_alist)); } @@ -813,8 +826,18 @@ pgtk_clear_frame_selections (struct frame *f) if (CONSP (XCDR (rest)) && EQ (frame, XCAR (XCDR (XCDR (XCDR (XCAR (XCDR (rest)))))))) { + symbol = XCAR (XCAR (XCDR (rest))); CALLN (Frun_hook_with_args, Qpgtk_lost_selection_functions, - XCAR (XCAR (XCDR (rest)))); + symbol); + + timestamp = XCAR (XCDR (XCDR (XCAR (XCDR (rest))))); + CONS_TO_INTEGER (timestamp, guint32, time); + + gdk_selection_owner_set_for_display (dpyinfo->display, + NULL, + symbol_to_gdk_atom (symbol), + time, TRUE); + XSETCDR (rest, XCDR (XCDR (rest))); break; } commit 0aa0dac799d692bac36a379c40bd178cff6cb80b Author: Stefan Kangas Date: Thu Jul 7 14:43:46 2022 +0200 * lisp/net/eww.el (eww-browse-url): Add 'browser-kind' property. diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 1671e062b2..995a755135 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1207,6 +1207,8 @@ instead of `browse-url-new-window-flag'." (let ((url-allow-non-local-files t)) (eww url))) +(function-put 'eww-browse-url 'browse-url-browser-kind 'internal) + (defun eww-back-url () "Go to the previously displayed page." (interactive nil eww-mode) commit 49b10a95c3b7e5bf61b881d34467e0b5f4c68eca Author: Stefan Kangas Date: Thu Jul 7 13:21:07 2022 +0200 * lisp/woman.el (woman): Fix comment; don't mention gnudoit. diff --git a/lisp/woman.el b/lisp/woman.el index 73e068a822..6bb775115a 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -1151,7 +1151,7 @@ updated (e.g. to re-interpret the current directory). Used non-interactively, arguments are optional: if given then TOPIC should be a topic string and non-nil RE-CACHE forces re-caching." (interactive (list nil current-prefix-arg)) - ;; The following test is for non-interactive calls via gnudoit etc. + ;; The following test is for non-interactive calls via emacsclient, etc. (if (or (not (stringp topic)) (string-match-p "\\S " topic)) (let ((file-name (woman-file-name topic re-cache))) (if file-name commit 9155f2ada3e2a290a0d0bfc99ee0a0426902f6df Author: Stefan Kangas Date: Thu Jul 7 13:18:01 2022 +0200 Make two XEmacs related variables obsolete * lisp/net/browse-url.el (browse-url-gnudoit-program) (browse-url-gnudoit-args): Make obsolete. The corresponding command 'browse-url-w3-gnudoit' is already obsolete since 25.1. diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 1cfe90895f..7cffe3e32e 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -437,11 +437,13 @@ These might set its size, for instance." (defcustom browse-url-gnudoit-program "gnudoit" "The name of the `gnudoit' program used by `browse-url-w3-gnudoit'." :type 'string) +(make-obsolete-variable 'browse-url-gnudoit-program nil "29.1") (defcustom browse-url-gnudoit-args '("-q") "A list of strings defining options for `browse-url-gnudoit-program'. These might set the port, for instance." :type '(repeat (string :tag "Argument"))) +(make-obsolete-variable 'browse-url-gnudoit-args nil "29.1") (defcustom browse-url-generic-program nil "The name of the browser program used by `browse-url-generic'." commit 59a798b3f0bd91e6112c080a8c80c22998e8ee3e Author: Po Lu Date: Thu Jul 7 20:16:43 2022 +0800 Fix GTK build * src/xterm.c (x_dnd_begin_drag_and_drop): Update GTK quitting code for last change too. Reported by Norbert Koch . diff --git a/src/xterm.c b/src/xterm.c index 98a5beed17..d057bbf06c 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -11889,55 +11889,10 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, if (xg_pending_quit_event.kind != NO_EVENT) { xg_pending_quit_event.kind = NO_EVENT; - - if (x_dnd_in_progress) - { - if (x_dnd_last_seen_window != None - && x_dnd_last_protocol_version != -1) - x_dnd_send_leave (f, x_dnd_last_seen_window); - else if (x_dnd_last_seen_window != None - && !XM_DRAG_STYLE_IS_DROP_ONLY (x_dnd_last_motif_style) - && x_dnd_last_motif_style != XM_DRAG_STYLE_NONE - && x_dnd_motif_setup_p) - { - dmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, - XM_DRAG_REASON_DROP_START); - dmsg.byte_order = XM_BYTE_ORDER_CUR_FIRST; - dmsg.timestamp = xg_pending_quit_event.timestamp; - dmsg.side_effects - = XM_DRAG_SIDE_EFFECT (xm_side_effect_from_action (FRAME_DISPLAY_INFO (f), - x_dnd_wanted_action), - XM_DROP_SITE_VALID, x_dnd_motif_operations, - XM_DROP_ACTION_DROP_CANCEL); - dmsg.x = 0; - dmsg.y = 0; - dmsg.index_atom = x_dnd_motif_atom; - dmsg.source_window = FRAME_X_WINDOW (f); - - x_dnd_send_xm_leave_for_drop (FRAME_DISPLAY_INFO (f), f, - x_dnd_last_seen_window, - xg_pending_quit_event.timestamp); - xm_send_drop_message (FRAME_DISPLAY_INFO (f), FRAME_X_WINDOW (f), - x_dnd_last_seen_window, &dmsg); - } - - x_dnd_end_window = x_dnd_last_seen_window; - x_dnd_last_seen_window = None; - x_dnd_last_seen_toplevel = None; - x_dnd_in_progress = false; - x_dnd_frame = NULL; - } - - x_dnd_waiting_for_finish = false; - x_dnd_return_frame_object = NULL; - x_dnd_movement_frame = NULL; - - FRAME_DISPLAY_INFO (f)->grabbed = 0; current_hold_quit = NULL; - /* Restore the old event mask. */ + x_dnd_process_quit (f, FRAME_DISPLAY_INFO (f)->last_user_time); x_restore_events_after_dnd (f, &root_window_attrs); - quit (); } #else commit 7a9f8ed6fba0d6728cbf185696bdc1a95b1acfea Author: Po Lu Date: Thu Jul 7 18:36:56 2022 +0800 Fix quitting out of selection converters during drag and drop * src/xterm.c (x_dnd_process_quit): New function. (x_dnd_begin_drag_and_drop): Use it instead. Also quit if quit-flag is true immediately after a selection converter is run. diff --git a/src/xterm.c b/src/xterm.c index a21daa2dfc..98a5beed17 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -11362,6 +11362,57 @@ x_dnd_lose_ownership (Lisp_Object timestamp_and_frame) XCDR (timestamp_and_frame)); } +/* Clean up an existing drag-and-drop operation in preparation for its + sudden termination. */ + +static void +x_dnd_process_quit (struct frame *f, Time timestamp) +{ + xm_drop_start_message dmsg; + + if (x_dnd_in_progress) + { + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1) + x_dnd_send_leave (f, x_dnd_last_seen_window); + else if (x_dnd_last_seen_window != None + && !XM_DRAG_STYLE_IS_DROP_ONLY (x_dnd_last_motif_style) + && x_dnd_last_motif_style != XM_DRAG_STYLE_NONE + && x_dnd_motif_setup_p) + { + dmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_DROP_START); + dmsg.byte_order = XM_BYTE_ORDER_CUR_FIRST; + dmsg.timestamp = timestamp; + dmsg.side_effects + = XM_DRAG_SIDE_EFFECT (xm_side_effect_from_action (FRAME_DISPLAY_INFO (f), + x_dnd_wanted_action), + XM_DROP_SITE_VALID, x_dnd_motif_operations, + XM_DROP_ACTION_DROP_CANCEL); + dmsg.x = 0; + dmsg.y = 0; + dmsg.index_atom = x_dnd_motif_atom; + dmsg.source_window = FRAME_X_WINDOW (f); + + x_dnd_send_xm_leave_for_drop (FRAME_DISPLAY_INFO (f), f, + x_dnd_last_seen_window, + timestamp); + xm_send_drop_message (FRAME_DISPLAY_INFO (f), FRAME_X_WINDOW (f), + x_dnd_last_seen_window, &dmsg); + } + + x_dnd_end_window = x_dnd_last_seen_window; + x_dnd_last_seen_window = None; + x_dnd_last_seen_toplevel = None; + x_dnd_in_progress = false; + x_dnd_frame = NULL; + } + + x_dnd_waiting_for_finish = false; + x_dnd_return_frame_object = NULL; + x_dnd_movement_frame = NULL; +} + /* This function is defined far away from the rest of the XDND code so it can utilize `x_any_window_to_frame'. */ @@ -11398,7 +11449,6 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, specpdl_ref ref, count, base; ptrdiff_t i, end, fill; XTextProperty prop; - xm_drop_start_message dmsg; Lisp_Object frame_object, x, y, frame, local_value; bool signals_were_pending, need_sync; #ifdef HAVE_XKB @@ -11750,50 +11800,7 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, if (hold_quit.kind != NO_EVENT) { - if (x_dnd_in_progress) - { - if (x_dnd_last_seen_window != None - && x_dnd_last_protocol_version != -1) - x_dnd_send_leave (f, x_dnd_last_seen_window); - else if (x_dnd_last_seen_window != None - && !XM_DRAG_STYLE_IS_DROP_ONLY (x_dnd_last_motif_style) - && x_dnd_last_motif_style != XM_DRAG_STYLE_NONE - && x_dnd_motif_setup_p) - { - dmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, - XM_DRAG_REASON_DROP_START); - dmsg.byte_order = XM_BYTE_ORDER_CUR_FIRST; - dmsg.timestamp = hold_quit.timestamp; - dmsg.side_effects - = XM_DRAG_SIDE_EFFECT (xm_side_effect_from_action (FRAME_DISPLAY_INFO (f), - x_dnd_wanted_action), - XM_DROP_SITE_VALID, x_dnd_motif_operations, - XM_DROP_ACTION_DROP_CANCEL); - dmsg.x = 0; - dmsg.y = 0; - dmsg.index_atom = x_dnd_motif_atom; - dmsg.source_window = FRAME_X_WINDOW (f); - - x_dnd_send_xm_leave_for_drop (FRAME_DISPLAY_INFO (f), f, - x_dnd_last_seen_window, - hold_quit.timestamp); - xm_send_drop_message (FRAME_DISPLAY_INFO (f), FRAME_X_WINDOW (f), - x_dnd_last_seen_window, &dmsg); - } - - x_dnd_end_window = x_dnd_last_seen_window; - x_dnd_last_seen_window = None; - x_dnd_last_seen_toplevel = None; - x_dnd_in_progress = false; - x_dnd_frame = NULL; - } - - x_dnd_waiting_for_finish = false; - x_dnd_return_frame_object = NULL; - x_dnd_movement_frame = NULL; - - /* Don't clear dpyinfo->grabbed if we're quitting. */ - + x_dnd_process_quit (f, hold_quit.timestamp); #ifdef USE_GTK current_hold_quit = NULL; #endif @@ -11821,6 +11828,19 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, unbind_to (ref, Qnil); } + /* Sometimes C-g can be pressed inside a selection + converter, where quitting is inhibited. We want + to quit after the converter exits. */ + if (!NILP (Vquit_flag) && !NILP (Vinhibit_quit)) + { + x_dnd_process_quit (f, FRAME_DISPLAY_INFO (f)->last_user_time); +#ifdef USE_GTK + current_hold_quit = NULL; +#endif + x_restore_events_after_dnd (f, &root_window_attrs); + quit (); + } + if (x_dnd_run_unsupported_drop_function && x_dnd_waiting_for_finish) { commit a40a4d3a0964f0428033744f77b67376700e963f Author: Stefan Kangas Date: Thu Jul 7 12:05:35 2022 +0200 Mark comint modes in net-utils.el as non-interactive * lisp/net/net-utils.el (net-utils-mode, nslookup-mode, ftp-mode) (smbclient-mode, network-connection-mode): Mark as non-interactive. (nslookup-mode-map, ftp-mode-map): Prefer defvar-keymap. diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el index ea1dd0f3ca..016fdec921 100644 --- a/lisp/net/net-utils.el +++ b/lisp/net/net-utils.el @@ -271,6 +271,7 @@ This variable is only used if the variable (define-derived-mode net-utils-mode special-mode "NetworkUtil" "Major mode for interacting with an external network utility." + :interactive nil (setq-local font-lock-defaults '((net-utils-font-lock-keywords))) (setq-local revert-buffer-function #'net-utils--revert-function)) @@ -580,14 +581,12 @@ This command uses `nslookup-program' to look up DNS records." (autoload 'comint-mode "comint" nil t) -(defvar nslookup-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\t" #'completion-at-point) - map)) +(defvar-keymap nslookup-mode-map + "TAB" #'completion-at-point) -;; Using a derived mode gives us keymaps, hooks, etc. (define-derived-mode nslookup-mode comint-mode "Nslookup" "Major mode for interacting with the nslookup program." + :interactive nil (setq-local font-lock-defaults '((nslookup-font-lock-keywords))) (setq comint-prompt-regexp nslookup-prompt-regexp) @@ -650,14 +649,12 @@ This command uses `dig-program' for looking up the DNS information." (list host))) (pop-to-buffer buf))) -(defvar ftp-mode-map - (let ((map (make-sparse-keymap))) - ;; Occasionally useful - (define-key map "\t" #'completion-at-point) - map)) +(defvar-keymap ftp-mode-map + "TAB" #'completion-at-point) (define-derived-mode ftp-mode comint-mode "FTP" "Major mode for interacting with the ftp program." + :interactive nil (setq comint-prompt-regexp ftp-prompt-regexp) (setq comint-input-autoexpand t) ;; Only add the password-prompting hook if it's not already in the @@ -707,6 +704,7 @@ This command uses `smbclient-program' to connect to HOST." (define-derived-mode smbclient-mode comint-mode "smbclient" "Major mode for interacting with the smbclient program." + :interactive nil (setq comint-prompt-regexp smbclient-prompt-regexp) (setq comint-input-autoexpand t) ;; Only add the password-prompting hook if it's not already in the @@ -922,10 +920,9 @@ The port is deduced from `network-connection-service-alist'." ;;; General Network connection ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Using a derived mode gives us keymaps, hooks, etc. -(define-derived-mode - network-connection-mode comint-mode "Network-Connection" - "Major mode for interacting with the `network-connection' program.") +(define-derived-mode network-connection-mode comint-mode "Network-Connection" + "Major mode for interacting with the `network-connection' program." + :interactive nil) (defun network-connection-mode-setup (host service) (setq-local network-connection-host host) commit 2ac0ddc4ac406b04b258f535aaa09a0e3859953b Author: Stefan Kangas Date: Thu Jul 7 12:15:48 2022 +0200 ; * lisp/net/net-utils.el: Minor doc fixes. diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el index 411b6ed413..47b5271ef0 100644 --- a/lisp/net/net-utils.el +++ b/lisp/net/net-utils.el @@ -23,11 +23,10 @@ ;;; Commentary: -;; ;; There are three main areas of functionality: ;; ;; * Wrap common network utility programs (ping, traceroute, netstat, -;; nslookup, arp, route). Note that these wrappers are of the diagnostic +;; nslookup, arp, route). Note that these wrappers are of the diagnostic ;; functions of these programs only. ;; ;; * Implement some very basic protocols in Emacs Lisp (finger and whois) @@ -39,7 +38,7 @@ ;;; Code: ;; On some systems, programs like ifconfig are not in normal user -;; path, but rather in /sbin, /usr/sbin, etc (but non-root users can +;; path, but rather in /sbin, /usr/sbin, etc. (but non-root users can ;; still use them for queries). Actually the trend these ;; days is for /sbin to be a symlink to /usr/sbin, but we still need to ;; search both for older systems. commit 707124d2b92780b4f21d72c7c62899e074fa8ced Author: Stefan Kangas Date: Thu Jul 7 11:11:34 2022 +0200 Make 'run-dig' command obsolete in favor of 'dig' * lisp/net/net-utils.el (run-dig): Redefine in terms of `dig' and make obsolete. (Bug#56432). (dig-program): Delete duplicate defcustom; it is also in dig.el. (dig-program-options): Move from here... * lisp/net/dig.el (dig-program-options): ...to here. (dig-invoke): Respect 'dig-program-options'. (dig): Prompt for DNS server when given double prefix argument. diff --git a/etc/NEWS b/etc/NEWS index 2013260c15..39c3aabb11 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2042,6 +2042,9 @@ back the old behavior. This command prompts for a recently opened file in the minibuffer, and visits it. +--- +*** The 'run-dig' command is now obsolete; use 'dig' instead. + --- ** The autoarg.el library is now marked obsolete. This library provides the 'autoarg-mode' and 'autoarg-kp-mode' minor diff --git a/lisp/net/dig.el b/lisp/net/dig.el index 81ddade109..0ac6399e87 100644 --- a/lisp/net/dig.el +++ b/lisp/net/dig.el @@ -44,6 +44,11 @@ "Name of dig (domain information groper) binary." :type 'file) +(defcustom dig-program-options nil + "Options for the dig program." + :type '(repeat string) + :version "26.1") + (defcustom dig-dns-server nil "DNS server to query. If nil, use system defaults." @@ -59,8 +64,8 @@ If nil, use system defaults." :type 'sexp) (defun dig-invoke (domain &optional - query-type query-class query-option - dig-option server) + query-type query-class query-option + dig-option server) "Call dig with given arguments and return buffer containing output. DOMAIN is a string with a DNS domain. QUERY-TYPE is an optional string with a DNS type. QUERY-CLASS is an optional string with a DNS @@ -79,7 +84,8 @@ and is a commonly available debugging tool." (push domain cmdline) (if server (push (concat "@" server) cmdline) (if dig-dns-server (push (concat "@" dig-dns-server) cmdline))) - (apply #'call-process dig-program nil buf nil cmdline) + (apply #'call-process dig-program nil buf nil + (append dig-program-options cmdline)) buf)) (defun dig-extract-rr (domain &optional type class) @@ -140,12 +146,21 @@ Buffer should contain output generated by `dig-invoke'." query-type query-class query-option dig-option server) "Query addresses of a DOMAIN using dig. See `dig-invoke' for an explanation for the parameters. -When called interactively, DOMAIN is prompted for. If given a prefix, -also prompt for the QUERY-TYPE parameter." +When called interactively, DOMAIN is prompted for. + +If given a \\[universal-argument] prefix, also prompt \ +for the QUERY-TYPE parameter. + +If given a \\[universal-argument] \\[universal-argument] \ +prefix, also prompt for the SERVER parameter." (interactive (list (read-string "Host: ") (and current-prefix-arg (read-string "Query type: ")))) + (when (>= (car current-prefix-arg) 16) + (let ((serv (read-from-minibuffer "Name server: "))) + (when (not (equal serv "")) + (setq server serv)))) (pop-to-buffer-same-window (dig-invoke domain query-type query-class query-option dig-option server)) (goto-char (point-min)) diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el index 411b6ed413..ea1dd0f3ca 100644 --- a/lisp/net/net-utils.el +++ b/lisp/net/net-utils.el @@ -176,15 +176,6 @@ This variable is only used if the variable `comint-use-prompt-regexp' is non-nil." :type 'regexp) -(defcustom dig-program "dig" - "Program to query DNS information." - :type 'string) - -(defcustom dig-program-options nil - "Options for the dig program." - :type '(repeat string) - :version "26.1") - (defcustom ftp-program "ftp" "Program to run to do FTP transfers." :type 'string) @@ -633,20 +624,11 @@ DNS resolution. Interactively, prompt for NAME-SERVER if invoked with prefix argument. This command uses `dig-program' for looking up the DNS information." + (declare (obsolete dig "29.1")) (interactive (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point)) (if current-prefix-arg (read-from-minibuffer "Name server: ")))) - (let ((options - (append dig-program-options (list host) - (if name-server (list (concat "@" name-server)))))) - (net-utils-run-program - "Dig" - (concat "** " - (mapconcat #'identity - (list "Dig" host dig-program) - " ** ")) - dig-program - options))) + (dig host nil nil nil nil name-server)) (autoload 'comint-exec "comint") (declare-function comint-watch-for-password-prompt "comint" (string)) commit 74f43f82e6b4702027d99edb6ca125f3243ce4ba Author: Eli Zaretskii Date: Thu Jul 7 11:56:31 2022 +0300 Fix undo of changes in cloned indirect buffers * lisp/simple.el (primitive-undo): If the visited-modtime of the indirect buffer's file is bogus, use the modtime of the file visited by its base buffer. * src/undo.c (record_first_change): Call 'buffer_visited_file_modtime' with the correct buffer, instead of always calling 'Fvisited_file_modtime', which returns possibly bogus values for indirect buffers. * src/fileio.c (Fset_visited_file_modtime): Signal a meaningful error for indirect buffers. (buffer_visited_file_modtime): New function, with implementation taken from 'Fvisited_file_modtime'. (Fvisited_file_modtime): Call 'buffer_visited_file_modtime'. * src/lisp.h: Add prototype for 'buffer_visited_file_modtime'. (Bug#56397) diff --git a/lisp/simple.el b/lisp/simple.el index 6313ce81ef..66640916a2 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -3525,12 +3525,22 @@ Return what remains of the list." ;; If this records an obsolete save ;; (not matching the actual disk file) ;; then don't mark unmodified. - (when (or (equal time (visited-file-modtime)) - (and (consp time) - (equal (list (car time) (cdr time)) - (visited-file-modtime)))) - (unlock-buffer) - (set-buffer-modified-p nil))) + (let ((visited-file-time (visited-file-modtime))) + ;; Indirect buffers don't have a visited file, so their + ;; file-modtime can be bogus. In that case, use the + ;; modtime of the base buffer instead. + (if (and (numberp visited-file-time) + (= visited-file-time 0) + (buffer-base-buffer)) + (setq visited-file-time + (with-current-buffer (buffer-base-buffer) + (visited-file-modtime)))) + (when (or (equal time visited-file-time) + (and (consp time) + (equal (list (car time) (cdr time)) + visited-file-time))) + (unlock-buffer) + (set-buffer-modified-p nil)))) ;; Element (nil PROP VAL BEG . END) is property change. (`(nil . ,(or `(,prop ,val ,beg . ,end) pcase--dontcare)) (when (or (> (point-min) beg) (< (point-max) end)) diff --git a/src/fileio.c b/src/fileio.c index 10d4b8bc15..d07e62a121 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -5832,6 +5832,15 @@ See Info node `(elisp)Modification Time' for more details. */) return Qnil; } +Lisp_Object +buffer_visited_file_modtime (struct buffer *buf) +{ + int ns = buf->modtime.tv_nsec; + if (ns < 0) + return make_fixnum (UNKNOWN_MODTIME_NSECS - ns); + return make_lisp_time (buf->modtime); +} + DEFUN ("visited-file-modtime", Fvisited_file_modtime, Svisited_file_modtime, 0, 0, 0, doc: /* Return the current buffer's recorded visited file modification time. @@ -5841,10 +5850,7 @@ visited file doesn't exist. See Info node `(elisp)Modification Time' for more details. */) (void) { - int ns = current_buffer->modtime.tv_nsec; - if (ns < 0) - return make_fixnum (UNKNOWN_MODTIME_NSECS - ns); - return make_lisp_time (current_buffer->modtime); + return buffer_visited_file_modtime (current_buffer); } DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, @@ -5871,6 +5877,8 @@ in `current-time' or an integer flag as returned by `visited-file-modtime'. */) current_buffer->modtime = mtime; current_buffer->modtime_size = -1; } + else if (current_buffer->base_buffer) + error ("An indirect buffer does not have a visited file"); else { register Lisp_Object filename; diff --git a/src/lisp.h b/src/lisp.h index e4a49b8ef9..35cc7f5a09 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4733,6 +4733,7 @@ extern bool internal_delete_file (Lisp_Object); extern Lisp_Object check_emacs_readlinkat (int, Lisp_Object, char const *); extern bool file_directory_p (Lisp_Object); extern bool file_accessible_directory_p (Lisp_Object); +extern Lisp_Object buffer_visited_file_modtime (struct buffer *); extern void init_fileio (void); extern void syms_of_fileio (void); diff --git a/src/undo.c b/src/undo.c index 36664d1642..f76977dbe5 100644 --- a/src/undo.c +++ b/src/undo.c @@ -218,7 +218,7 @@ record_first_change (void) base_buffer = base_buffer->base_buffer; bset_undo_list (current_buffer, - Fcons (Fcons (Qt, Fvisited_file_modtime ()), + Fcons (Fcons (Qt, buffer_visited_file_modtime (base_buffer)), BVAR (current_buffer, undo_list))); } commit b075a59a1a4ddfd0668da4fb2312a6ec747dd53b Author: Stefan Kangas Date: Thu Jul 7 10:38:45 2022 +0200 * lisp/net/dig.el (dig-exit): Mark for 'dig-mode'. diff --git a/lisp/net/dig.el b/lisp/net/dig.el index f7f1500454..81ddade109 100644 --- a/lisp/net/dig.el +++ b/lisp/net/dig.el @@ -132,7 +132,7 @@ Buffer should contain output generated by `dig-invoke'." (defun dig-exit () "Quit dig output buffer." - (interactive) + (interactive nil dig-mode) (quit-window t)) ;;;###autoload commit f703b64da0cb20dee42a47770f9d22ec335f29c2 Author: Visuwesh Date: Wed Jul 6 10:03:59 2022 +0530 Make the Indian itrans methods more phonetic The characters ऋ and ॠ are pronunced as ru in languages such as Marathi, Gujarati, Telugu, etc. so add new translation rules that reflects this sound. (bug#56414) * lisp/language/ind-util.el (indian-itrans-v5-table): Add new translation rules to make the input method more phonetic. (indian-tml-base-table, indian-tml-base-digits-table): Fix typo. diff --git a/lisp/language/ind-util.el b/lisp/language/ind-util.el index fa380dbde7..27facaa858 100644 --- a/lisp/language/ind-util.el +++ b/lisp/language/ind-util.el @@ -269,7 +269,7 @@ ?ய ?ர ?ற ?ல ?ள ?ழ ?வ ;; SEMIVOWELS ?ஶ ?ஷ ?ஸ ?ஹ ;; SIBILANTS nil nil nil nil nil nil nil nil ;; NUKTAS - "ஜ்ஞ" "க்ஷ" "க்‌ஷ்") + "ஜ்ஞ" "க்ஷ" "க்‌ஷ") (;; Misc Symbols nil ?ஂ ?ஃ nil ?் ?ௐ nil) (;; Digits @@ -292,7 +292,7 @@ ?ய ?ர ?ற ?ல ?ள ?ழ ?வ ;; SEMIVOWELS ?ஶ ?ஷ ?ஸ ?ஹ ;; SIBILANTS nil nil nil nil nil nil nil nil ;; NUKTAS - "ஜ்ஞ" "க்ஷ" "க்‌ஷ்") + "ஜ்ஞ" "க்ஷ" "க்‌ஷ") (;; Misc Symbols nil ?ஂ ?ஃ nil ?் ?ௐ nil) (;; Digits @@ -315,8 +315,8 @@ '(;; for encode/decode (;; vowels -- 18 "a" ("aa" "A") "i" ("ii" "I") "u" ("uu" "U") - ("RRi" "R^i") ("LLi" "L^i") (".c" "e.c") "E" "e" "ai" - "o.c" "O" "o" "au" ("RRI" "R^I") ("LLI" "L^I")) + ("RRi" "R^i" "RRu" "R^u") ("LLi" "L^i") (".c" "e.c") "E" "e" "ai" + "o.c" "O" "o" "au" ("RRI" "R^I" "RRU" "R^U") ("LLI" "L^I")) (;; consonants -- 40 "k" "kh" "g" "gh" ("~N" "N^") "ch" ("Ch" "chh") "j" "jh" ("~n" "JN") commit 455495b2154844f9f0e7465c9f0ccfc864c0290b Merge: e93aa8d586 6f872ea8e7 Author: Eli Zaretskii Date: Thu Jul 7 09:31:49 2022 +0300 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit 6f872ea8e70e777f07e19f3eb1ff0c77dcdcba63 Author: Juri Linkov Date: Thu Jul 7 09:31:02 2022 +0300 Don't accumulate trailing newlines on every save of .dir-locals.el * lisp/files-x.el (modify-dir-local-variable): Insert a newline only after creating a new file. (dir-locals-to-string): Remove newline to not add more newlines on every save. diff --git a/lisp/files-x.el b/lisp/files-x.el index a89fc26d60..8224a57450 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -502,12 +502,13 @@ from the MODE alist ignoring the input argument VALUE." ((and (symbolp (car b)) (stringp (car a))) nil) (t (string< (car a) (car b))))))) (current-buffer)) + (when (eobp) (insert "\n")) (goto-char (point-min)) (indent-sexp)))) (defun dir-locals-to-string (variables) "Output alists of VARIABLES to string in dotted pair notation syntax." - (format "(%s)\n" + (format "(%s)" (mapconcat (lambda (mode-variables) (format "(%S . %s)" commit e93aa8d58670f013b9a457e7136a6284f173a8ce Author: Eli Zaretskii Date: Thu Jul 7 09:29:51 2022 +0300 ; Improve documentation of 'set-transient-map' changes * lisp/subr.el (set-transient-map-timeout, set-transient-map): Doc fixes. * etc/NEWS: Improve wording of the 'set-transient-map' entry. * doc/lispref/keymaps.texi (Controlling Active Maps): Fix wording and passive tense, and improve indexing. (Bug#21634) diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 8df4b6f2b4..f5341f40f0 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -1063,15 +1063,19 @@ The optional argument @var{on-exit}, if non-@code{nil}, specifies a function that is called, with no arguments, after @var{keymap} is deactivated. -The optional argument @var{message}, if a string, specifies the format -string for the message to display after activating the transient map. -When the string contains the specifier @samp{%k}, it's replaced with -the list of keys from the transient map. - -The optional argument @var{timeout}, if a number, specifies the number -of seconds of idle time after which @var{keymap} is deactivated. The -value of the argument @var{timeout} can be overridden by the variable -@code{set-transient-map-timeout}. +The optional argument @var{message} specifies the message to display +after activating the transient map. If @var{message} is a string, it +is the format string for the message, and any @samp{%k} specifier in +that string is replaced with the list of keys from the transient map. +Any other non-@code{nil} value of @var{message} stands for the default +message format @samp{Repeat with %k}. + +@vindex set-transient-map-timeout +If the optional argument @var{timeout} is non-@code{nil}, it should be +a number that specifies how many seconds of idle time to wait before +deactivating @var{keymap}. The value of the variable +@code{set-transient-map-timeout}, if non-@code{nil}, overrides the +value of this argument. This function works by adding and removing @var{keymap} from the variable @code{overriding-terminal-local-map}, which takes precedence diff --git a/etc/NEWS b/etc/NEWS index e169447025..2013260c15 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2279,10 +2279,11 @@ patcomp.el, pc-mode.el, pc-select.el, s-region.el, and sregex.el. +++ ** New arguments MESSAGE and TIMEOUT of 'set-transient-map'. -MESSAGE specifies a string that lists available keys, -and TIMEOUT deactivates the transient map after the specified -number of seconds. The default timeout is defined by -the new variable 'set-transient-map-timeout'. +MESSAGE specifies a message to display after activating the transient +map, including a special formatting spec to list available keys. +TIMEOUT is the idle time after which to deactivate the transient map. +The default timeout value can be defined by the new variable +'set-transient-map-timeout'. +++ ** New function 'seq-split'. diff --git a/lisp/subr.el b/lisp/subr.el index 44d094d28d..6bf12fd757 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6014,9 +6014,10 @@ To test whether a function can be called interactively, use 'set-temporary-overlay-map #'set-transient-map "24.4") (defvar set-transient-map-timeout nil - "Deactivate the transient map after specified timeout. -When a number, after idle time of the specified number of seconds -deactivate the map set by the previous call of `set-transient-map'.") + "Timeout in seconds for deactivation of a transient keymap. +If this is a number, it specifies the amount of idle time +after which to deactivate the keymap set by `set-transient-map', +thus overriding the value of the TIMEOUT argument to that function.") (defvar set-transient-map-timer nil "Timer for `set-transient-map-timeout'.") @@ -6032,16 +6033,18 @@ if it returns non-nil, then MAP stays active. Optional arg ON-EXIT, if non-nil, specifies a function that is called, with no arguments, after MAP is deactivated. -Optional arg MESSAGE, if a string, specifies the format string for the -message to display after activating the transient map. When the string -contains the specifier %k, it's replaced with the list of keys from the -transient map. Other non-nil values of MESSAGE use the message format -\"Repeat with %k\". On deactivating the map the displayed message -is cleared out. - -Optional arg TIMEOUT, if a number, specifies the number of seconds -of idle time after which the map is deactivated. The variable -`set-transient-map-timeout' overrides the argument TIMEOUT. +Optional arg MESSAGE, if non-nil, requests display of an informative +message after activating the transient map. If MESSAGE is a string, +it specifies the format string for the message to display, and the %k +specifier in the string is replaced with the list of keys from the +transient map. Any other non-nil value of MESSAGE means to use the +message format string \"Repeat with %k\". Upon deactivating the map, +the displayed message will be cleared out. + +Optional arg TIMEOUT, if non-nil, should be a number specifying the +number of seconds of idle time after which the map is deactivated. +The variable `set-transient-map-timeout', if non-nil, overrides the +value of TIMEOUT. This function uses `overriding-terminal-local-map', which takes precedence over all other keymaps. As usual, if no match for a key is found in MAP, commit ba63d8783bfd9a484106718346c7dbf6729c4c0f Author: Po Lu Date: Thu Jul 7 13:37:31 2022 +0800 Fix `trace-function' default buffer * lisp/emacs-lisp/trace.el (trace--read-args): Don't use format-prompt; instead, use DEF arg to read-buffer. diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el index 165f5c7bfe..7377ac9403 100644 --- a/lisp/emacs-lisp/trace.el +++ b/lisp/emacs-lisp/trace.el @@ -273,7 +273,7 @@ If `current-prefix-arg' is non-nil, also read a buffer and a \"context\" (if default (symbol-name default))))) (when current-prefix-arg (list - (read-buffer (format-prompt "Output to buffer" trace-buffer)) + (read-buffer "Output to buffer" trace-buffer) (let ((exp (let ((minibuffer-completing-symbol t)) (read-from-minibuffer "Context expression: " commit b1565431270a3596311f898ab51eccd969dca810 Merge: dafbdb87ec f9d01e5047 Author: Stefan Kangas Date: Thu Jul 7 06:30:37 2022 +0200 ; Merge from origin/emacs-28 The following commit was skipped: f9d01e5047 ; * lisp/emacs-lisp/ert.el: Remove installation instructions. commit dafbdb87ecccd347bc120816c29f4b7909bc73ca Author: Sean Whitton Date: Wed Jul 6 20:34:33 2022 -0700 gnus-advanced-body: Fix return value * gnus-logic.el (gnus-advanced-body): Return whether the search succeeded, not the value of one of the cleanup forms. diff --git a/lisp/gnus/gnus-logic.el b/lisp/gnus/gnus-logic.el index 3fb2ed3c62..c1b559ba6f 100644 --- a/lisp/gnus/gnus-logic.el +++ b/lisp/gnus/gnus-logic.el @@ -224,8 +224,8 @@ (goto-char (point-min)) (prog1 (funcall search-func match nil t) - (widen))) - (when handles (mm-destroy-parts handles)))))) + (widen) + (when handles (mm-destroy-parts handles)))))))) (provide 'gnus-logic) commit ca58872a5370bc9683c8bc0128c1f896410fdb6b Author: Po Lu Date: Thu Jul 7 10:50:49 2022 +0800 Fix NS build * src/keyboard.c (process_special_events): Don't define copy and moved events on the wrong toolkit. diff --git a/src/keyboard.c b/src/keyboard.c index 76dc3732b5..84a7a0a38a 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -4361,12 +4361,14 @@ static void process_special_events (void) { union buffered_input_event *event; +#if defined HAVE_X11 || defined HAVE_PGTK || defined HAVE_HAIKU #ifndef HAVE_HAIKU struct selection_input_event copy; #else struct input_event copy; #endif int moved_events; +#endif for (event = kbd_fetch_ptr; event != kbd_store_ptr; event = next_kbd_event (event)) commit fd016ea99724f7abedfddbb470ab96ece6ddf4ae Author: Po Lu Date: Thu Jul 7 02:48:19 2022 +0000 Port `x-lost-selection-functions' to Haiku * src/haiku_io.c (haiku_len): Add `CLIPBOARD_CHANGED_EVENT'. * src/haiku_select.cc (be_update_clipboard_count): Set ownership flags. (be_handle_clipboard_changed_message): (be_start_watching_selection): New functions. * src/haiku_support.cc (class Emacs): Handle B_CLIPBOARD_CHANGED. * src/haiku_support.h (enum haiku_event_type): New event `CLIPBOARD_CHANGED_EVENT'. (struct haiku_clipboard_changed_event): New struct. * src/haikuselect.c (haiku_handle_selection_clear) (haiku_selection_disowned, haiku_start_watching_selections): New functions. (syms_of_haikuselect): New defsym and defvar. * src/haikuselect.h: Update prototypes. * src/haikuterm.c (haiku_read_socket): Handle selection events. (haiku_term_init): Start watching selections. * src/haikuterm.h: Update prototypes. * src/keyboard.c (kbd_buffer_get_event, process_special_events) (mark_kboards): Handle SELECTON_CLEAR_EVENTs correctly on Haiku. diff --git a/src/haiku_io.c b/src/haiku_io.c index d345527685..5cc70f6f71 100644 --- a/src/haiku_io.c +++ b/src/haiku_io.c @@ -107,6 +107,8 @@ haiku_len (enum haiku_event_type type) return sizeof (struct haiku_scroll_bar_part_event); case SCREEN_CHANGED_EVENT: return sizeof (struct haiku_screen_changed_event); + case CLIPBOARD_CHANGED_EVENT: + return sizeof (struct haiku_clipboard_changed_event); } emacs_abort (); diff --git a/src/haiku_select.cc b/src/haiku_select.cc index 80c5d29482..edb821e313 100644 --- a/src/haiku_select.cc +++ b/src/haiku_select.cc @@ -18,6 +18,7 @@ along with GNU Emacs. If not, see . */ #include +#include #include #include #include @@ -47,6 +48,16 @@ static int64 count_primary = -1; /* The number of times the secondary selection has changed. */ static int64 count_secondary = -1; +/* Whether or not we currently think Emacs owns the primary + selection. */ +static bool owned_primary; + +/* Likewise for the secondary selection. */ +static bool owned_secondary; + +/* And the clipboard. */ +static bool owned_clipboard; + static BClipboard * get_clipboard_object (enum haiku_clipboard clipboard) { @@ -150,14 +161,17 @@ be_update_clipboard_count (enum haiku_clipboard id) { case CLIPBOARD_CLIPBOARD: count_clipboard = system_clipboard->SystemCount (); + owned_clipboard = true; break; case CLIPBOARD_PRIMARY: count_primary = primary->SystemCount (); + owned_primary = true; break; case CLIPBOARD_SECONDARY: count_secondary = secondary->SystemCount (); + owned_secondary = true; break; } } @@ -433,3 +447,43 @@ be_unlock_clipboard (enum haiku_clipboard clipboard, bool discard) board->Unlock (); } + +void +be_handle_clipboard_changed_message (void) +{ + if (count_clipboard != -1 + && (system_clipboard->SystemCount () + > count_clipboard + 1) + && owned_clipboard) + { + owned_clipboard = false; + haiku_selection_disowned (CLIPBOARD_CLIPBOARD); + } + + if (count_primary != -1 + && (primary->SystemCount () + > count_primary + 1) + && owned_primary) + { + owned_primary = false; + haiku_selection_disowned (CLIPBOARD_PRIMARY); + } + + if (count_secondary != -1 + && (secondary->SystemCount () + > count_secondary + 1) + && owned_secondary) + { + owned_secondary = false; + haiku_selection_disowned (CLIPBOARD_SECONDARY); + } +} + +void +be_start_watching_selection (enum haiku_clipboard id) +{ + BClipboard *clipboard; + + clipboard = get_clipboard_object (id); + clipboard->StartWatching (be_app); +} diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 7819cef568..9e38d9556f 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -21,6 +21,7 @@ along with GNU Emacs. If not, see . */ #include #include +#include #include #include @@ -648,8 +649,12 @@ class Emacs : public BApplication void MessageReceived (BMessage *msg) { + struct haiku_clipboard_changed_event rq; + if (msg->what == QUIT_APPLICATION) Quit (); + else if (msg->what == B_CLIPBOARD_CHANGED) + haiku_write (CLIPBOARD_CHANGED_EVENT, &rq); else BApplication::MessageReceived (msg); } diff --git a/src/haiku_support.h b/src/haiku_support.h index 6260b35cbc..d73f15560b 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -114,8 +114,14 @@ enum haiku_event_type DUMMY_EVENT, SCREEN_CHANGED_EVENT, MENU_BAR_LEFT, + CLIPBOARD_CHANGED_EVENT, }; +struct haiku_clipboard_changed_event +{ + char dummy; +}; + struct haiku_screen_changed_event { bigtime_t when; diff --git a/src/haikuselect.c b/src/haikuselect.c index fe76e09810..999a0f5ac2 100644 --- a/src/haikuselect.c +++ b/src/haikuselect.c @@ -24,6 +24,7 @@ along with GNU Emacs. If not, see . */ #include "haikuselect.h" #include "haikuterm.h" #include "haiku_support.h" +#include "keyboard.h" #include @@ -1020,6 +1021,47 @@ init_haiku_select (void) be_clipboard_init (); } +void +haiku_handle_selection_clear (struct input_event *ie) +{ + CALLN (Frun_hook_with_args, + Qhaiku_lost_selection_functions, ie->arg); +} + +void +haiku_selection_disowned (enum haiku_clipboard id) +{ + struct input_event ie; + + EVENT_INIT (ie); + ie.kind = SELECTION_CLEAR_EVENT; + + switch (id) + { + case CLIPBOARD_CLIPBOARD: + ie.arg = QCLIPBOARD; + break; + + case CLIPBOARD_PRIMARY: + ie.arg = QPRIMARY; + break; + + case CLIPBOARD_SECONDARY: + ie.arg = QSECONDARY; + break; + } + + kbd_buffer_store_event (&ie); +} + +void +haiku_start_watching_selections (void) +{ + be_start_watching_selection (CLIPBOARD_CLIPBOARD); + be_start_watching_selection (CLIPBOARD_PRIMARY); + be_start_watching_selection (CLIPBOARD_SECONDARY); +} + void syms_of_haikuselect (void) { @@ -1035,12 +1077,21 @@ The function is called without any arguments. `mouse-position' can be used to retrieve the current position of the mouse. */); Vhaiku_drag_track_function = Qnil; + DEFVAR_LISP ("haiku-lost-selection-functions", Vhaiku_lost_selection_functions, + doc: /* A list of functions to be called when Emacs loses an X selection. +These are only called if a connection to the Haiku display was opened. */); + Vhaiku_lost_selection_functions = Qnil; + DEFSYM (QSECONDARY, "SECONDARY"); DEFSYM (QCLIPBOARD, "CLIPBOARD"); DEFSYM (QSTRING, "STRING"); DEFSYM (QUTF8_STRING, "UTF8_STRING"); DEFSYM (Qforeign_selection, "foreign-selection"); DEFSYM (QTARGETS, "TARGETS"); + + DEFSYM (Qhaiku_lost_selection_functions, + "haiku-lost-selection-functions"); + DEFSYM (Qmessage, "message"); DEFSYM (Qstring, "string"); DEFSYM (Qref, "ref"); diff --git a/src/haikuselect.h b/src/haikuselect.h index ac8e069895..d027834e8b 100644 --- a/src/haikuselect.h +++ b/src/haikuselect.h @@ -38,7 +38,10 @@ enum haiku_clipboard extern "C" { #endif +/* Defined in haikuselect.c. */ +extern void haiku_selection_disowned (enum haiku_clipboard); +/* Defined in haiku_select.cc. */ extern void be_clipboard_init (void); extern char *be_find_clipboard_data (enum haiku_clipboard, const char *, ssize_t *); extern void be_set_clipboard_data (enum haiku_clipboard, const char *, const char *, @@ -61,6 +64,8 @@ extern int be_add_point_data (void *, const char *, float, float); extern int be_add_message_message (void *, const char *, void *); extern int be_lock_clipboard_message (enum haiku_clipboard, void **, bool); extern void be_unlock_clipboard (enum haiku_clipboard, bool); +extern void be_handle_clipboard_changed_message (void); +extern void be_start_watching_selection (enum haiku_clipboard); #ifdef __cplusplus }; diff --git a/src/haikuterm.c b/src/haikuterm.c index d7247c99e0..bcb3af0e2c 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -32,6 +32,7 @@ along with GNU Emacs. If not, see . */ #include "haiku_support.h" #include "thread.h" #include "window.h" +#include "haikuselect.h" #include #include @@ -4010,6 +4011,9 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) inev.timestamp = b->when / 1000; break; } + case CLIPBOARD_CHANGED_EVENT: + be_handle_clipboard_changed_message (); + break; case APP_QUIT_REQUESTED_EVENT: inev.kind = SAVE_SESSION_EVENT; inev.arg = Qt; @@ -4403,6 +4407,7 @@ haiku_term_init (void) else dpyinfo->default_name = build_string ("GNU Emacs"); + haiku_start_watching_selections (); unblock_input (); return dpyinfo; diff --git a/src/haikuterm.h b/src/haikuterm.h index ea20289b5d..46a2218e49 100644 --- a/src/haikuterm.h +++ b/src/haikuterm.h @@ -357,4 +357,6 @@ extern void haiku_end_cr_clip (cairo_t *); extern void haiku_merge_cursor_foreground (struct glyph_string *, unsigned long *, unsigned long *); +extern void haiku_handle_selection_clear (struct input_event *); +extern void haiku_start_watching_selections (void); #endif /* _HAIKU_TERM_H_ */ diff --git a/src/keyboard.c b/src/keyboard.c index bed8307b6f..76dc3732b5 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -4012,6 +4012,7 @@ kbd_buffer_get_event (KBOARD **kbp, We return nil for them. */ switch (event->kind) { +#ifndef HAVE_HAIKU case SELECTION_REQUEST_EVENT: case SELECTION_CLEAR_EVENT: { @@ -4035,6 +4036,20 @@ kbd_buffer_get_event (KBOARD **kbp, #endif } break; +#else + case SELECTION_REQUEST_EVENT: + emacs_abort (); + + case SELECTION_CLEAR_EVENT: + { + struct input_event copy = event->ie; + + kbd_fetch_ptr = next_kbd_event (event); + input_pending = readable_events (0); + haiku_handle_selection_clear (©); + } + break; +#endif case MONITORS_CHANGED_EVENT: { @@ -4345,8 +4360,16 @@ kbd_buffer_get_event (KBOARD **kbp, static void process_special_events (void) { - for (union buffered_input_event *event = kbd_fetch_ptr; - event != kbd_store_ptr; event = next_kbd_event (event)) + union buffered_input_event *event; +#ifndef HAVE_HAIKU + struct selection_input_event copy; +#else + struct input_event copy; +#endif + int moved_events; + + for (event = kbd_fetch_ptr; event != kbd_store_ptr; + event = next_kbd_event (event)) { /* If we find a stored X selection request, handle it now. */ if (event->kind == SELECTION_REQUEST_EVENT @@ -4360,8 +4383,7 @@ process_special_events (void) between kbd_fetch_ptr and EVENT one slot to the right, cyclically. */ - struct selection_input_event copy = event->sie; - int moved_events; + copy = event->sie; if (event < kbd_fetch_ptr) { @@ -4383,6 +4405,27 @@ process_special_events (void) #else pgtk_handle_selection_event (©); #endif +#elif defined HAVE_HAIKU + if (event->ie.kind != SELECTION_CLEAR_EVENT) + emacs_abort (); + + copy = event->ie; + + if (event < kbd_fetch_ptr) + { + memmove (kbd_buffer + 1, kbd_buffer, + (event - kbd_buffer) * sizeof *kbd_buffer); + kbd_buffer[0] = kbd_buffer[KBD_BUFFER_SIZE - 1]; + moved_events = kbd_buffer + KBD_BUFFER_SIZE - 1 - kbd_fetch_ptr; + } + else + moved_events = event - kbd_fetch_ptr; + + memmove (kbd_fetch_ptr + 1, kbd_fetch_ptr, + moved_events * sizeof *kbd_fetch_ptr); + kbd_fetch_ptr = next_kbd_event (kbd_fetch_ptr); + input_pending = readable_events (0); + haiku_handle_selection_clear (©); #else /* We're getting selection request events, but we don't have a window system. */ @@ -13149,7 +13192,10 @@ mark_kboards (void) { /* These two special event types have no Lisp_Objects to mark. */ if (event->kind != SELECTION_REQUEST_EVENT - && event->kind != SELECTION_CLEAR_EVENT) +#ifndef HAVE_HAIKU + && event->kind != SELECTION_CLEAR_EVENT +#endif + ) { mark_object (event->ie.x); mark_object (event->ie.y); commit 8575962d46d1f1d08836bf00cb74ccd344953bcb Author: Po Lu Date: Thu Jul 7 09:21:22 2022 +0800 Avoid excessive synchronization performing "xterm" drops * src/xterm.c (x_dnd_do_unsupported_drop): Asynchronously catch errors around XSendEvent. diff --git a/src/xterm.c b/src/xterm.c index 225c45ff7c..a21daa2dfc 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -3860,6 +3860,7 @@ x_dnd_do_unsupported_drop (struct x_display_info *dpyinfo, event.xbutton.root = dpyinfo->root_window; event.xbutton.x_root = root_x; event.xbutton.y_root = root_y; + x_catch_errors (dpyinfo->display); child = dpyinfo->root_window; @@ -3892,6 +3893,8 @@ x_dnd_do_unsupported_drop (struct x_display_info *dpyinfo, if (owner != FRAME_X_WINDOW (f)) goto cancel; + x_uncatch_errors (); + event.xbutton.window = child; event.xbutton.subwindow = None; event.xbutton.x = dest_x; @@ -3905,14 +3908,20 @@ x_dnd_do_unsupported_drop (struct x_display_info *dpyinfo, event.xbutton.type = ButtonPress; event.xbutton.time = before + 1; + x_ignore_errors_for_next_request (dpyinfo); XSendEvent (dpyinfo->display, child, True, ButtonPressMask, &event); + x_stop_ignoring_errors (dpyinfo); event.xbutton.type = ButtonRelease; event.xbutton.time = before + 2; + x_ignore_errors_for_next_request (dpyinfo); XSendEvent (dpyinfo->display, child, True, ButtonReleaseMask, &event); + x_stop_ignoring_errors (dpyinfo); + + return; cancel: x_uncatch_errors (); commit 7ac9c22636cc2d6c56bf238ca4311924a6ee0cd0 Author: Stefan Kangas Date: Thu Jul 7 02:09:30 2022 +0200 End new .dir-locals.el files with a newline * lisp/files-x.el (dir-locals-to-string): Add newline at the end of newly created .dir-locals.el files. This avoids git complaining about "No newline at end of file". diff --git a/lisp/files-x.el b/lisp/files-x.el index 4db6fbd22c..a89fc26d60 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -507,19 +507,20 @@ from the MODE alist ignoring the input argument VALUE." (defun dir-locals-to-string (variables) "Output alists of VARIABLES to string in dotted pair notation syntax." - (format "(%s)" (mapconcat - (lambda (mode-variables) - (format "(%S . %s)" - (car mode-variables) - (format "(%s)" (mapconcat - (lambda (variable-value) - (format "(%S . %s)" - (car variable-value) - (string-trim-right - (pp-to-string - (cdr variable-value))))) - (cdr mode-variables) "\n")))) - variables "\n"))) + (format "(%s)\n" + (mapconcat + (lambda (mode-variables) + (format "(%S . %s)" + (car mode-variables) + (format "(%s)" (mapconcat + (lambda (variable-value) + (format "(%S . %s)" + (car variable-value) + (string-trim-right + (pp-to-string + (cdr variable-value))))) + (cdr mode-variables) "\n")))) + variables "\n"))) ;;;###autoload (defun add-dir-local-variable (mode variable value) commit ab9b55d617fe1235548d368e416e07aeb25504b8 Author: Stefan Kangas Date: Wed Jul 6 20:53:52 2022 +0200 Autoload safe local property for plstore-encrypt-to * lisp/plstore.el (plstore-encrypt-to): Autoload 'safe-local-variable' property for improved security. diff --git a/lisp/plstore.el b/lisp/plstore.el index b37d39ce1b..de3f828016 100644 --- a/lisp/plstore.el +++ b/lisp/plstore.el @@ -107,6 +107,7 @@ symmetric encryption will be used." :type '(choice (const nil) (repeat :tag "Recipient(s)" string)) :group 'plstore) +;;;###autoload (put 'plstore-encrypt-to 'safe-local-variable (lambda (val) (or (stringp val) commit 3e7f6ff4b09760c92b1a6b1a193d08c52f37675a Author: Stefan Kangas Date: Wed Jul 6 19:56:32 2022 +0200 Prefer defcustom :safe to putting 'safe-local-variable' * lisp/emacs-lisp/lisp-mode.el (lisp-indent-offset) (lisp-body-indent, emacs-lisp-docstring-fill-column): * lisp/files.el (version-control): * lisp/progmodes/modula2.el (m2-indent): * lisp/progmodes/octave.el (octave-block-offset): * lisp/progmodes/sh-script.el (sh-basic-offset): * lisp/progmodes/tcl.el (tcl-indent-level) (tcl-continued-indent-level): * lisp/simple.el (fill-prefix): * lisp/textmodes/fill.el (colon-double-space): * lisp/textmodes/paragraphs.el (paragraph-start) (paragraph-separate, sentence-end-double-space) (sentence-end-without-period, sentence-end-without-space) (sentence-end, sentence-end-base, page-delimiter) (paragraph-ignore-fill-prefix): * lisp/textmodes/tex-mode.el (tex-fontify-script): * lisp/vc/add-log.el (add-log-dont-create-changelog-file): * lisp/vc/vc-hooks.el (vc-follow-symlinks): Prefer defcustom :safe to putting 'safe-local-variable'. diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index c559dd427c..68528e199f 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -838,9 +838,8 @@ or to switch back to an existing one." (defcustom lisp-indent-offset nil "If non-nil, indent second line of expressions that many more columns." :group 'lisp - :type '(choice (const nil) integer)) -(put 'lisp-indent-offset 'safe-local-variable - (lambda (x) (or (null x) (integerp x)))) + :type '(choice (const nil) integer) + :safe (lambda (x) (or (null x) (integerp x)))) (defcustom lisp-indent-function 'lisp-indent-function "A function to be called by `calculate-lisp-indent'. @@ -1252,8 +1251,8 @@ Lisp function does not specify a special indentation." (defcustom lisp-body-indent 2 "Number of columns to indent the second line of a `(def...)' form." :group 'lisp - :type 'integer) -(put 'lisp-body-indent 'safe-local-variable 'integerp) + :type 'integer + :safe #'integerp) (defun lisp-indent-specform (count state indent-point normal-indent) (let ((containing-form-start (elt state 1)) @@ -1414,9 +1413,8 @@ Any non-integer value means do not use a different value of `fill-column' when filling docstrings." :type '(choice (integer) (const :tag "Use the current `fill-column'" t)) + :safe (lambda (x) (or (eq x t) (integerp x))) :group 'lisp) -(put 'emacs-lisp-docstring-fill-column 'safe-local-variable - (lambda (x) (or (eq x t) (integerp x)))) (defun lisp-fill-paragraph (&optional justify) "Like \\[fill-paragraph], but handle Emacs Lisp comments and docstrings. diff --git a/lisp/files.el b/lisp/files.el index f84fe7e085..992f987943 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -304,16 +304,14 @@ When nil, make them for files that have some already. The value `never' means do not make them." :type '(choice (const :tag "Never" never) (const :tag "If existing" nil) - (other :tag "Always" t)) + (other :tag "Always" t)) + :safe #'version-control-safe-local-p :group 'backup) (defun version-control-safe-local-p (x) "Return whether X is safe as local value for `version-control'." (or (booleanp x) (equal x 'never))) -(put 'version-control 'safe-local-variable - #'version-control-safe-local-p) - (defcustom dired-kept-versions 2 "When cleaning directory, number of versions to keep." :type 'natnum diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el index a8d644dba0..e668570ba1 100644 --- a/lisp/progmodes/modula2.el +++ b/lisp/progmodes/modula2.el @@ -101,9 +101,8 @@ (defcustom m2-indent 5 "This variable gives the indentation in Modula-2 mode." - :type 'integer) -(put 'm2-indent 'safe-local-variable - (lambda (v) (or (null v) (integerp v)))) + :type 'integer + :safe (lambda (v) (or (null v) (integerp v)))) (defconst m2-smie-grammar ;; An official definition can be found as "M2R10.pdf". This grammar does diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index 7b7c675873..721dfa51ad 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -197,8 +197,8 @@ newline or semicolon after an else or end keyword." (defcustom octave-block-offset 2 "Extra indentation applied to statements in Octave block structures." - :type 'integer) -(put 'octave-block-offset 'safe-local-variable 'integerp) + :type 'integer + :safe #'integerp) (defvar octave-block-comment-start (concat (make-string 2 octave-comment-char) " ") diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 71fb0cd2e0..be9f325d93 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1156,8 +1156,8 @@ Can be set to a number, or to nil which means leave it as is." "The default indentation increment. This value is used for the `+' and `-' symbols in an indentation variable." :type 'integer + :safe #'integerp :group 'sh-indentation) -(put 'sh-basic-offset 'safe-local-variable 'integerp) (defcustom sh-indent-comment t "How a comment line is to be indented. diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index 8c179879ce..7dae14f9e0 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -120,13 +120,13 @@ (defcustom tcl-indent-level 4 "Indentation of Tcl statements with respect to containing block." - :type 'integer) -(put 'tcl-indent-level 'safe-local-variable #'integerp) + :type 'integer + :safe #'integerp) (defcustom tcl-continued-indent-level 4 "Indentation of continuation line relative to first line of command." - :type 'integer) -(put 'tcl-continued-indent-level 'safe-local-variable #'integerp) + :type 'integer + :safe #'integerp) (defcustom tcl-auto-newline nil "Non-nil means automatically newline before and after braces you insert." diff --git a/lisp/simple.el b/lisp/simple.el index e79487eba8..6313ce81ef 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -8609,10 +8609,10 @@ constitute a word." (defcustom fill-prefix nil "String for filling to insert at front of new line, or nil for none." :type '(choice (const :tag "None" nil) - string) + string) + :safe #'string-or-null-p :group 'fill) (make-variable-buffer-local 'fill-prefix) -(put 'fill-prefix 'safe-local-variable 'string-or-null-p) (defcustom auto-fill-inhibit-regexp nil "Regexp to match lines that should not be auto-filled." diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index 88a8395c88..23ba1a24f1 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -46,8 +46,8 @@ A value of nil means that any change in indentation starts a new paragraph." (defcustom colon-double-space nil "Non-nil means put two spaces after a colon when filling." - :type 'boolean) -(put 'colon-double-space 'safe-local-variable #'booleanp) + :type 'boolean + :safe #'booleanp) (defcustom fill-separate-heterogeneous-words-with-space nil "Non-nil means to use a space to separate words of a different kind. diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el index 98eb494823..cd726ad477 100644 --- a/lisp/textmodes/paragraphs.el +++ b/lisp/textmodes/paragraphs.el @@ -96,8 +96,8 @@ lines that start paragraphs from lines that separate them. If the variable `use-hard-newlines' is non-nil, then only lines following a hard newline are considered to match." - :type 'regexp) -(put 'paragraph-start 'safe-local-variable #'stringp) + :type 'regexp + :safe #'stringp) ;; paragraph-start requires a hard newline, but paragraph-separate does not: ;; It is assumed that paragraph-separate is distinctive enough to be believed @@ -113,8 +113,8 @@ This is matched against the text at the left margin, which is not necessarily the beginning of the line, so it should not use \"^\" as an anchor. This ensures that the paragraph functions will work equally within a region of text indented by a margin setting." - :type 'regexp) -(put 'paragraph-separate 'safe-local-variable #'stringp) + :type 'regexp + :safe #'stringp) (defcustom sentence-end-double-space t "Non-nil means a single space does not end a sentence. @@ -125,8 +125,8 @@ This value is used by the function `sentence-end' to construct the regexp describing the end of a sentence, when the value of the variable `sentence-end' is nil. See Info node `(elisp)Standard Regexps'." :type 'boolean + :safe #'booleanp :group 'fill) -(put 'sentence-end-double-space 'safe-local-variable #'booleanp) (defcustom sentence-end-without-period nil "Non-nil means a sentence will end without a period. @@ -137,8 +137,8 @@ This value is used by the function `sentence-end' to construct the regexp describing the end of a sentence, when the value of the variable `sentence-end' is nil. See Info node `(elisp)Standard Regexps'." :type 'boolean + :safe #'booleanp :group 'fill) -(put 'sentence-end-without-period 'safe-local-variable #'booleanp) (defcustom sentence-end-without-space "。．？！" @@ -147,8 +147,8 @@ regexp describing the end of a sentence, when the value of the variable This value is used by the function `sentence-end' to construct the regexp describing the end of a sentence, when the value of the variable `sentence-end' is nil. See Info node `(elisp)Standard Regexps'." - :type 'string) -(put 'sentence-end-without-space 'safe-local-variable #'stringp) + :type 'string + :safe #'stringp) (defcustom sentence-end nil "Regexp describing the end of a sentence. @@ -158,14 +158,14 @@ All paragraph boundaries also end sentences, regardless. The value nil means to use the default value defined by the function `sentence-end'. You should always use this function to obtain the value of this variable." - :type '(choice regexp (const :tag "Use default value" nil))) -(put 'sentence-end 'safe-local-variable #'string-or-null-p) + :type '(choice regexp (const :tag "Use default value" nil)) + :safe #'string-or-null-p) (defcustom sentence-end-base "[.?!…‽][]\"'”’)}»›]*" "Regexp matching the basic end of a sentence, not including following space." :type 'regexp + :safe #'stringp :version "25.1") -(put 'sentence-end-base 'safe-local-variable #'stringp) (defun sentence-end () "Return the regexp describing the end of a sentence. @@ -192,14 +192,14 @@ in between. See Info node `(elisp)Standard Regexps'." (defcustom page-delimiter "^\014" "Regexp describing line-beginnings that separate pages." - :type 'regexp) -(put 'page-delimiter 'safe-local-variable #'stringp) + :type 'regexp + :safe #'stringp) (defcustom paragraph-ignore-fill-prefix nil "Non-nil means the paragraph commands are not affected by `fill-prefix'. This is desirable in modes where blank lines are the paragraph delimiters." - :type 'boolean) -(put 'paragraph-ignore-fill-prefix 'safe-local-variable #'booleanp) + :type 'boolean + :safe #'booleanp) ;; Silence the compiler. (defun forward-paragraph (&optional arg) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index e90d214a12..d34133f856 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -248,9 +248,9 @@ Normally set to either `plain-tex-mode' or `latex-mode'." (defcustom tex-fontify-script t "If non-nil, fontify subscript and superscript strings." :type 'boolean + :safe #'booleanp :group 'tex :version "23.1") -(put 'tex-fontify-script 'safe-local-variable #'booleanp) (defcustom tex-font-script-display '(-0.2 0.2) "How much to lower and raise subscript and superscript content. diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el index beaad2e835..e02d84f1f5 100644 --- a/lisp/vc/add-log.el +++ b/lisp/vc/add-log.el @@ -789,10 +789,9 @@ Optional arg BUFFER-FILE overrides `buffer-file-name'." If a ChangeLog file does not already exist, a non-nil value means to put log entries in a suitably named buffer." :type 'boolean + :safe #'booleanp :version "27.1") -(put 'add-log-dont-create-changelog-file 'safe-local-variable #'booleanp) - (defun add-log--pseudo-changelog-buffer-name (changelog-file-name) "Compute a suitable name for a non-file visiting ChangeLog buffer. CHANGELOG-FILE-NAME is the file name of the actual ChangeLog file diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index cc08767ade..46e40f29c0 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -141,9 +141,9 @@ confirmation whether it should follow the link. If nil, the link is visited and a warning displayed." :type '(choice (const :tag "Ask for confirmation" ask) (const :tag "Visit link and warn" nil) - (const :tag "Follow link" t)) + (const :tag "Follow link" t)) + :safe #'null :group 'vc) -(put 'vc-follow-symlinks 'safe-local-variable #'null) (defcustom vc-display-status t "If non-nil, display revision number and lock status in mode line. commit 5866fd5fecd93116f0885f55887a449d739c369c Author: Juri Linkov Date: Wed Jul 6 20:40:48 2022 +0300 * lisp/repeat.el (describe-repeat-maps): Handle non-symbol keymap (bug#21634). diff --git a/lisp/repeat.el b/lisp/repeat.el index d69640a29c..a32f3a4c50 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -563,13 +563,17 @@ Used in `repeat-mode'." (insert "A list of keymaps used by commands with the symbol property `repeat-map'.\n\n") (dolist (keymap (sort keymaps (lambda (a b) - (string-lessp (car a) (car b))))) + (when (and (symbolp (car a)) + (symbolp (car b))) + (string-lessp (car a) (car b)))))) (insert (format-message "`%s' keymap is repeatable by these commands:\n" (car keymap))) (dolist (command (sort (cdr keymap) #'string-lessp)) (let* ((info (help-fns--analyze-function command)) - (map (list (symbol-value (car keymap)))) + (map (list (if (symbolp (car keymap)) + (symbol-value (car keymap)) + (car keymap)))) (desc (mapconcat (lambda (key) (propertize (key-description key) 'face 'help-key-binding)) commit 0e99046d62e71fb874cb9010e60ecfee289f84e9 Author: Juri Linkov Date: Wed Jul 6 20:39:41 2022 +0300 Add new args MESSAGE and TIMEOUT to set-transient-map (bug#21634) * lisp/subr.el (set-transient-map): Add new args MESSAGE and TIMEOUT. (set-transient-map-timeout, set-transient-map-timer): New variables. * lisp/international/emoji.el (emoji-zoom-increase): * lisp/indent.el (indent-rigidly): * lisp/face-remap.el (text-scale-adjust, global-text-scale-adjust): Use the arg MESSAGE of set-transient-map. * doc/lispref/keymaps.texi (Controlling Active Maps): Mention new args MESSAGE and TIMEOUT of set-transient-map. diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 9488c4d7b3..8df4b6f2b4 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -1063,6 +1063,16 @@ The optional argument @var{on-exit}, if non-@code{nil}, specifies a function that is called, with no arguments, after @var{keymap} is deactivated. +The optional argument @var{message}, if a string, specifies the format +string for the message to display after activating the transient map. +When the string contains the specifier @samp{%k}, it's replaced with +the list of keys from the transient map. + +The optional argument @var{timeout}, if a number, specifies the number +of seconds of idle time after which @var{keymap} is deactivated. The +value of the argument @var{timeout} can be overridden by the variable +@code{set-transient-map-timeout}. + This function works by adding and removing @var{keymap} from the variable @code{overriding-terminal-local-map}, which takes precedence over all other active keymaps (@pxref{Searching Keymaps}). diff --git a/etc/NEWS b/etc/NEWS index 7a1b7a856a..e169447025 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2277,6 +2277,13 @@ patcomp.el, pc-mode.el, pc-select.el, s-region.el, and sregex.el. * Lisp Changes in Emacs 29.1 ++++ +** New arguments MESSAGE and TIMEOUT of 'set-transient-map'. +MESSAGE specifies a string that lists available keys, +and TIMEOUT deactivates the transient map after the specified +number of seconds. The default timeout is defined by +the new variable 'set-transient-map-timeout'. + +++ ** New function 'seq-split'. This returns a list of sub-sequences of the specified sequence. diff --git a/lisp/face-remap.el b/lisp/face-remap.el index 467ccbc299..fd49c81ab3 100644 --- a/lisp/face-remap.el +++ b/lisp/face-remap.el @@ -408,20 +408,15 @@ See also the related command `global-text-scale-adjust'." (?0 0) (_ inc)))) (text-scale-increase step) - ;; (unless (zerop step) - (message (substitute-command-keys - "Use \\`+',\\`-',\\`0' for further adjustment")) (set-transient-map (let ((map (make-sparse-keymap))) (dolist (mods '(() (control))) - (dolist (key '(?- ?+ ?= ?0)) ;; = is often unshifted +. + (dolist (key '(?+ ?= ?- ?0)) ;; = is often unshifted +. (define-key map (vector (append mods (list key))) (lambda () (interactive) (text-scale-adjust (abs inc)))))) map) - nil - ;; Clear the prompt after exiting. - (lambda () - (message "")))))) + nil nil + "Use %k for further adjustment")))) (defvar-local text-scale--pinch-start-scale 0 "The text scale at the start of a pinch sequence.") @@ -515,15 +510,15 @@ See also the related command `text-scale-adjust'." (not global-text-scale-adjust-resizes-frames))) (set-face-attribute 'default nil :height new))) (when (characterp key) - (message (substitute-command-keys - "Use \\`+',\\`-',\\`0' for further adjustment")) (set-transient-map (let ((map (make-sparse-keymap))) (dolist (mod '(() (control meta))) (dolist (key '(?+ ?= ?- ?0)) (define-key map (vector (append mod (list key))) 'global-text-scale-adjust))) - map)))))) + map) + nil nil + "Use %k for further adjustment"))))) ;; ---------------------------------------------------------------- diff --git a/lisp/indent.el b/lisp/indent.el index d6dee94016..f52b729051 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -270,11 +270,8 @@ Negative values of ARG indent backward, so you can remove all indentation by specifying a large negative ARG." (interactive "r\nP\np") (if (and (not arg) interactive) - (progn - (message - (substitute-command-keys - "Indent region with \\\\[indent-rigidly-left], \\[indent-rigidly-right], \\[indent-rigidly-left-to-tab-stop], or \\[indent-rigidly-right-to-tab-stop].")) - (set-transient-map indent-rigidly-map t #'deactivate-mark)) + (set-transient-map indent-rigidly-map t #'deactivate-mark + "Indent region with %k") (save-excursion (goto-char end) (setq end (point-marker)) diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el index 341b44cc11..4f4d4f4832 100644 --- a/lisp/international/emoji.el +++ b/lisp/international/emoji.el @@ -704,10 +704,7 @@ We prefer the earliest unique letter." "Increase the size of the character under point. FACTOR is the multiplication factor for the size." (interactive) - (message - (substitute-command-keys - "Zoom with \\\\[emoji-zoom-increase] and \\[emoji-zoom-decrease]")) - (set-transient-map emoji-zoom-map t) + (set-transient-map emoji-zoom-map t nil "Zoom with %k") (let* ((factor (or factor 1.1)) (old (get-text-property (point) 'face)) (height (or (and (consp old) diff --git a/lisp/subr.el b/lisp/subr.el index 2f9d37ffd6..44d094d28d 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6013,7 +6013,15 @@ To test whether a function can be called interactively, use (define-obsolete-function-alias 'set-temporary-overlay-map #'set-transient-map "24.4") -(defun set-transient-map (map &optional keep-pred on-exit) +(defvar set-transient-map-timeout nil + "Deactivate the transient map after specified timeout. +When a number, after idle time of the specified number of seconds +deactivate the map set by the previous call of `set-transient-map'.") + +(defvar set-transient-map-timer nil + "Timer for `set-transient-map-timeout'.") + +(defun set-transient-map (map &optional keep-pred on-exit message timeout) "Set MAP as a temporary keymap taking precedence over other keymaps. Normally, MAP is used only once, to look up the very next key. However, if the optional argument KEEP-PRED is t, MAP stays @@ -6024,24 +6032,50 @@ if it returns non-nil, then MAP stays active. Optional arg ON-EXIT, if non-nil, specifies a function that is called, with no arguments, after MAP is deactivated. -This uses `overriding-terminal-local-map', which takes precedence over all -other keymaps. As usual, if no match for a key is found in MAP, the normal -key lookup sequence then continues. +Optional arg MESSAGE, if a string, specifies the format string for the +message to display after activating the transient map. When the string +contains the specifier %k, it's replaced with the list of keys from the +transient map. Other non-nil values of MESSAGE use the message format +\"Repeat with %k\". On deactivating the map the displayed message +is cleared out. + +Optional arg TIMEOUT, if a number, specifies the number of seconds +of idle time after which the map is deactivated. The variable +`set-transient-map-timeout' overrides the argument TIMEOUT. + +This function uses `overriding-terminal-local-map', which takes precedence +over all other keymaps. As usual, if no match for a key is found in MAP, +the normal key lookup sequence then continues. This returns an \"exit function\", which can be called with no argument to deactivate this transient map, regardless of KEEP-PRED." - (let* ((clearfun (make-symbol "clear-transient-map")) + (let* ((timeout (or set-transient-map-timeout timeout)) + (message + (when message + (let (keys) + (map-keymap (lambda (key cmd) (and cmd (push key keys))) map) + (format-spec (if (stringp message) message "Repeat with %k") + `((?k . ,(mapconcat + (lambda (key) + (substitute-command-keys + (format "\\`%s'" + (key-description (vector key))))) + keys ", "))))))) + (clearfun (make-symbol "clear-transient-map")) (exitfun (lambda () (internal-pop-keymap map 'overriding-terminal-local-map) (remove-hook 'pre-command-hook clearfun) + ;; Clear the prompt after exiting. + (when message (message "")) + (when set-transient-map-timer (cancel-timer set-transient-map-timer)) (when on-exit (funcall on-exit))))) ;; Don't use letrec, because equal (in add/remove-hook) could get trapped ;; in a cycle. (bug#46326) (fset clearfun (lambda () (with-demoted-errors "set-transient-map PCH: %S" - (unless (cond + (if (cond ((null keep-pred) nil) ((and (not (eq map (cadr overriding-terminal-local-map))) (memq map (cddr overriding-terminal-local-map))) @@ -6066,9 +6100,15 @@ to deactivate this transient map, regardless of KEEP-PRED." ;; nil and so is `mc`. (and mc (eq this-command mc)))) (t (funcall keep-pred))) + ;; Repeat the message for the next command. + (when message (message "%s" message)) (funcall exitfun))))) (add-hook 'pre-command-hook clearfun) (internal-push-keymap map 'overriding-terminal-local-map) + (when timeout + (when set-transient-map-timer (cancel-timer set-transient-map-timer)) + (setq set-transient-map-timer (run-with-idle-timer timeout nil exitfun))) + (when message (message "%s" message)) exitfun)) ;;;; Progress reporters. commit 6a7bb1ddbc9837b2d2af60236be58723114855ac Author: Stefan Kangas Date: Wed Jul 6 19:29:51 2022 +0200 Make some additional defcustom types more restrictive * lisp/desktop.el (desktop-lazy-idle-delay): * lisp/files.el (dired-kept-versions) (kept-old-versions, kept-new-versions): * lisp/filesets.el (filesets-max-submenu-length) (filesets-max-entry-length, filesets-tree-max-level) (filesets-query-user-limit): * lisp/hi-lock.el (hi-lock-file-patterns-range) (hi-lock-highlight-range): * lisp/ido.el (ido-max-work-directory-list): * lisp/image/gravatar.el (gravatar-cache-ttl): * lisp/imenu.el (imenu-auto-rescan-maxout, imenu-max-items): * lisp/informat.el (Info-split-threshold): * lisp/mail/hashcash.el (hashcash-default-payment) (hashcash-default-accept-payment): * lisp/mail/mail-hist.el (mail-hist-history-size): * lisp/mail/smtpmail.el (smtpmail-retries): * lisp/msb.el (msb-display-most-recently-used): * lisp/nxml/rng-valid.el (rng-state-cache-distance) (rng-validate-chunk-size): * lisp/progmodes/gdb-mi.el (gdb-max-source-window-count): * lisp/recentf.el (recentf-arrange-by-rules-min-items): * lisp/simple.el (kill-ring-max, mark-ring-max) (global-mark-ring-max): * lisp/tab-line.el (tab-line-tab-name-truncated-max): * lisp/term.el (term-buffer-maximum-size, term-input-chunk-size): * lisp/thumbs.el (thumbs-max-image-number) (thumbs-thumbsdir-max-size, thumbs-relief, thumbs-margin) (thumbs-image-resizing-step): * lisp/type-break.el (type-break-interval) (type-break-good-rest-interval, type-break-query-interval) (type-break-warning-repeat): * lisp/vc/compare-w.el (compare-windows-sync-string-size): * lisp/woman.el (woman-fill-column): Use defcustom :type natnum. * lisp/emacs-lisp/backtrace.el (backtrace-line-length): * lisp/doc-view.el (doc-view-conversion-refresh-interval): Use defcustom :type natnum and allow the nil value. * lisp/gnus/spam-stat.el (spam-stat-process-directory-age): Use defcustom :type integer. diff --git a/lisp/desktop.el b/lisp/desktop.el index 947f7cff5c..850d2a86ef 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -481,7 +481,7 @@ If value is t, all buffers are restored immediately." (defcustom desktop-lazy-idle-delay 5 "Idle delay before starting to create buffers. See `desktop-restore-eager'." - :type 'integer + :type 'natnum :group 'desktop :version "22.1") diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 25c476b99b..0f659fb8b3 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -378,7 +378,8 @@ After such a refresh newly converted pages will be available for viewing. If set to nil there won't be any refreshes and the pages won't be displayed before conversion of the whole document has finished." - :type 'integer) + :type '(choice natnum + (const :value nil :tag "No refreshes"))) (defcustom doc-view-continuous nil "In Continuous mode reaching the page edge advances to next/previous page. diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index e305822af1..4f98bf3f4f 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -58,7 +58,8 @@ Backtrace mode will attempt to abbreviate printing of backtrace frames by setting `print-level' and `print-length' to make them shorter than this, but success is not guaranteed. If set to nil or zero, backtrace mode will not abbreviate the forms it prints." - :type 'integer + :type '(choice natnum + (const :value nil :tag "Don't abbreviate")) :group 'backtrace :version "27.1") diff --git a/lisp/files.el b/lisp/files.el index b2f035d4df..f84fe7e085 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -316,7 +316,7 @@ The value `never' means do not make them." (defcustom dired-kept-versions 2 "When cleaning directory, number of versions to keep." - :type 'integer + :type 'natnum :group 'backup :group 'dired) @@ -330,16 +330,16 @@ If nil, ask confirmation. Any other value prevents any trimming." (defcustom kept-old-versions 2 "Number of oldest versions to keep when a new numbered backup is made." - :type 'integer + :type 'natnum + :safe #'natnump :group 'backup) -(put 'kept-old-versions 'safe-local-variable 'integerp) (defcustom kept-new-versions 2 "Number of newest versions to keep when a new numbered backup is made. Includes the new backup. Must be greater than 0." - :type 'integer + :type 'natnum + :safe #'natnump :group 'backup) -(put 'kept-new-versions 'safe-local-variable 'integerp) (defcustom require-final-newline nil "Whether to add a newline automatically at the end of the file. diff --git a/lisp/filesets.el b/lisp/filesets.el index b97dda3cd6..b1829793f1 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -414,12 +414,12 @@ time to time or if the fileset cache causes troubles." Set this value to 0 to turn menu splitting off. BTW, parts of submenus will not be rewrapped if their length exceeds this value." :set #'filesets-set-default - :type 'integer) + :type 'natnum) (defcustom filesets-max-entry-length 50 "Truncate names of split submenus to this length." :set #'filesets-set-default - :type 'integer) + :type 'natnum) (defcustom filesets-browse-dir-function #'dired "A function or command used for browsing directories. @@ -518,7 +518,7 @@ i.e. how deep the menu should be. Try something like and it should become clear what this option is about. In any case, including directory trees to the menu can take a lot of memory." :set #'filesets-set-default - :type 'integer) + :type 'natnum) (defcustom filesets-commands '(("Isearch" @@ -1027,7 +1027,7 @@ defined in `filesets-ingroup-patterns'." (defcustom filesets-query-user-limit 15 "Query the user before opening a fileset with that many files." :set #'filesets-set-default - :type 'integer) + :type 'natnum) (defun filesets-filter-dir-names (lst &optional negative) diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el index b0d258d67a..084eb3d774 100644 --- a/lisp/gnus/spam-stat.el +++ b/lisp/gnus/spam-stat.el @@ -189,7 +189,7 @@ When using `spam-stat-process-spam-directory' or been touched in this many days will be considered. Without this filter, re-training spam-stat with several thousand messages will start to take a very long time." - :type 'number) + :type 'integer) (defvar spam-stat-last-saved-at nil "Time stamp of last change of spam-stat-file on this run") diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 8cddd64482..b56f26d529 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -97,7 +97,7 @@ When a file is visited and hi-lock mode is on, patterns starting up to this limit are added to font-lock's patterns. See documentation of functions `hi-lock-mode' and `hi-lock-find-patterns'." - :type 'integer + :type 'natnum :group 'hi-lock) (defcustom hi-lock-highlight-range 2000000 @@ -107,7 +107,7 @@ such as the buffer created by `list-colors-display'. In those buffers hi-lock patterns will only be applied over a range of `hi-lock-highlight-range' characters. If font-lock is active then highlighting will be applied throughout the buffer." - :type 'integer + :type 'natnum :group 'hi-lock) (defcustom hi-lock-exclude-modes diff --git a/lisp/ido.el b/lisp/ido.el index b3365059d2..134081d675 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -554,7 +554,7 @@ See `ido-last-directory-list' and `ido-save-directory-list-file'." "Maximum number of working directories to record. This is the list of directories where files have most recently been opened. See `ido-work-directory-list' and `ido-save-directory-list-file'." - :type 'integer) + :type 'natnum) (defcustom ido-work-directory-list-ignore-regexps nil "List of regexps matching directories which should not be recorded. diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el index 78a2df72c4..8c49c1edf2 100644 --- a/lisp/image/gravatar.el +++ b/lisp/image/gravatar.el @@ -45,7 +45,7 @@ "Time to live in seconds for gravatar cache entries. If a requested gravatar has been cached for longer than this, it is retrieved anew. The default value is 30 days." - :type 'integer + :type 'natnum ;; Restricted :type to number of seconds. :version "27.1" :group 'gravatar) diff --git a/lisp/imenu.el b/lisp/imenu.el index 4393c6ed6c..040e373fb4 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -87,7 +87,7 @@ This might not yet be honored by all index-building functions." (defcustom imenu-auto-rescan-maxout 600000 "Imenu auto-rescan is disabled in buffers larger than this size (in bytes). Also see `imenu-max-index-time'." - :type 'integer + :type 'natnum :version "26.2") (defcustom imenu-use-popup-menu 'on-mouse @@ -132,7 +132,7 @@ element should come before the second. The arguments are cons cells; (defcustom imenu-max-items 25 "Maximum number of elements in a mouse menu for Imenu." - :type 'integer) + :type 'natnum) (defcustom imenu-space-replacement "." "The replacement string for spaces in index names. diff --git a/lisp/informat.el b/lisp/informat.el index e7595fa541..c126ab5b1a 100644 --- a/lisp/informat.el +++ b/lisp/informat.el @@ -158,7 +158,7 @@ ;;;###autoload (defcustom Info-split-threshold 262144 "The number of characters by which `Info-split' splits an info file." - :type 'integer + :type 'natnum :version "23.1" :group 'texinfo) diff --git a/lisp/mail/hashcash.el b/lisp/mail/hashcash.el index b343a017e3..8d274d9cac 100644 --- a/lisp/mail/hashcash.el +++ b/lisp/mail/hashcash.el @@ -57,7 +57,7 @@ "The default number of bits to pay to unknown users. If this is zero, no payment header will be generated. See `hashcash-payment-alist'." - :type 'integer + :type 'natnum :group 'hashcash) (defcustom hashcash-payment-alist '() @@ -77,7 +77,7 @@ present, is the string to be hashed; if not present ADDR will be used." (defcustom hashcash-default-accept-payment 20 "The default minimum number of bits to accept on incoming payments." - :type 'integer + :type 'natnum :group 'hashcash) (defcustom hashcash-accept-resources `((,user-mail-address nil)) diff --git a/lisp/mail/mail-hist.el b/lisp/mail/mail-hist.el index e02d4218dd..a13f9de174 100644 --- a/lisp/mail/mail-hist.el +++ b/lisp/mail/mail-hist.el @@ -80,7 +80,7 @@ previous/next input.") (defcustom mail-hist-history-size (or kill-ring-max 1729) "The maximum number of elements in a mail field's history. Oldest elements are dumped first." - :type 'integer) + :type 'natnum) ;;;###autoload (defcustom mail-hist-keep-history t diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 88e55e968c..da786dec00 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -171,7 +171,7 @@ attempt." "The number of times smtpmail will retry sending when getting transient errors. These are errors with a code of 4xx from the SMTP server, which mean \"try again\"." - :type 'integer + :type 'natnum :version "27.1") (defcustom smtpmail-store-queue-variables nil diff --git a/lisp/msb.el b/lisp/msb.el index 6e1d03ac27..616799f067 100644 --- a/lisp/msb.el +++ b/lisp/msb.el @@ -299,7 +299,7 @@ If the value is not a number, then the value 10 is used." (defcustom msb-display-most-recently-used 15 "How many buffers should be in the most-recently-used menu. No buffers at all if less than 1 or nil (or any non-number)." - :type 'integer + :type 'natnum :set #'msb-custom-set) (defcustom msb-most-recently-used-title "Most recently used (%d)" diff --git a/lisp/nxml/rng-valid.el b/lisp/nxml/rng-valid.el index 56ff3b66c0..b9c980222e 100644 --- a/lisp/nxml/rng-valid.el +++ b/lisp/nxml/rng-valid.el @@ -110,14 +110,14 @@ (defcustom rng-state-cache-distance 2000 "Distance in characters between each parsing and validation state cache." - :type 'integer) + :type 'natnum) (defcustom rng-validate-chunk-size 8000 "Number of characters in a RELAX NG validation chunk. A validation chunk will be the smallest chunk that is at least this size and ends with a tag. After validating a chunk, validation will continue only if Emacs is still idle." - :type 'integer) + :type 'natnum) (defcustom rng-validate-delay 1.5 "Time in seconds that Emacs must be idle before starting a full validation. diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 03beb06569..21bb75ae0c 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -684,7 +684,7 @@ Note that this variable only takes effect when variable Until there are such number of source windows on screen, GDB tries to open a new window when visiting a new source file; after that GDB starts to reuse existing source windows." - :type 'number + :type 'natnum :group 'gdb :version "28.1") diff --git a/lisp/recentf.el b/lisp/recentf.el index 4bc1ab5c21..b80ee3dd7d 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -837,7 +837,7 @@ corresponding sub-menu items are displayed in the main recent files menu or in the `recentf-arrange-by-rule-others' sub-menu if defined." :group 'recentf-filters - :type 'number) + :type 'natnum) (defcustom recentf-arrange-by-rule-subfilter nil "Function called by a rule based filter to filter sub-menu elements. diff --git a/lisp/simple.el b/lisp/simple.el index 042384bbe7..e79487eba8 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -5456,7 +5456,7 @@ ring directly.") (defcustom kill-ring-max 120 "Maximum length of kill ring before oldest elements are thrown away." - :type 'integer + :type 'natnum :group 'killing :version "29.1") @@ -7026,7 +7026,7 @@ is set to the buffer displayed in that window.") (defcustom mark-ring-max 16 "Maximum size of mark ring. Start discarding off end if gets this big." - :type 'integer + :type 'natnum :group 'editing-basics) (defvar global-mark-ring nil @@ -7035,7 +7035,7 @@ is set to the buffer displayed in that window.") (defcustom global-mark-ring-max 16 "Maximum size of global mark ring. \ Start discarding off end if gets this big." - :type 'integer + :type 'natnum :group 'editing-basics) (defun pop-to-mark-command () diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 80b0aabd77..3e3b4c9559 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -288,7 +288,7 @@ variable `tab-line-tab-name-function'." "Maximum length of the tab name from the current buffer. Effective when `tab-line-tab-name-function' is customized to `tab-line-tab-name-truncated-buffer'." - :type 'integer + :type 'natnum :group 'tab-line :version "27.1") diff --git a/lisp/term.el b/lisp/term.el index c129ed976d..a28d8c5d76 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -915,7 +915,7 @@ Term buffers are truncated from the top to be no greater than this number. Notice that a setting of 0 means \"don't truncate anything\". This variable is buffer-local." :group 'term - :type 'integer + :type 'natnum :version "27.1") (defcustom term-bind-function-keys nil @@ -2473,7 +2473,7 @@ Checks if STRING contains a password prompt as defined by "Long inputs send to term processes are broken up into chunks of this size. If your process is choking on big inputs, try lowering the value." :group 'term - :type 'integer) + :type 'natnum) (defun term-send-string (proc str) "Send to PROC the contents of STR as input. diff --git a/lisp/thumbs.el b/lisp/thumbs.el index e622bcedc4..158597d7c8 100644 --- a/lisp/thumbs.el +++ b/lisp/thumbs.el @@ -73,16 +73,16 @@ (defcustom thumbs-per-line 4 "Number of thumbnails per line to show in directory." - :type 'integer) + :type 'natnum) (defcustom thumbs-max-image-number 16 - "Maximum number of images initially displayed in thumbs buffer." - :type 'integer) + "Maximum number of images initially displayed in thumbs buffer." + :type 'natnum) (defcustom thumbs-thumbsdir-max-size 50000000 "Maximum size for thumbnails directory. -When it reaches that size (in bytes), a warning is sent." - :type 'integer) +When it reaches that size (in bytes), a warning is displayed." + :type 'natnum) ;; Unfortunately Windows XP has a program called CONVERT.EXE in ;; C:/WINDOWS/SYSTEM32/ for partitioning NTFS systems. So Emacs @@ -106,12 +106,12 @@ This must be the ImageMagick \"convert\" utility." (defcustom thumbs-relief 5 "Size of button-like border around thumbnails." - :type 'integer) + :type 'natnum) (defcustom thumbs-margin 2 "Size of the margin around thumbnails. This is where you see the cursor." - :type 'integer) + :type 'natnum) (defcustom thumbs-thumbsdir-auto-clean t "If set, delete older file in the thumbnails directory. @@ -121,7 +121,7 @@ than `thumbs-thumbsdir-max-size'." (defcustom thumbs-image-resizing-step 10 "Step by which to resize image as a percentage." - :type 'integer) + :type 'natnum) (defcustom thumbs-temp-dir temporary-file-directory "Temporary directory to use. diff --git a/lisp/type-break.el b/lisp/type-break.el index 267facccc4..dca5a43b89 100644 --- a/lisp/type-break.el +++ b/lisp/type-break.el @@ -69,7 +69,7 @@ (defcustom type-break-interval (* 60 60) "Number of seconds between scheduled typing breaks." - :type 'integer + :type 'natnum :group 'type-break) (defcustom type-break-good-rest-interval (/ type-break-interval 6) @@ -82,7 +82,7 @@ rest from typing, then the next typing break is simply rescheduled for later. If a break is interrupted before this much time elapses, the user will be asked whether or not really to interrupt the break." :set-after '(type-break-interval) - :type 'integer + :type 'natnum :group 'type-break) (defcustom type-break-good-break-interval nil @@ -148,7 +148,7 @@ To avoid being queried at all, set `type-break-query-mode' to nil." "Number of seconds between queries to take a break, if put off. The user will continue to be prompted at this interval until he or she finally submits to taking a typing break." - :type 'integer + :type 'natnum :group 'type-break) (defcustom type-break-time-warning-intervals '(300 120 60 30) @@ -171,7 +171,7 @@ will occur." "Number of keystrokes for which warnings should be repeated. That is, for each of this many keystrokes the warning is redisplayed in the echo area to make sure it's really seen." - :type 'integer + :type 'natnum :group 'type-break) (defcustom type-break-time-stamp-format "[%H:%M] " diff --git a/lisp/vc/compare-w.el b/lisp/vc/compare-w.el index b56b4c0d83..64d5d1081a 100644 --- a/lisp/vc/compare-w.el +++ b/lisp/vc/compare-w.el @@ -1,7 +1,6 @@ ;;; compare-w.el --- compare text between windows for Emacs -*- lexical-binding: t; -*- -;; Copyright (C) 1986, 1989, 1993, 1997, 2001-2022 Free Software -;; Foundation, Inc. +;; Copyright (C) 1986-2022 Free Software Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org ;; Keywords: convenience files vc @@ -99,7 +98,7 @@ may fail by finding the wrong match. The bigger number makes difference regions more coarse-grained. The default value 32 is good for the most cases." - :type 'integer + :type 'natnum :version "22.1") (defcustom compare-windows-recenter nil diff --git a/lisp/woman.el b/lisp/woman.el index fd5fee2005..73e068a822 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -843,7 +843,7 @@ Only useful when run on a graphic display such as X or MS-Windows." (defcustom woman-fill-column 65 "Right margin for formatted text -- default is 65." - :type 'integer + :type 'natnum :group 'woman-formatting) (defcustom woman-fill-frame nil commit 22bcbf8e2cc271555a737c176c48e89daa0c17be Author: Stefan Kangas Date: Wed Jul 6 15:25:56 2022 +0200 Fix missing :value with defcustom const :type * lisp/calendar/calendar.el (calendar-intermonth-header) (calendar-intermonth-text, calendar-date-style): * lisp/calendar/diary-lib.el (diary-face-attrs): * lisp/emacs-lisp/package.el (package-check-signature): * lisp/erc/erc-dcc.el (erc-dcc-get-default-directory): * lisp/gnus/gnus-art.el (gnus-auto-select-part): * lisp/gnus/gnus-cus.el (gnus-agent-parameters): * lisp/gnus/gnus.el (gnus-user-agent): * lisp/mail/rmail.el (rmail-retry-ignored-headers): * lisp/progmodes/sh-script.el (sh-indent-after-continuation): Fix missing :value with defcustom const :type. diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 0d9e697644..c1f176050c 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -565,7 +565,7 @@ See `calendar-intermonth-text'." :set (lambda (sym val) (set sym val) (calendar-redraw)) - :type '(choice (const nil :tag "Nothing") + :type '(choice (const :value nil :tag "Nothing") (string :tag "Fixed string") (sexp :value (propertize "WK" 'font-lock-face @@ -597,7 +597,7 @@ See also `calendar-intermonth-header'." :set (lambda (sym val) (set sym val) (calendar-redraw)) - :type '(choice (const nil :tag "Nothing") + :type '(choice (const :value nil :tag "Nothing") (string :tag "Fixed string") (sexp :value (propertize @@ -742,9 +742,9 @@ Setting this variable directly does not take effect (if the calendar package is already loaded). Rather, use either \\[customize] or the function `calendar-set-date-style'." :version "23.1" - :type '(choice (const american :tag "Month/Day/Year") - (const european :tag "Day/Month/Year") - (const iso :tag "Year/Month/Day")) + :type '(choice (const :value american :tag "American (Month/Day/Year)") + (const :value european :tag "European (Day/Month/Year)") + (const :value iso :tag "ISO 8601 (Year/Month/Day)")) :initialize 'custom-initialize-default :set (lambda (_symbol value) (calendar-set-date-style value)) diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 48dbf33adf..084d2d7d55 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -100,11 +100,11 @@ are: `string', `symbol', `int', `tnil', `stringtnil'." :type '(repeat (list (regexp :tag "Regular expression") (integer :tag "Sub-expression") (symbol :tag "Attribute (e.g. :foreground)") - (choice (const string :tag "A string") - (const symbol :tag "A symbol") - (const int :tag "An integer") - (const tnil :tag "t or nil") - (const stringtnil + (choice (const :value string :tag "A string") + (const :value symbol :tag "A symbol") + (const :value int :tag "An integer") + (const :value tnil :tag "t or nil") + (const :value stringtnil :tag "A string, t, or nil")))) :group 'diary) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 85a154a8e0..c8b6667597 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -355,10 +355,10 @@ More specifically the value can be: This also applies to the \"archive-contents\" file that lists the contents of the archive." - :type '(choice (const nil :tag "Never") - (const allow-unsigned :tag "Allow unsigned") - (const t :tag "Check always") - (const all :tag "Check all signatures")) + :type '(choice (const :value nil :tag "Never") + (const :value allow-unsigned :tag "Allow unsigned") + (const :value t :tag "Check always") + (const :value all :tag "Check all signatures")) :risky t :version "27.1") diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index ff486b2d4e..d0e1848e0e 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -391,7 +391,7 @@ the accepted connection." (defcustom erc-dcc-get-default-directory nil "Default directory for incoming DCC file transfers. If this is nil, then the current value of `default-directory' is used." - :type '(choice (const nil :tag "Default directory") directory)) + :type '(choice (const :value nil :tag "Default directory") directory)) ;;;###autoload (defun erc-cmd-DCC (cmd &rest args) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 2a56a12dbb..4b68a54ce8 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -1091,9 +1091,9 @@ positive (negative), move point forward (backwards) this many parts. When nil, redisplay article." :version "23.1" ;; No Gnus :group 'gnus-article-mime - :type '(choice (const nil :tag "Redisplay article.") - (const 1 :tag "Next part.") - (const 0 :tag "Current part.") + :type '(choice (const :value nil :tag "Redisplay article") + (const :value 1 :tag "Next part") + (const :value 0 :tag "Current part") integer)) ;;; diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el index f8714a95d4..ddd939794d 100644 --- a/lisp/gnus/gnus-cus.el +++ b/lisp/gnus/gnus-cus.el @@ -273,7 +273,7 @@ DOC is a documentation string for the parameter.") gnus-agent-cat-predicate) (agent-score (choice :tag "Score File" :value nil - (const file :tag "Use group's score files") + (const :value file :tag "Use group's score files") (repeat (list (string :format "%v" :tag "File name")))) "Which score files to use when using score to select articles to fetch. diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index f60c11f985..2119e68509 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -2263,12 +2263,12 @@ a string, be sure to use a valid format, see RFC 2616." :version "22.1" :group 'gnus-message :type '(choice (list (set :inline t - (const gnus :tag "Gnus version") - (const emacs :tag "Emacs version") + (const :value gnus :tag "Gnus version") + (const :value emacs :tag "Emacs version") (choice :tag "system" - (const type :tag "system type") - (const config :tag "system configuration")) - (const codename :tag "Emacs codename"))) + (const :value type :tag "system type") + (const :value config :tag "system configuration")) + (const :value codename :tag "Emacs codename"))) (string))) ;; Convert old (< 2005-01-10) symbol type values: diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index adb61aa09d..b2b21b88ef 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -388,7 +388,7 @@ If nil, display all header fields except those matched by ;;;###autoload (defcustom rmail-retry-ignored-headers (purecopy "^x-authentication-warning:\\|^x-detected-operating-system:\\|^x-spam[-a-z]*:\\|content-type:\\|content-transfer-encoding:\\|mime-version:\\|message-id:") "Headers that should be stripped when retrying a failed message." - :type '(choice regexp (const nil :tag "None")) + :type '(choice regexp (const :value nil :tag "None")) :group 'rmail-headers :version "23.2") ; added x-detected-operating-system, x-spam diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index c3e93c397a..71fb0cd2e0 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1926,9 +1926,9 @@ With t, you get the latter as long as that would indent the continuation line deeper than the initial line." :version "25.1" :type '(choice - (const nil :tag "Never") - (const t :tag "Only if needed to make it deeper") - (const always :tag "Always")) + (const :value nil :tag "Never") + (const :value t :tag "Only if needed to make it deeper") + (const :value always :tag "Always")) :group 'sh-indentation) (defun sh-smie--continuation-start-indent () commit b5cd9343aea2d7939209c35eef3247946df24dfa Author: Po Lu Date: Wed Jul 6 12:23:19 2022 +0000 Fix infinite looping around Haiku menus * src/haikumenu.c (haiku_menu_show): Block SIGIO around menu event loop. * src/haikuterm.c (haiku_read_socket): Flush tooltip frames after resize. diff --git a/src/haikumenu.c b/src/haikumenu.c index 5729bed4a9..3f68eadfd9 100644 --- a/src/haikumenu.c +++ b/src/haikumenu.c @@ -422,11 +422,13 @@ haiku_menu_show (struct frame *f, int x, int y, int menuflags, BView_convert_to_screen (view, &x, &y); unblock_input (); + unrequest_sigio (); popup_activated_p++; menu_item_selection = BMenu_run (menu, x, y, haiku_menu_show_help, block_input, unblock_input, haiku_process_pending_signals_for_menu, NULL); popup_activated_p--; + request_sigio (); FRAME_DISPLAY_INFO (f)->grabbed = 0; diff --git a/src/haikuterm.c b/src/haikuterm.c index 9f8aceae64..d7247c99e0 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -3202,6 +3202,11 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) FRAME_PIXEL_HEIGHT (f) = height; haiku_clear_under_internal_border (f); + + /* Flush the frame and flip buffers here. It is + necessary for tooltips displayed inside menus, as + redisplay cannot happen. */ + haiku_flush (f); continue; } @@ -4438,6 +4443,7 @@ haiku_clear_under_internal_border (struct frame *f) : INTERNAL_BORDER_FACE_ID)); struct face *face = FACE_FROM_ID_OR_NULL (f, face_id); void *view = FRAME_HAIKU_VIEW (f); + block_input (); BView_draw_lock (view, true, 0, 0, FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f)); commit a2e56a8d659d31466c248a38a954a1b165087781 Author: Davide Masserut Date: Wed Jul 6 13:45:40 2022 +0200 Send region to the subshell specified by the current file interpreter * sh-script.el (sh-execute-region): Send region to the subshell specified by the current file interpreter (bug#56406). diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 75758fd39a..c3e93c397a 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -2410,6 +2410,8 @@ Lines containing only comments are considered empty." The working directory is that of the buffer, and only environment variables are already set which is why you can mark a header within the script. +The executed subshell is `sh-shell-file'. + With a positive prefix ARG, instead of sending region, define header from beginning of buffer to point. With a negative prefix ARG, instead of sending region, clear header." @@ -2417,17 +2419,18 @@ region, clear header." (if flag (setq sh-header-marker (if (> (prefix-numeric-value flag) 0) (point-marker))) - (if sh-header-marker - (save-excursion - (let (buffer-undo-list) - (goto-char sh-header-marker) - (append-to-buffer (current-buffer) start end) - (shell-command-on-region (point-min) - (setq end (+ sh-header-marker - (- end start))) - sh-shell-file) - (delete-region sh-header-marker end))) - (shell-command-on-region start end (concat sh-shell-file " -"))))) + (let ((shell-file-name sh-shell-file)) + (if sh-header-marker + (save-excursion + (let (buffer-undo-list) + (goto-char sh-header-marker) + (append-to-buffer (current-buffer) start end) + (shell-command-on-region (point-min) + (setq end (+ sh-header-marker + (- end start))) + sh-shell-file) + (delete-region sh-header-marker end))) + (shell-command-on-region start end (concat sh-shell-file " -")))))) (defun sh-remember-variable (var) commit 706d1fb5ec3151adf4886bd867710acdc88b9786 Author: Manuel Giraud Date: Wed Jul 6 13:18:09 2022 +0200 Remove soft newlines in longlines-mode * lisp/longlines.el (longlines-mode, longlines-encode-string): Update from `buffer-substring-filters' to `filter-buffer-substring-function'. Remove soft newlines in substring (bug#56335). diff --git a/lisp/longlines.el b/lisp/longlines.el index a6cf93a039..6dc2f61ed9 100644 --- a/lisp/longlines.el +++ b/lisp/longlines.el @@ -118,7 +118,6 @@ newlines are indicated with a symbol." (add-to-list 'buffer-file-format 'longlines) (add-hook 'change-major-mode-hook #'longlines-mode-off nil t) (add-hook 'before-revert-hook #'longlines-before-revert-hook nil t) - (make-local-variable 'buffer-substring-filters) (make-local-variable 'longlines-auto-wrap) (set (make-local-variable 'isearch-search-fun-function) #'longlines-search-function) @@ -126,7 +125,8 @@ newlines are indicated with a symbol." #'longlines-search-forward) (set (make-local-variable 'replace-re-search-function) #'longlines-re-search-forward) - (add-to-list 'buffer-substring-filters 'longlines-encode-string) + (add-function :filter-return (local 'filter-buffer-substring-function) + #'longlines-encode-string) (when longlines-wrap-follows-window-size (let ((dw (if (and (integerp longlines-wrap-follows-window-size) (>= longlines-wrap-follows-window-size 0) @@ -143,7 +143,7 @@ newlines are indicated with a symbol." (inhibit-modification-hooks t) (mod (buffer-modified-p)) buffer-file-name buffer-file-truename) - ;; Turning off undo is OK since (spaces + newlines) is + ;; Turning off undo is OK since (separators + newlines) is ;; conserved, except for a corner case in ;; longlines-wrap-lines that we'll never encounter from here (save-restriction @@ -202,7 +202,8 @@ newlines are indicated with a symbol." (kill-local-variable 'replace-search-function) (kill-local-variable 'replace-re-search-function) (kill-local-variable 'require-final-newline) - (kill-local-variable 'buffer-substring-filters) + (remove-function (local 'filter-buffer-substring-function) + #'longlines-encode-string) (kill-local-variable 'use-hard-newlines))) (defun longlines-mode-off () @@ -385,15 +386,22 @@ compatibility with `format-alist', and is ignored." end))) (defun longlines-encode-string (string) - "Return a copy of STRING with each soft newline replaced by a space. + "Return a copy of STRING with each soft newline removed. Hard newlines are left intact." - (let* ((str (copy-sequence string)) - (pos (string-search "\n" str))) - (while pos - (if (null (get-text-property pos 'hard str)) - (aset str pos ? )) - (setq pos (string-search "\n" str (1+ pos)))) - str)) + (let ((start 0) + (result nil) + pos) + (while (setq pos (string-search "\n" string start)) + (unless (= start pos) + (push (substring string start pos) result)) + (when (get-text-property pos 'hard string) + (push (substring string pos (1+ pos)) result)) + (setq start (1+ pos))) + (if (null result) + (copy-sequence string) + (unless (= start (length string)) + (push (substring string start) result)) + (apply #'concat (nreverse result))))) ;;; Auto wrap commit f9d01e504711676d7c223ad9543256a9d34fde55 Author: Stefan Kangas Date: Wed Jul 6 12:31:01 2022 +0200 ; * lisp/emacs-lisp/ert.el: Remove installation instructions. (cherry picked from commit ef218ac936c3ffe219b57e37e684fd8400389c38) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 41180f9914..156eeadb5d 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -47,8 +47,6 @@ ;; environment (like availability of features, external binaries, etc). ;; ;; See ERT's info manual as well as the docstrings for more details. -;; To compile the manual, run `makeinfo ert.texinfo' in the ERT -;; directory, then C-u M-x info ert.info in Emacs to view it. ;; ;; To see some examples of tests written in ERT, see its self-tests in ;; ert-tests.el. Some of these are tricky due to the bootstrapping commit ef218ac936c3ffe219b57e37e684fd8400389c38 Author: Stefan Kangas Date: Wed Jul 6 12:31:01 2022 +0200 ; * lisp/emacs-lisp/ert.el: Remove installation instructions. diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 82722add42..262d85f9b4 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -47,8 +47,6 @@ ;; environment (like availability of features, external binaries, etc). ;; ;; See ERT's info manual as well as the docstrings for more details. -;; To compile the manual, run `makeinfo ert.texinfo' in the ERT -;; directory, then C-u M-x info ert.info in Emacs to view it. ;; ;; To see some examples of tests written in ERT, see its self-tests in ;; ert-tests.el. Some of these are tricky due to the bootstrapping commit f65e4c46a3418c7f24f53503feda42e844951997 Author: F. Jason Park Date: Tue Jul 5 03:46:00 2022 -0700 * lisp/erc/erc-track.el (erc-track-minor-mode-map): Doc fix. diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index d02a8d13e5..ef9a8c243e 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -458,7 +458,7 @@ START is the minimum length of the name used." (define-key map (kbd "C-c C-@") #'erc-track-switch-buffer) (define-key map (kbd "C-c C-SPC") #'erc-track-switch-buffer) map) - "Keymap for rcirc track minor mode.") + "Keymap for ERC track minor mode.") ;;;###autoload (define-minor-mode erc-track-minor-mode commit 0bacb8f9e74aefd39c492d34b01800aeb1e53c98 Author: dickmao Date: Fri Jul 1 11:06:51 2022 -0400 Use compatibility macro for ISUPPORT caching in ERC * lisp/erc/erc-backend.el (erc--with-memoization): Defalias was a kung-fu I've never seen before. (Bug#56340) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index bee2551d76..bc7a7d14dc 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1673,12 +1673,15 @@ Then display the welcome message." (split-string value ",") (list value))))) -;; FIXME move to erc-compat (once we decide how to load it) -(defalias 'erc--with-memoization - (cond - ((fboundp 'with-memoization) #'with-memoization) ; 29.1 - ((fboundp 'cl--generic-with-memoization) #'cl--generic-with-memoization) - (t (lambda (_ v) v)))) +(defmacro erc--with-memoization (table &rest forms) + "Adapter to be migrated to erc-compat." + (declare (indent defun)) + `(cond + ((fboundp 'with-memoization) + (with-memoization ,table ,@forms)) ; 29.1 + ((fboundp 'cl--generic-with-memoization) + (cl--generic-with-memoization ,table ,@forms)) + (t ,@forms))) (defun erc--get-isupport-entry (key &optional single) "Return an item for \"ISUPPORT\" token KEY, a symbol. commit e6504c3eda12c72268d2db6598764f043b74c24d Author: Po Lu Date: Wed Jul 6 16:31:54 2022 +0800 Stop synchronizing after sending XEmbed events * src/xterm.c (xembed_send_message): Don't sync and handle errors, which is actually why the XSync call in the spec exists. diff --git a/src/xterm.c b/src/xterm.c index 0180ea3c78..225c45ff7c 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -25208,9 +25208,14 @@ xembed_send_message (struct frame *f, Time t, enum xembed_message msg, event.xclient.data.l[3] = data1; event.xclient.data.l[4] = data2; + /* XXX: the XEmbed spec tells us to trap errors around this request, + but I don't understand why: there is no way for clients to + survive the death of the parent anyway. */ + + x_ignore_errors_for_next_request (FRAME_DISPLAY_INFO (f)); XSendEvent (FRAME_X_DISPLAY (f), FRAME_X_OUTPUT (f)->parent_desc, False, NoEventMask, &event); - XSync (FRAME_X_DISPLAY (f), False); + x_stop_ignoring_errors (FRAME_DISPLAY_INFO (f)); } /* Change of visibility. */ commit 939dc2ff126dbca1f1c31989f2c11a4fdc35648c Author: Martin Rudalics Date: Wed Jul 6 09:25:43 2022 +0200 Fix 'fit-frame-to-buffer' (Bug#56102) * lisp/window.el (fit-frame-to-buffer-sizes): Fix doc-string. Give calls to 'max' a second argument so they do something useful. If ONLY equals 'vertically', call 'window-text-pixel-size' with X-LIMIT nil (Bug#56102). For minimum sizes of the window to fit, use 'window-safe-min-size' by default. * doc/lispref/windows.texi (Resizing Windows): Fix descriptions of 'fit-frame-to-buffer' and 'fit-frame-to-buffer-sizes'. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 704ed30366..535571b316 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -1158,11 +1158,13 @@ frame to its buffer using the command @code{fit-frame-to-buffer}. This command adjusts the size of @var{frame} to display the contents of its buffer exactly. @var{frame} can be any live frame and defaults to the selected one. Fitting is done only if @var{frame}'s root window is -live. The arguments @var{max-height}, @var{min-height}, @var{max-width} -and @var{min-width} specify bounds on the new total size of -@var{frame}'s root window. @var{min-height} and @var{min-width} default -to the values of @code{window-min-height} and @code{window-min-width} -respectively. +live. + +The arguments @var{max-height}, @var{min-height}, @var{max-width} and +@var{min-width}, if non-@code{nil}, specify bounds on the new body size +of @var{frame}'s root window. A non-@code{nil} value specified by any +of these arguments overrides the corresponding value specified by +the option @code{fit-frame-to-buffer-sizes} described below. If the optional argument @var{only} is @code{vertically}, this function may resize the frame vertically only. If @var{only} is @@ -1187,10 +1189,10 @@ here can be overridden for a specific frame by that frame's @defopt fit-frame-to-buffer-sizes This option specifies size boundaries for @code{fit-frame-to-buffer}. -It specifies the total maximum and minimum lines and maximum and minimum -columns of the root window of any frame that shall be fit to its buffer. -If any of these values is non-@code{nil}, it overrides the corresponding -argument of @code{fit-frame-to-buffer}. +It specifies the maximum and minimum lines and maximum and minimum +columns of the root window's body of any frame that shall be fit to its +buffer. Any value this option specifies will be overridden by the +corresponding argument of @code{fit-frame-to-buffer}, if non-@code{nil}. @end defopt @deffn Command shrink-window-if-larger-than-buffer &optional window diff --git a/lisp/window.el b/lisp/window.el index a3ef2521bb..4d88ffa903 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -9179,10 +9179,11 @@ present. See also `fit-frame-to-buffer-sizes'." (defcustom fit-frame-to-buffer-sizes '(nil nil nil nil) "Size boundaries of frame for `fit-frame-to-buffer'. -This list specifies the total maximum and minimum lines and -maximum and minimum columns of the root window of any frame that -shall be fit to its buffer. If any of these values is non-nil, -it overrides the corresponding argument of `fit-frame-to-buffer'. +This list specifies the total maximum and minimum numbers of +lines and the maximum and minimum numbers of columns of the body +of the root window of any frame that shall be fit to its buffer. +Any value specified by ths variable will be overridden by the +corresponding argument of `fit-frame-to-buffer', if non-nil. On window systems where the menubar can wrap, fitting a frame to its buffer may swallow the last line(s). Specifying an @@ -9378,30 +9379,30 @@ for `fit-frame-to-buffer'." (t parent-or-display-height)) ;; The following is the maximum height that fits into the ;; top and bottom margins. - (max (- bottom-margin top-margin outer-minus-body-height)))) + (max (- bottom-margin top-margin outer-minus-body-height) 0))) (min-height (cond ((numberp min-height) (* min-height line-height)) ((numberp (nth 1 sizes)) (* (nth 1 sizes) line-height)) - (t (window-min-size window nil nil t)))) + (t (window-safe-min-size window nil t)))) (max-width - (min - (cond - ((numberp max-width) (* max-width char-width)) - ((numberp (nth 2 sizes)) (* (nth 2 sizes) char-width)) - (t parent-or-display-width)) - ;; The following is the maximum width that fits into the - ;; left and right margins. - (max (- right-margin left-margin outer-minus-body-width)))) + (unless (eq only 'vertically) + (min + (cond + ((numberp max-width) (* max-width char-width)) + ((numberp (nth 2 sizes)) (* (nth 2 sizes) char-width)) + (t parent-or-display-width)) + ;; The following is the maximum width that fits into the + ;; left and right margins. + (max (- right-margin left-margin outer-minus-body-width) 0)))) (min-width (cond ((numberp min-width) (* min-width char-width)) - ((numberp (nth 3 sizes)) (nth 3 sizes)) - (t (window-min-size window t nil t)))) + ((numberp (nth 3 sizes)) (* (nth 3 sizes) char-width)) + (t (window-safe-min-size window t t)))) ;; Note: Currently, for a new frame the sizes of the header ;; and mode line may be estimated incorrectly - (size - (window-text-pixel-size window from to max-width max-height)) + (size (window-text-pixel-size window from to max-width max-height)) (width (max (car size) min-width)) (height (max (cdr size) min-height))) ;; Don't change height or width when the window's size is fixed