mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-27 07:30:59 -08:00
Code Issues Projects Releases Wiki Activity

Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs

Browse source
This commit is contained in:
Michael Albinus 2023-10-29 15:28:11 +01:00
commit 4a579e0471
20 changed files with 294 additions and 122 deletions
Download patch file Download diff file Expand all files Collapse all files

12
doc/emacs/misc.texi
View file

@ -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

33
doc/lispref/frames.texi
View file

@ -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

11
doc/lispref/strings.texi
View file

@ -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}.

19
etc/NEWS
View file

@ -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

7
etc/emacsclient-mail.desktop
View file

@ -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

3
java/org/gnu/emacs/EmacsNative.java
View file

@ -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 ();

24
java/org/gnu/emacs/EmacsSdk11Clipboard.java
View file

@ -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;
}

81
lisp/eshell/em-smart.el
View file

@ -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)

2
lisp/gnus/nnrss.el
View file

@ -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))

18
lisp/language/hanja-util.el
View file

@ -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

11
lisp/net/rcirc.el
View file

@ -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

39
lisp/progmodes/which-func.el
View file

@ -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.")

27
lisp/server.el
View file

@ -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))

5
lisp/startup.el
View file

@ -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

8
src/android.c
View file

@ -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)
{

25
src/casefiddle.c
View file

@ -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);

11
src/search.c
View file

@ -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;
}

10
src/xdisp.c
View file

@ -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. */

58
test/lisp/progmodes/which-func-tests.el Normal file
View file

@ -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

12
test/src/casefiddle-tests.el
View file

@ -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