From 72d040ce7db94979dd2baa951919478faef928a0 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 29 Oct 2023 00:38:02 +0200 Subject: [PATCH 01/12] Prefer seq-filter in rcirc.el Benchmarking shows seq-filter to be ~30% faster on this machine. * lisp/net/rcirc.el (rcirc-condition-filter): Make into an obsolete alias for 'seq-filter'. Update single caller. --- lisp/net/rcirc.el | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 7cc7adc45c7..ecfeb9f8f84 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2974,20 +2974,13 @@ keywords when no KEYWORD is given." browse-url-button-regexp) "Regexp matching URLs. Set to nil to disable URL features in rcirc.") -;; cf cl-remove-if-not -(defun rcirc-condition-filter (condp lst) - "Remove all items not satisfying condition CONDP in list LST. -CONDP is a function that takes a list element as argument and returns -non-nil if that element should be included. Returns a new list." - (delq nil (mapcar (lambda (x) (and (funcall condp x) x)) lst))) - (defun rcirc-browse-url (&optional arg) "Prompt for URL to browse based on URLs in buffer before point. If ARG is given, opens the URL in a new browser window." (interactive "P") (let* ((point (point)) - (filtered (rcirc-condition-filter + (filtered (seq-filter (lambda (x) (>= point (cdr x))) rcirc-urls)) (completions (mapcar (lambda (x) (car x)) filtered)) @@ -4008,6 +4001,8 @@ PROCESS is the process object for the current connection." (define-obsolete-function-alias 'rcirc-format-strike-trough 'rcirc-format-strike-through "30.1") +(define-obsolete-function-alias 'rcirc-condition-filter #'seq-filter "30.1") + (provide 'rcirc) ;;; rcirc.el ends here From e08238cdd74719d4cd99cf5a4f743eb8c6d1d251 Mon Sep 17 00:00:00 2001 From: Morgan Smith Date: Tue, 6 Sep 2022 21:18:51 -0400 Subject: [PATCH 02/12] Speed up Eshell smart display module em-smart was forcibly re-displaying the screen upwards of 500 times per screen of output. This caused the Eshell to feel quite slow when the module was in use. By using fewer hooks and never explicitly calling 'redisplay' (which was unnecessary) the performance issues go away (bug#57367). lisp/eshell/em-smart.el: (em-smart-unload-hook, eshell-smart-unload-hook): Remove 'eshell-smart-scroll' instead of the now deleted 'eshell-refresh-windows'. (eshell-smart-displayed, eshell-currently-handling-window) (eshell-refresh-windows): Delete. (eshell-smart-scroll-window): Rename to 'eshell-smart-scroll-windows' and add a bunch of logic originally from 'eshell-refresh-windows'. (eshell-smart-initialize): Don't add a hook onto 'window-scroll-functions'. Replace 'eshell-refresh-windows' with 'eshell-smart-scroll-windows'. (eshell-smart-display-setup): Don't refresh windows. (eshell-smart-redisplay): Rename to 'eshell-smart-scroll'. Delete 'eobp' case. --- lisp/eshell/em-smart.el | 81 +++++++++++++++-------------------------- 1 file changed, 29 insertions(+), 52 deletions(-) diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el index 4c39a991ec6..fc283547519 100644 --- a/lisp/eshell/em-smart.el +++ b/lisp/eshell/em-smart.el @@ -95,7 +95,7 @@ it to get a real sense of how it works." (list (lambda () (remove-hook 'window-configuration-change-hook - 'eshell-refresh-windows))) + 'eshell-smart-scroll))) "A hook that gets run when `eshell-smart' is unloaded." :type 'hook :group 'eshell-smart) @@ -159,9 +159,7 @@ The options are `begin', `after' or `end'." ;;; Internal Variables: -(defvar eshell-smart-displayed nil) (defvar eshell-smart-command-done nil) -(defvar eshell-currently-handling-window nil) ;;; Functions: @@ -174,10 +172,9 @@ The options are `begin', `after' or `end'." (setq-local eshell-scroll-to-bottom-on-input nil) (setq-local eshell-scroll-show-maximum-output t) - (add-hook 'window-scroll-functions 'eshell-smart-scroll-window nil t) - (add-hook 'window-configuration-change-hook 'eshell-refresh-windows) + (add-hook 'window-configuration-change-hook 'eshell-smart-scroll nil t) - (add-hook 'eshell-output-filter-functions 'eshell-refresh-windows t t) + (add-hook 'eshell-output-filter-functions 'eshell-smart-scroll-windows 90 t) (add-hook 'after-change-functions 'eshell-disable-after-change nil t) @@ -193,28 +190,15 @@ The options are `begin', `after' or `end'." (add-hook 'eshell-post-command-hook 'eshell-smart-maybe-jump-to-end nil t)))) -;; This is called by window-scroll-functions with two arguments. -(defun eshell-smart-scroll-window (wind _start) - "Scroll the given Eshell window WIND accordingly." - (unless eshell-currently-handling-window - (let ((eshell-currently-handling-window t)) - (with-selected-window wind - (eshell-smart-redisplay))))) - -(defun eshell-refresh-windows (&optional frame) - "Refresh all visible Eshell buffers." - (let (affected) - (walk-windows - (lambda (wind) - (with-current-buffer (window-buffer wind) - (if eshell-mode - (let (window-scroll-functions) ;;FIXME: Why? - (eshell-smart-scroll-window wind (window-start)) - (setq affected t))))) - 0 frame) - (if affected - (let (window-scroll-functions) ;;FIXME: Why? - (redisplay))))) +(defun eshell-smart-scroll-windows () + "Scroll all eshell windows to display as much output as possible, smartly." + (walk-windows + (lambda (wind) + (with-current-buffer (window-buffer wind) + (if eshell-mode + (with-selected-window wind + (eshell-smart-scroll))))) + 0 t)) (defun eshell-smart-display-setup () "Set the point to somewhere in the beginning of the last command." @@ -231,8 +215,7 @@ The options are `begin', `after' or `end'." (t (error "Invalid value for `eshell-where-to-jump'"))) (setq eshell-smart-command-done nil) - (add-hook 'pre-command-hook 'eshell-smart-display-move nil t) - (eshell-refresh-windows)) + (add-hook 'pre-command-hook 'eshell-smart-display-move nil t)) ;; Called from after-change-functions with 3 arguments. (defun eshell-disable-after-change (_b _e _l) @@ -254,28 +237,22 @@ and the end of the buffer are still visible." (goto-char (point-max)) (remove-hook 'pre-command-hook 'eshell-smart-display-move t))) -(defun eshell-smart-redisplay () - "Display as much output as possible, smartly." - (if (eobp) +(defun eshell-smart-scroll () + "Scroll WINDOW to display as much output as possible, smartly." + (let ((top-point (point))) + (and (memq 'eshell-smart-display-move pre-command-hook) + (>= (point) eshell-last-input-start) + (< (point) eshell-last-input-end) + (set-window-start (selected-window) + (pos-bol) t)) + (when (pos-visible-in-window-p (point-max) (selected-window)) (save-excursion - (recenter -1) - ;; trigger the redisplay now, so that we catch any attempted - ;; point motion; this is to cover for a redisplay bug - (redisplay)) - (let ((top-point (point))) - (and (memq 'eshell-smart-display-move pre-command-hook) - (>= (point) eshell-last-input-start) - (< (point) eshell-last-input-end) - (set-window-start (selected-window) - (line-beginning-position) t)) - (if (pos-visible-in-window-p (point-max)) - (save-excursion - (goto-char (point-max)) - (recenter -1) - (unless (pos-visible-in-window-p top-point) - (goto-char top-point) - (set-window-start (selected-window) - (line-beginning-position) t))))))) + (goto-char (point-max)) + (recenter -1) + (unless (pos-visible-in-window-p top-point (selected-window)) + (goto-char top-point) + (set-window-start (selected-window) + (pos-bol) t)))))) (defun eshell-smart-goto-end () "Like `end-of-buffer', but do not push a mark." @@ -323,7 +300,7 @@ and the end of the buffer are still visible." (remove-hook 'pre-command-hook 'eshell-smart-display-move t)))) (defun em-smart-unload-hook () - (remove-hook 'window-configuration-change-hook #'eshell-refresh-windows)) + (remove-hook 'window-configuration-change-hook #'eshell-smart-scroll)) (provide 'em-smart) From 3624e9bd409075d4f78b240ebdb356f93fd9c3e4 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 29 Oct 2023 01:40:25 +0200 Subject: [PATCH 03/12] Prefer seq-filter in hanja-util.el Benchmarking shows seq-filter to be ~30% faster on this machine. * lisp/language/hanja-util.el (hanja-filter): Make into obsolete alias for 'seq-filter'. Update single caller. --- lisp/language/hanja-util.el | 18 +++++++----------- 1 file changed, 7 insertions(+), 11 deletions(-) diff --git a/lisp/language/hanja-util.el b/lisp/language/hanja-util.el index be0364b1c23..b5ef9230d27 100644 --- a/lisp/language/hanja-util.el +++ b/lisp/language/hanja-util.el @@ -6479,11 +6479,7 @@ character. This variable is initialized by `hanja-init-load'.") map) "Keymap for Hanja (Korean Hanja Converter).") -(defun hanja-filter (condp lst) - "Construct a list from the elements of LST for which CONDP returns true." - (delq - nil - (mapcar (lambda (x) (and (funcall condp x) x)) lst))) +(define-obsolete-function-alias 'hanja-filter #'seq-filter "30.1") (defun hanja-list-prev-group () "Select the previous group of hangul->hanja conversions." @@ -6570,12 +6566,12 @@ The value is a hanja character that is selected interactively." 0 0 ;; Filter characters that can not be decoded. ;; Maybe it can not represent characters in current terminal coding. - (hanja-filter (lambda (x) (car x)) - (mapcar (lambda (c) - (if (listp c) - (cons (car c) (cdr c)) - (list c))) - (aref hanja-table char))))) + (seq-filter #'car + (mapcar (lambda (c) + (if (listp c) + (cons (car c) (cdr c)) + (list c))) + (aref hanja-table char))))) (unwind-protect (when (aref hanja-conversions 2) (catch 'exit-input-loop From 59a3edc3559057e6f0346e3f1b3b13e8ef3e1683 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 29 Oct 2023 12:59:45 +0800 Subject: [PATCH 04/12] Avert a crash and file descriptor leak in yank-media * java/org/gnu/emacs/EmacsNative.java (close): New declaration. * java/org/gnu/emacs/EmacsSdk11Clipboard.java (getClipboardData): Catch SecurityException and guarantee file descriptors are closed even if exceptions arise. * src/android.c (dup): Export another function. --- java/org/gnu/emacs/EmacsNative.java | 3 +++ java/org/gnu/emacs/EmacsSdk11Clipboard.java | 24 +++++++++++++++++++++ src/android.c | 8 +++++++ 3 files changed, 35 insertions(+) diff --git a/java/org/gnu/emacs/EmacsNative.java b/java/org/gnu/emacs/EmacsNative.java index 7d7e1e5d831..f15927bb3a7 100644 --- a/java/org/gnu/emacs/EmacsNative.java +++ b/java/org/gnu/emacs/EmacsNative.java @@ -39,6 +39,9 @@ public final class EmacsNative /* Like `dup' in C. */ public static native int dup (int fd); + /* Like `close' in C. */ + public static native int close (int fd); + /* Obtain the fingerprint of this build of Emacs. The fingerprint can be used to determine the dump file name. */ public static native String getFingerprint (); diff --git a/java/org/gnu/emacs/EmacsSdk11Clipboard.java b/java/org/gnu/emacs/EmacsSdk11Clipboard.java index b8a43496b6d..b068a89831e 100644 --- a/java/org/gnu/emacs/EmacsSdk11Clipboard.java +++ b/java/org/gnu/emacs/EmacsSdk11Clipboard.java @@ -245,6 +245,8 @@ public final class EmacsSdk11Clipboard extends EmacsClipboard if (data == null || data.getItemCount () < 1) return null; + fd = -1; + try { uri = data.getItemAt (0).getUri (); @@ -267,12 +269,34 @@ public final class EmacsSdk11Clipboard extends EmacsClipboard /* Close the original offset. */ assetFd.close (); } + catch (SecurityException e) + { + /* Guarantee a file descriptor duplicated or detached is + ultimately closed if an error arises. */ + + if (fd != -1) + EmacsNative.close (fd); + + return null; + } catch (FileNotFoundException e) { + /* Guarantee a file descriptor duplicated or detached is + ultimately closed if an error arises. */ + + if (fd != -1) + EmacsNative.close (fd); + return null; } catch (IOException e) { + /* Guarantee a file descriptor duplicated or detached is + ultimately closed if an error arises. */ + + if (fd != -1) + EmacsNative.close (fd); + return null; } diff --git a/src/android.c b/src/android.c index 3344a773d5f..79f16568fd4 100644 --- a/src/android.c +++ b/src/android.c @@ -1260,6 +1260,14 @@ NATIVE_NAME (dup) (JNIEnv *env, jobject object, jint fd) return dup (fd); } +JNIEXPORT jint JNICALL +NATIVE_NAME (close) (JNIEnv *env, jobject object, jint fd) +{ + JNI_STACK_ALIGNMENT_PROLOGUE; + + return close (fd); +} + JNIEXPORT jstring JNICALL NATIVE_NAME (getFingerprint) (JNIEnv *env, jobject object) { From 27ccf2230bced7248a86e3741b45734bde77cb42 Mon Sep 17 00:00:00 2001 From: Manuel Giraud Date: Fri, 6 Oct 2023 14:27:02 +0200 Subject: [PATCH 05/12] Set non-text mouse cursor on menu bar * src/xdisp.c (note_mouse_highlight): Set non-text mouse cursor on menu bar. --- src/xdisp.c | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/xdisp.c b/src/xdisp.c index 578131a4005..20c7634fc3e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -35537,6 +35537,16 @@ note_mouse_highlight (struct frame *f, int x, int y) w = XWINDOW (window); frame_to_window_pixel_xy (w, &x, &y); +#if defined (HAVE_WINDOW_SYSTEM) && ! defined (HAVE_EXT_MENU_BAR) + /* Handle menu-bar window differently since it doesn't display a + buffer. */ + if (EQ (window, f->menu_bar_window)) + { + cursor = FRAME_OUTPUT_DATA (f)->nontext_cursor; + goto set_cursor; + } +#endif + #if defined (HAVE_WINDOW_SYSTEM) /* Handle tab-bar window differently since it doesn't display a buffer. */ From 3dca52dd422c50ebf24a304e7c3d36cf5f1c55cf Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Sat, 21 Oct 2023 10:41:42 -0400 Subject: [PATCH 06/12] Remove the header line after disabling 'which-function-mode' Previously, the header line would stay around even when after disabling 'which-function-mode', although it may be empty. Now the 'which-function-mode' element is properly removed from 'header-line-format', so the header line will disappear if there's nothing else in 'header-line-format'. Also, previously, when we ran (which-function-mode), we would enable 'which-function-mode' for all buffers even if they didn't support imenu. We didn't run the normal logic in 'which-func-ff-hook' to disable 'which-func-mode' if imenu wasn't present. Now we do run that logic, by just calling 'which-func-ff-hook'. This is especially important when the header line is enabled, because otherwise there's a very noticeable header line added to every buffer, including e.g. *Help* and *Buffer List*. Also, we now check that 'header-line-format' is a list before trying to add to it; this makes us work properly when enabling and disabling 'which-function-mode' for modes which set 'header-line-format' to a string or symbol, such as eww. * lisp/progmodes/which-func.el (which-func-try-to-enable): Re-add 'which-func-format' to the header line. (which-func--header-line-remove): New function. (which-func--disable): Call 'which-func--header-line-remove'. (which-function-mode): Call 'which-func-ff-hook' and 'which-func--header-line-remove'. (bug#66283) * test/lisp/progmodes/which-func-tests.el: New test. --- lisp/progmodes/which-func.el | 39 ++++++++++------- test/lisp/progmodes/which-func-tests.el | 58 +++++++++++++++++++++++++ 2 files changed, 82 insertions(+), 15 deletions(-) create mode 100644 test/lisp/progmodes/which-func-tests.el diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 09d0250515f..0e04bab6ea4 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -208,21 +208,28 @@ non-nil.") (add-hook 'after-change-major-mode-hook #'which-func-ff-hook t) (defun which-func-try-to-enable () - (unless (or (not which-function-mode) - (local-variable-p 'which-func-mode)) - (setq which-func-mode (or (eq which-func-modes t) - (member major-mode which-func-modes))) - (setq which-func--use-mode-line - (member which-func-display '(mode mode-and-header))) - (setq which-func--use-header-line - (member which-func-display '(header mode-and-header))) - (when (and which-func-mode which-func--use-header-line) + (when which-function-mode + (unless (local-variable-p 'which-func-mode) + (setq which-func-mode (or (eq which-func-modes t) + (member major-mode which-func-modes))) + (setq which-func--use-mode-line + (member which-func-display '(mode mode-and-header))) + (setq which-func--use-header-line + (member which-func-display '(header mode-and-header)))) + ;; We might need to re-add which-func-format to the header line, + ;; if which-function-mode was toggled off and on. + (when (and which-func-mode which-func--use-header-line + (listp header-line-format)) (add-to-list 'header-line-format '("" which-func-format " "))))) -(defun which-func--disable () - (when (and which-func-mode which-func--use-header-line) +(defun which-func--header-line-remove () + (when (and which-func-mode which-func--use-header-line + (listp header-line-format)) (setq header-line-format - (delete '("" which-func-format " ") header-line-format))) + (delete '("" which-func-format " ") header-line-format)))) + +(defun which-func--disable () + (which-func--header-line-remove) (setq which-func-mode nil)) (defun which-func-ff-hook () @@ -288,9 +295,11 @@ in certain major modes." (when which-function-mode ;;Turn it on. (setq which-func-update-timer - (run-with-idle-timer idle-update-delay t #'which-func-update)) - (dolist (buf (buffer-list)) - (with-current-buffer buf (which-func-try-to-enable))))) + (run-with-idle-timer idle-update-delay t #'which-func-update))) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (which-func--header-line-remove) + (which-func-ff-hook)))) (defvar which-function-imenu-failed nil "Locally t in a buffer if `imenu--make-index-alist' found nothing there.") diff --git a/test/lisp/progmodes/which-func-tests.el b/test/lisp/progmodes/which-func-tests.el new file mode 100644 index 00000000000..73709f1c5e5 --- /dev/null +++ b/test/lisp/progmodes/which-func-tests.el @@ -0,0 +1,58 @@ +;;; which-func-tests.el --- tests for which-func -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; Author: Spencer Baugh + +;; This file is part of GNU Emacs. + +;; This program 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. + +;; This program 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 'which-func) + +(ert-deftest which-func-tests-toggle () + (let ((which-func-display 'mode-and-header) buf-code buf-not) + (setq buf-code (find-file-noselect "which-func-tests.el")) + (setq buf-not (get-buffer-create "fundamental")) + (with-current-buffer buf-code + (should-not which-func-mode) (should-not header-line-format)) + (with-current-buffer buf-not + (should-not which-func-mode) (should-not header-line-format)) + (which-function-mode 1) + (with-current-buffer buf-code + (should which-func-mode) (should header-line-format)) + (with-current-buffer buf-not + (should-not which-func-mode) (should-not header-line-format)) + (which-function-mode -1) + ;; which-func-mode stays set even when which-function-mode is off. + (with-current-buffer buf-code + (should which-func-mode) (should-not header-line-format)) + (with-current-buffer buf-not + (should-not which-func-mode) (should-not header-line-format)) + (kill-buffer buf-code) + (kill-buffer buf-not) + (which-function-mode 1) + (setq buf-code (find-file-noselect "which-func-tests.el")) + (setq buf-not (get-buffer-create "fundamental")) + (with-current-buffer buf-code + (should which-func-mode) (should header-line-format)) + (with-current-buffer buf-not + (should-not which-func-mode) (should-not header-line-format)))) + +(provide 'which-func-tests) +;;; which-func-tests.el ends here From 5c8fc0b0594b1e3af43d86c0bc96e10d03bc75a2 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Sat, 21 Oct 2023 11:09:39 -0400 Subject: [PATCH 07/12] Add 'case-symbols-as-words' to configure symbol case behavior In some programming languages and styles, a symbol (or every symbol in a sequence of symbols) might be capitalized, but the individual words making up the symbol should never be capitalized. For example, in OCaml, type names Look_like_this and variable names look_like_this, but it is basically never correct for something to Look_Like_This. And one might have "aa_bb cc_dd ee_ff" or "Aa_bb Cc_dd Ee_ff", but never "Aa_Bb Cc_Dd Ee_Ff". To support this, the new variable 'case-symbols-as-words' causes symbol constituents to be treated as part of words only for case operations. * src/casefiddle.c (case_ch_is_word): New function. (case_character_impl, case_character): Use 'case_ch_is_word'. (syms_of_casefiddle): Define 'case-symbols-as-words'. * src/search.c (Freplace_match): Use 'case-symbols-as-words' when calculating case pattern. * test/src/casefiddle-tests.el (casefiddle-tests--check-syms) (casefiddle-case-symbols-as-words): Test 'case-symbols-as-words'. * etc/NEWS: Announce 'case-symbols-as-words'. * doc/lispref/strings.texi (Case Conversion): Document 'case-symbols-as-words'. (Bug#66614) --- doc/lispref/strings.texi | 8 ++++++-- etc/NEWS | 8 ++++++++ src/casefiddle.c | 25 +++++++++++++++++++++++-- src/search.c | 11 +++++++---- test/src/casefiddle-tests.el | 12 ++++++++++++ 5 files changed, 56 insertions(+), 8 deletions(-) diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 7d11db49def..665d4f9a8dc 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -1510,7 +1510,9 @@ case. The definition of a word is any sequence of consecutive characters that are assigned to the word constituent syntax class in the current syntax -table (@pxref{Syntax Class Table}). +table (@pxref{Syntax Class Table}), or if @code{case-symbols-as-words} +is non-nil, also characters assigned to the symbol constituent syntax +class. When @var{string-or-char} is a character, this function does the same thing as @code{upcase}. @@ -1542,7 +1544,9 @@ had its initial letter converted to upper case. The definition of a word is any sequence of consecutive characters that are assigned to the word constituent syntax class in the current syntax -table (@pxref{Syntax Class Table}). +table (@pxref{Syntax Class Table}), or if @code{case-symbols-as-words} +is non-nil, also characters assigned to the symbol constituent syntax +class. When the argument to @code{upcase-initials} is a character, @code{upcase-initials} has the same result as @code{upcase}. diff --git a/etc/NEWS b/etc/NEWS index ed9f1a2124c..269346b5917 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1193,6 +1193,14 @@ instead of "ctags", "ebrowse", "etags", "hexl", "emacsclient", and "rcs2log", when starting one of these built in programs in a subprocess. ++++ +** New variable 'case-symbols-as-words' affects case operations for symbols. +If non-nil, then case operations such as 'upcase-initials' or +'replace-match' (with nil FIXEDCASE) will treat the entire symbol name +as a single word. This is useful for programming languages and styles +where only the first letter of a symbol's name is ever capitalized. +It defaults to nil. + +++ ** 'x-popup-menu' now understands touch screen events. When a 'touchscreen-begin' or 'touchscreen-end' event is passed as the diff --git a/src/casefiddle.c b/src/casefiddle.c index d567a5e353a..3afb131c50e 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -92,6 +92,12 @@ prepare_casing_context (struct casing_context *ctx, SETUP_BUFFER_SYNTAX_TABLE (); /* For syntax_prefix_flag_p. */ } +static bool +case_ch_is_word (enum syntaxcode syntax) +{ + return syntax == Sword || (case_symbols_as_words && syntax == Ssymbol); +} + struct casing_str_buf { unsigned char data[max (6, MAX_MULTIBYTE_LENGTH)]; @@ -115,7 +121,7 @@ case_character_impl (struct casing_str_buf *buf, /* Update inword state */ bool was_inword = ctx->inword; - ctx->inword = SYNTAX (ch) == Sword && + ctx->inword = case_ch_is_word (SYNTAX (ch)) && (!ctx->inbuffer || was_inword || !syntax_prefix_flag_p (ch)); /* Normalize flag so its one of CASE_UP, CASE_DOWN or CASE_CAPITALIZE. */ @@ -222,7 +228,7 @@ case_character (struct casing_str_buf *buf, struct casing_context *ctx, has a word syntax (i.e. current character is end of word), use final sigma. */ if (was_inword && ch == GREEK_CAPITAL_LETTER_SIGMA && changed - && (!next || SYNTAX (STRING_CHAR (next)) != Sword)) + && (!next || !case_ch_is_word (SYNTAX (STRING_CHAR (next))))) { buf->len_bytes = CHAR_STRING (GREEK_SMALL_LETTER_FINAL_SIGMA, buf->data); buf->len_chars = 1; @@ -720,6 +726,21 @@ Called with one argument METHOD which can be: 3rd argument. */); Vregion_extract_function = Qnil; /* simple.el sets this. */ + DEFVAR_BOOL ("case-symbols-as-words", case_symbols_as_words, + doc: /* If non-nil, case functions treat symbol syntax as part of words. + +Functions such as `upcase-initials' and `replace-match' check or modify +the case pattern of sequences of characters. Normally, these operate on +sequences of characters whose syntax is word constituent. If this +variable is non-nil, then they operate on sequences of characters whose +syntax is either word constituent or symbol constituent. + +This is useful for programming languages and styles where only the first +letter of a symbol's name is ever capitalized.*/); + case_symbols_as_words = 0; + DEFSYM (Qcase_symbols_as_words, "case-symbols-as-words"); + Fmake_variable_buffer_local (Qcase_symbols_as_words); + defsubr (&Supcase); defsubr (&Sdowncase); defsubr (&Scapitalize); diff --git a/src/search.c b/src/search.c index e9b29bb7179..692d8488049 100644 --- a/src/search.c +++ b/src/search.c @@ -2365,7 +2365,7 @@ text has only capital letters and has at least one multiletter word, convert NEWTEXT to all caps. Otherwise if all words are capitalized in the replaced text, capitalize each word in NEWTEXT. Note that what exactly is a word is determined by the syntax tables in effect -in the current buffer. +in the current buffer, and the variable `case-symbols-as-words'. If optional third arg LITERAL is non-nil, insert NEWTEXT literally. Otherwise treat `\\' as special: @@ -2479,7 +2479,8 @@ since only regular expressions have distinguished subexpressions. */) /* Cannot be all caps if any original char is lower case */ some_lowercase = 1; - if (SYNTAX (prevc) != Sword) + if (SYNTAX (prevc) != Sword + && !(case_symbols_as_words && SYNTAX (prevc) == Ssymbol)) some_nonuppercase_initial = 1; else some_multiletter_word = 1; @@ -2487,7 +2488,8 @@ since only regular expressions have distinguished subexpressions. */) else if (uppercasep (c)) { some_uppercase = 1; - if (SYNTAX (prevc) != Sword) + if (SYNTAX (prevc) != Sword + && !(case_symbols_as_words && SYNTAX (prevc) == Ssymbol)) ; else some_multiletter_word = 1; @@ -2496,7 +2498,8 @@ since only regular expressions have distinguished subexpressions. */) { /* If the initial is a caseless word constituent, treat that like a lowercase initial. */ - if (SYNTAX (prevc) != Sword) + if (SYNTAX (prevc) != Sword + && !(case_symbols_as_words && SYNTAX (prevc) == Ssymbol)) some_nonuppercase_initial = 1; } diff --git a/test/src/casefiddle-tests.el b/test/src/casefiddle-tests.el index e7f4348b0c6..12984d898b9 100644 --- a/test/src/casefiddle-tests.el +++ b/test/src/casefiddle-tests.el @@ -294,4 +294,16 @@ ;;(should (string-equal (capitalize "indIá") "İndıa")) )) +(defun casefiddle-tests--check-syms (init with-words with-symbols) + (let ((case-symbols-as-words nil)) + (should (string-equal (upcase-initials init) with-words))) + (let ((case-symbols-as-words t)) + (should (string-equal (upcase-initials init) with-symbols)))) + +(ert-deftest casefiddle-case-symbols-as-words () + (casefiddle-tests--check-syms "Aa_bb Cc_dd" "Aa_Bb Cc_Dd" "Aa_bb Cc_dd") + (casefiddle-tests--check-syms "Aa_bb cc_DD" "Aa_Bb Cc_DD" "Aa_bb Cc_DD") + (casefiddle-tests--check-syms "aa_bb cc_dd" "Aa_Bb Cc_Dd" "Aa_bb Cc_dd") + (casefiddle-tests--check-syms "Aa_Bb Cc_Dd" "Aa_Bb Cc_Dd" "Aa_Bb Cc_Dd")) + ;;; casefiddle-tests.el ends here From f80889b7247d42adb09f345bb6aa24010a6af33b Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 29 Oct 2023 13:40:27 +0200 Subject: [PATCH 08/12] ; Fix last change (bug#66614). --- doc/lispref/strings.texi | 15 +++++++-------- etc/NEWS | 2 +- 2 files changed, 8 insertions(+), 9 deletions(-) diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 665d4f9a8dc..d05b0b36475 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -1508,11 +1508,12 @@ has been capitalized. This means that the first character of each word is converted to upper case, and the rest are converted to lower case. +@vindex case-symbols-as-words The definition of a word is any sequence of consecutive characters that are assigned to the word constituent syntax class in the current syntax -table (@pxref{Syntax Class Table}), or if @code{case-symbols-as-words} -is non-nil, also characters assigned to the symbol constituent syntax -class. +table (@pxref{Syntax Class Table}); if @code{case-symbols-as-words} +is non-nil, characters assigned to the symbol constituent syntax +class are also considered as word constituent. When @var{string-or-char} is a character, this function does the same thing as @code{upcase}. @@ -1542,11 +1543,9 @@ letters other than the initials. It returns a new string whose contents are a copy of @var{string-or-char}, in which each word has had its initial letter converted to upper case. -The definition of a word is any sequence of consecutive characters that -are assigned to the word constituent syntax class in the current syntax -table (@pxref{Syntax Class Table}), or if @code{case-symbols-as-words} -is non-nil, also characters assigned to the symbol constituent syntax -class. +The definition of a word for this function is the same as described +for @code{capitalize} above, and @code{case-symbols-as-words} has the +same effect on word constituent characters. When the argument to @code{upcase-initials} is a character, @code{upcase-initials} has the same result as @code{upcase}. diff --git a/etc/NEWS b/etc/NEWS index 269346b5917..8ae7b89e830 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1199,7 +1199,7 @@ If non-nil, then case operations such as 'upcase-initials' or 'replace-match' (with nil FIXEDCASE) will treat the entire symbol name as a single word. This is useful for programming languages and styles where only the first letter of a symbol's name is ever capitalized. -It defaults to nil. +The default value of this variable is nil. +++ ** 'x-popup-menu' now understands touch screen events. From f3a27180b7b22e8220f9d92d91ece835545da4aa Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 29 Oct 2023 14:06:29 +0200 Subject: [PATCH 09/12] ; Fix a recent change in documentation of 'selection-coding-system' * doc/lispref/frames.texi (Window System Selections): Fix description of the effect of 'selection-coding-system' on MS-Windows and MS-DOS. --- doc/lispref/frames.texi | 33 +++++++++++++++++++++------------ 1 file changed, 21 insertions(+), 12 deletions(-) diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index fc36346f773..6193a4fe1cd 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4058,20 +4058,29 @@ under X, and @xref{Other Selections} for those elsewhere. @defopt selection-coding-system This variable provides a coding system (@pxref{Coding Systems}) which -is used to encode selection data, and takes effect on MS-DOS, -MS-Windows and X@. +is used to encode selection data, and takes effect on MS-Windows and +X@. It is also used in the MS-DOS port when it runs on MS-Windows and +can access the Windows clipboard text. -Under MS-DOS and MS-Windows, it is the coding system by which all -non-ASCII clipboard text will be encoded and decoded; if set under X, -it provides the coding system calls to @code{gui-get-selection} will -decode selection data for a subset of text data types by, and also -forces replies to selection requests for the polymorphic @code{TEXT} -data type to be encoded by the @code{compound-text-with-extensions} -coding system rather than Unicode. +On X, the value of this variable provides the coding system which +@code{gui-get-selection} will use to decode selection data for a +subset of text data types, and also forces replies to selection +requests for the polymorphic @code{TEXT} data type to be encoded by +the @code{compound-text-with-extensions} coding system rather than +Unicode. -Its default value is the system code page under MS-Windows 95, 98 or -Me, @code{utf-16le-dos} under NT/W2K/XP, @code{iso-latin-1-dos} on -MS-DOS, and @code{nil} elsewhere. +On MS-Windows, this variable is generally ignored, as the MS-Windows +clipboard provides the information about decoding as part of the +clipboard data, and uses either UTF-16 or locale-specific encoding +automatically as appropriate. We recommend to set the value of this +variable only on the older Windows 9X, as it is otherwise used only in +the very rare cases when the information provided by the clipboard +data is unusable for some reason. + +The default value of this variable is the system code page under +MS-Windows 95, 98 or Me, @code{utf-16le-dos} on Windows +NT/W2K/XP/Vista/7/8/10/11, @code{iso-latin-1-dos} on MS-DOS, and +@code{nil} elsewhere. @end defopt For backward compatibility, there are obsolete aliases From 683efb8de5ac3a2ba5ecc073d8c912ec6a61191d Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Thu, 21 Sep 2023 21:35:50 -0400 Subject: [PATCH 10/12] Add 'server-eval-args-left' to server.el Passing arbitrary arguments to functions through "emacsclient --eval" sometimes requires complicated escaping to avoid them being parsed as Lisp (as seen in emacsclient-mail.desktop before this change). The new variable 'server-eval-args-left' allows access to the arguments before they are parsed as Lisp. By removing arguments from the variable before they're parsed, a snippet of Lisp can consume arguments, as in emacsclient-mail.desktop. org-protocol might be able to use this as well, which might allow it to drop its current advice on server-visit-files. * etc/emacsclient-mail.desktop: Use 'server-eval-args-left'. * lisp/server.el (server-eval-args-left): New variable. (server-process-filter, server-execute): Make '-eval' arguments available through 'server-eval-args-left'. * lisp/startup.el (argv): Mention 'server-eval-args-left' in docstring. * etc/NEWS: Announce 'server-eval-args-left'. * doc/emacs/misc.texi (emacsclient Options): Document 'server-eval-args-left'. (Bug#65902) --- doc/emacs/misc.texi | 9 +++++++++ etc/NEWS | 10 ++++++++++ etc/emacsclient-mail.desktop | 7 ++----- lisp/server.el | 27 ++++++++++++++++++++------- lisp/startup.el | 5 ++++- 5 files changed, 45 insertions(+), 13 deletions(-) diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index d7168fa1ca0..9c7c5dcd5da 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -2078,6 +2078,15 @@ files. When this option is given, the arguments to @command{emacsclient} are interpreted as a list of expressions to evaluate, @emph{not} as a list of files to visit. +@vindex server-eval-args-left +If you have arbitrary data which you want to provide as input to one +of your expressions, you can pass the data as another argument to +@command{emacsclient} and use @var{server-eval-args-left} in the +expression to access the data. Be careful to have your expression +remove the data from @var{server-eval-args-left} regardless of whether +your code succeeds, such as by using @code{pop}, otherwise Emacs will +attempt to evaluate the data as a Lisp expression. + @item -f @var{server-file} @itemx --server-file=@var{server-file} Specify a server file (@pxref{TCP Emacs server}) for connecting to an diff --git a/etc/NEWS b/etc/NEWS index 8ae7b89e830..84a03495798 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -233,6 +233,16 @@ to enter the file you want to modify. It can be used to customize the look of the appointment notification displayed on the mode line when 'appt-display-mode-line' is non-nil. +** Emacs Server and Client + +--- +*** 'server-eval-args-left' can be used to pop subsequent eval args +When '--eval' is passed to emacsclient and Emacs is evaluating each +argument, this variable is set to those which have not yet been +evaluated. It can be used to 'pop' arguments to prevent them from +being evaluated, which is useful when those arguments contain +arbitrary data. + * Editing Changes in Emacs 30.1 diff --git a/etc/emacsclient-mail.desktop b/etc/emacsclient-mail.desktop index 0a2420ddead..4f7f00ebefd 100644 --- a/etc/emacsclient-mail.desktop +++ b/etc/emacsclient-mail.desktop @@ -1,10 +1,7 @@ [Desktop Entry] Categories=Network;Email; Comment=GNU Emacs is an extensible, customizable text editor - and more -# We want to pass the following commands to the shell wrapper: -# u=$(echo "$1" | sed 's/[\"]/\\&/g'); exec emacsclient --alternate-editor= --display="$DISPLAY" --eval "(message-mailto \"$u\")" -# Special chars '"', '$', and '\' must be escaped as '\\"', '\\$', and '\\\\'. -Exec=sh -c "u=\\$(echo \\"\\$1\\" | sed 's/[\\\\\\"]/\\\\\\\\&/g'); exec emacsclient --alternate-editor= --display=\\"\\$DISPLAY\\" --eval \\"(message-mailto \\\\\\"\\$u\\\\\\")\\"" sh %u +Exec=emacsclient --alternate-editor= --eval "(message-mailto (pop server-eval-args-left))" %u Icon=emacs Name=Emacs (Mail, Client) MimeType=x-scheme-handler/mailto; @@ -16,7 +13,7 @@ Actions=new-window;new-instance; [Desktop Action new-window] Name=New Window -Exec=sh -c "u=\\$(echo \\"\\$1\\" | sed 's/[\\\\\\"]/\\\\\\\\&/g'); exec emacsclient --alternate-editor= --create-frame --eval \\"(message-mailto \\\\\\"\\$u\\\\\\")\\"" sh %u +Exec=emacsclient --alternate-editor= --create-frame --eval "(message-mailto (pop server-eval-args-left))" %u [Desktop Action new-instance] Name=New Instance diff --git a/lisp/server.el b/lisp/server.el index ce68e9aebc9..a2671165bfc 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -1199,6 +1199,7 @@ The following commands are accepted by the client: parent-id ; Window ID for XEmbed dontkill ; t if client should not be killed. commands + evalexprs dir use-current-frame frame-parameters ;parameters for newly created frame @@ -1332,8 +1333,7 @@ The following commands are accepted by the client: (let ((expr (pop args-left))) (if coding-system (setq expr (decode-coding-string expr coding-system))) - (push (lambda () (server-eval-and-print expr proc)) - commands) + (push expr evalexprs) (setq filepos nil))) ;; -env NAME=VALUE: An environment variable. @@ -1358,7 +1358,7 @@ The following commands are accepted by the client: ;; arguments, use an existing frame. (and nowait (not (eq tty-name 'window-system)) - (or files commands) + (or files commands evalexprs) (setq use-current-frame t)) (setq frame @@ -1407,7 +1407,7 @@ The following commands are accepted by the client: (let ((default-directory (if (and dir (file-directory-p dir)) dir default-directory))) - (server-execute proc files nowait commands + (server-execute proc files nowait commands evalexprs dontkill frame tty-name))))) (when (or frame files) @@ -1417,22 +1417,35 @@ The following commands are accepted by the client: ;; condition-case (t (server-return-error proc err)))) -(defun server-execute (proc files nowait commands dontkill frame tty-name) +(defvar server-eval-args-left nil + "List of eval args not yet processed. + +Adding or removing strings from this variable while the Emacs +server is processing a series of eval requests will affect what +Emacs evaluates. + +See also `argv' for a similar variable which works for +invocations of \"emacs\".") + +(defun server-execute (proc files nowait commands evalexprs dontkill frame tty-name) ;; This is run from timers and process-filters, i.e. "asynchronously". ;; But w.r.t the user, this is not really asynchronous since the timer ;; is run after 0s and the process-filter is run in response to the ;; user running `emacsclient'. So it is OK to override the - ;; inhibit-quit flag, which is good since `commands' (as well as + ;; inhibit-quit flag, which is good since `evalexprs' (as well as ;; find-file-noselect via the major-mode) can run arbitrary code, ;; including code that needs to wait. (with-local-quit (condition-case err (let ((buffers (server-visit-files files proc nowait))) (mapc 'funcall (nreverse commands)) + (let ((server-eval-args-left (nreverse evalexprs))) + (while server-eval-args-left + (server-eval-and-print (pop server-eval-args-left) proc))) ;; If we were told only to open a new client, obey ;; `initial-buffer-choice' if it specifies a file ;; or a function. - (unless (or files commands) + (unless (or files commands evalexprs) (let ((buf (cond ((stringp initial-buffer-choice) (find-file-noselect initial-buffer-choice)) diff --git a/lisp/startup.el b/lisp/startup.el index 6329e3ea8d0..37843eab176 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -120,7 +120,10 @@ the remaining command-line args are in the variable `command-line-args-left'.") "List of command-line args not yet processed. This is a convenience alias, so that one can write (pop argv) inside of --eval command line arguments in order to access -following arguments.")) +following arguments. + +See also `server-eval-args-left' for a similar variable which +works for invocations of \"emacsclient --eval\".")) (internal-make-var-non-special 'argv) (defvar command-line-args-left nil From cb86120272042df9420a726b3a754d58f300f350 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 29 Oct 2023 14:19:39 +0200 Subject: [PATCH 11/12] ; Fix documentation of last change * etc/NEWS: * doc/emacs/misc.texi (emacsclient Options): Fix wording. (Bug#65902) --- doc/emacs/misc.texi | 17 ++++++++++------- etc/NEWS | 11 ++++++----- 2 files changed, 16 insertions(+), 12 deletions(-) diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 9c7c5dcd5da..d3c5712099d 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -2079,13 +2079,16 @@ files. When this option is given, the arguments to evaluate, @emph{not} as a list of files to visit. @vindex server-eval-args-left -If you have arbitrary data which you want to provide as input to one -of your expressions, you can pass the data as another argument to -@command{emacsclient} and use @var{server-eval-args-left} in the -expression to access the data. Be careful to have your expression -remove the data from @var{server-eval-args-left} regardless of whether -your code succeeds, such as by using @code{pop}, otherwise Emacs will -attempt to evaluate the data as a Lisp expression. +Passing complex Lisp expression via the @option{--eval} command-line +option sometimes requires elaborate escaping of characters special to +the shell. To avoid this, you can pass arguments to Lisp functions in +your expression as additional separate arguments to +@command{emacsclient}, and use @var{server-eval-args-left} in the +expression to access those arguments. Be careful to have your +expression remove the processed arguments from +@var{server-eval-args-left} regardless of whether your code succeeds, +for example by using @code{pop}, otherwise Emacs will attempt to +evaluate those arguments as separate Lisp expressions. @item -f @var{server-file} @itemx --server-file=@var{server-file} diff --git a/etc/NEWS b/etc/NEWS index 84a03495798..9c0f28e3fa9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -236,12 +236,13 @@ displayed on the mode line when 'appt-display-mode-line' is non-nil. ** Emacs Server and Client --- -*** 'server-eval-args-left' can be used to pop subsequent eval args +*** 'server-eval-args-left' can be used to pop and eval subsequent args. When '--eval' is passed to emacsclient and Emacs is evaluating each -argument, this variable is set to those which have not yet been -evaluated. It can be used to 'pop' arguments to prevent them from -being evaluated, which is useful when those arguments contain -arbitrary data. +argument, this variable is set to those arguments not yet evaluated. +It can be used to 'pop' arguments and process them by the function +called in the '--eval' expression, which is useful when those +arguments contain arbitrary characters that otherwise might require +elaborate and error-prone escaping (to protect them from the shell). * Editing Changes in Emacs 30.1 From 3bc092270027660a4edbbb8c5a4e5a37f114076c Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 29 Oct 2023 14:06:32 +0100 Subject: [PATCH 12/12] Make nnrss suggest HTTPS instead of HTTP * lisp/gnus/nnrss.el (nnrss-check-group): Suggest HTTPS instead of HTTP when prompting for URL. --- lisp/gnus/nnrss.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index c5f2cb672d7..06a0bc7e799 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -629,7 +629,7 @@ which RSS 2.0 allows." (assoc 'href (nnrss-discover-feed (read-string - (format "URL to search for %s: " group) "http://"))))) + (format "URL to search for %s: " group) "https://"))))) (let ((pair (assoc-string group nnrss-server-data))) (if pair (setcdr (cdr pair) (list url))