[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 4a579e04712 4/5: Merge branch 'master' of git.sv.gnu.org:/srv/git
|
From: |
Michael Albinus |
|
Subject: |
master 4a579e04712 4/5: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs |
|
Date: |
Sun, 29 Oct 2023 10:29:50 -0400 (EDT) |
branch: master
commit 4a579e047124fe1dbf24ee712f4debb47e357b8b
Merge: 3d25a9fccfa 3bc09227002
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>
Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs
---
doc/emacs/misc.texi | 12 +++++
doc/lispref/frames.texi | 37 ++++++++-----
doc/lispref/strings.texi | 11 ++--
etc/NEWS | 19 +++++++
etc/emacsclient-mail.desktop | 7 +--
java/org/gnu/emacs/EmacsNative.java | 3 ++
java/org/gnu/emacs/EmacsSdk11Clipboard.java | 24 +++++++++
lisp/eshell/em-smart.el | 81 +++++++++++------------------
lisp/gnus/nnrss.el | 2 +-
lisp/language/hanja-util.el | 18 +++----
lisp/net/rcirc.el | 11 ++--
lisp/progmodes/which-func.el | 39 ++++++++------
lisp/server.el | 27 +++++++---
lisp/startup.el | 5 +-
src/android.c | 8 +++
src/casefiddle.c | 25 ++++++++-
src/search.c | 11 ++--
src/xdisp.c | 10 ++++
test/lisp/progmodes/which-func-tests.el | 58 +++++++++++++++++++++
test/src/casefiddle-tests.el | 12 +++++
20 files changed, 296 insertions(+), 124 deletions(-)
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index d7168fa1ca0..d3c5712099d 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -2078,6 +2078,18 @@ 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
+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}
Specify a server file (@pxref{TCP Emacs server}) for connecting to an
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@.
-
-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.
-
-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.
+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.
+
+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.
+
+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
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index 7d11db49def..d05b0b36475 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -1508,9 +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}).
+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}.
@@ -1540,9 +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}).
+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 ed9f1a2124c..9c0f28e3fa9 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -233,6 +233,17 @@ 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 and eval subsequent args.
+When '--eval' is passed to emacsclient and Emacs is evaluating each
+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
@@ -1193,6 +1204,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.
+The default value of this variable is nil.
+
+++
** 'x-popup-menu' now understands touch screen events.
When a 'touchscreen-begin' or 'touchscreen-end' event is passed as the
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/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/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)
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))
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
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
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/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
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)
{
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/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. */
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 <sbaugh@catern.com>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; 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
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