procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge from origin/emacs-29

Browse source 
6f6071c526 Avoid duplicate load-path entry when generating package a...
117b29c6f6 ; Improve documentation of Isearch command properties
a347b26cba Disable loading SQLite3 extensions when SQLite3 version i...
fe22bf503f ; * lisp/progmodes/project.el (project-switch-use-entire-...
64dbbde3b7 Fix visiting HTML files encoded in iso-2022 variants
5c95239aca ; Fix markup of some treesit vars in Elisp manual.
6ad041939b Support 'isearch-allow-scroll' in 'pixel-scroll-precision...
ecccdc07a0 shr: allow moving between adjacent anchors
504ef25ef3 ; * etc/NEWS: Fix typos.
d6fb868cdd Fix multihop file name expansion in Tramp
dd3e4e14fd Remove obsolete information from Gnus manual
2a5c946f87 Preserve mark in comint-history-isearch
6b60c8142e Fix systemd unit completion for old versions of systemd
8c56557cd9 Fix Skeletons menu-bar menu in Python modes
58eb38cfb4 ; * etc/NEWS: missing definite article
cf40362869 ; * etc/NEWS: PGTK cannot switch to -new automatically (b...
ead3a2abbf Fix loading SQLite extensions
a6bddd1765 ; * etc/NEWS: Fix typos.
f49fe936ab * etc/NEWS: Note dotimes loop variable scoping change (bu...
cec9333dc5 Fix c-ts-mode--top-level-declarator
f571e8f1bb Improve c-ts-mode font-lock for function names (bug#63390)
42a28ffdc2 * lisp/tab-bar.el: Don't use 'minibuffer-selected-window'...
8e61d23f71 Split windows horizontally in places that use split to cr...
459d08c7fe Fix tree-sitter test (bug#63481)
3bc5efb87e ; * lisp/emacs-lisp/benchmark.el (benchmark-progn): Fix d...

# Conflicts:
#	etc/NEWS
This commit is contained in:
Eli Zaretskii 2023-05-26 07:03:07 -04:00
commit eacee3e536
22 changed files with 206 additions and 109 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
doc/emacs/display.texi
View file

@ -127,7 +127,10 @@ command leaves point in the window. This variable affects all the
scroll commands documented in this section, as well as scrolling with
the mouse wheel (@pxref{Mouse Commands}); in general, it affects any
command that has a non-@code{nil} @code{scroll-command} property.
@xref{Property Lists,,, elisp, The Emacs Lisp Reference Manual}.
@xref{Property Lists,,, elisp, The Emacs Lisp Reference Manual}. The
same property also causes Emacs not to exit incremental search when
one of these commands is invoked and @code{isearch-allow-scroll} is
non-@code{nil} (@pxref{Not Exiting Isearch}).
@vindex fast-but-imprecise-scrolling
Sometimes, particularly when you hold down keys such as @kbd{C-v}

35
doc/emacs/search.texi
View file

@ -587,26 +587,30 @@ i.e., they don't terminate the search, even if
@item Scrolling Commands
@cindex scrolling commands, during incremental search
@vindex isearch-allow-scroll
Normally, scrolling commands exit incremental search. If you change
the variable @code{isearch-allow-scroll} to a non-@code{nil} value,
that enables the use of the scroll-bar, as well as keyboard scrolling
commands like @kbd{C-v}, @kbd{M-v}, and @kbd{C-l} (@pxref{Scrolling}).
This applies only to calling these commands via their bound key
sequences---typing @kbd{M-x} will still exit the search. You can give
prefix arguments to these commands in the usual way. This feature
normally won't let you scroll the current match out of visibility; but
if you customize @code{isearch-allow-scroll} to the special value
@code{unlimited}, that restriction is lifted.
@cindex @code{scroll-command} property, and incremental search
Normally, scrolling commands exit incremental search. But if you
change the variable @code{isearch-allow-scroll} to a non-@code{nil}
value, that enables the use of the scroll-bar, as well as keyboard
scrolling commands like @kbd{C-v}, @kbd{M-v}, and @kbd{C-l}
(@pxref{Scrolling}), which have a non-@code{nil} @code{scroll-command}
property, without exiting the search. This applies only to calling
these commands via their bound key sequences---typing @kbd{M-x} will
still exit the search. You can give prefix arguments to these
commands in the usual way. This feature normally won't let you scroll
the current match out of visibility; but if you customize
@code{isearch-allow-scroll} to the special value @code{unlimited},
that restriction is lifted.
@cindex @code{isearch-scroll} property
@cindex prevent commands from exiting incremental search
The @code{isearch-allow-scroll} feature also affects some other
commands, such as @kbd{C-x 2} (@code{split-window-below}) and
@kbd{C-x ^} (@code{enlarge-window}), which don't exactly scroll but do
affect where the text appears on the screen. It applies to any
command whose name has a non-@code{nil} @code{isearch-scroll}
property. So you can control which commands are affected by changing
these properties.
affect where the text appears on the screen. In fact, it affects
any command that has a non-@code{nil} @code{isearch-scroll} property.
So you can control which commands are affected by changing these
properties.
@cindex prevent commands from exiting incremental search
For example, to make @kbd{C-h l} usable within an incremental search
in all future Emacs sessions, use @kbd{C-h c} to find what command it
runs (@pxref{Key Help}), which is @code{view-lossage}. Then you can
@ -643,6 +647,7 @@ you can extend the search string by holding down the shift key while
typing cursor motion commands. It will yank text that ends at the new
position after moving point in the current buffer.
@cindex @code{isearch-move} property
When @code{isearch-yank-on-move} is @code{t}, you can extend the
search string without using the shift key for cursor motion commands,
but it applies only for certain motion command that have the

10
doc/lispref/modes.texi
View file

@ -4074,8 +4074,8 @@ replacing syntactic font lock, then the regexp-based font lock.
Although parser-based font lock doesn't share the same customization
variables with regexp-based font lock, it uses similar customization
schemes. The tree-sitter counterpart of @var{font-lock-keywords} is
@var{treesit-font-lock-settings}.
schemes. The tree-sitter counterpart of @code{font-lock-keywords} is
@code{treesit-font-lock-settings}.
@cindex tree-sitter fontifications, overview
@cindex fontifications with tree-sitter, overview
@ -4109,9 +4109,9 @@ To setup tree-sitter fontification, a major mode should first set
@code{treesit-major-mode-setup}.
@defun treesit-font-lock-rules &rest query-specs
This function is used to set @var{treesit-font-lock-settings}. It
This function is used to set @code{treesit-font-lock-settings}. It
takes care of compiling queries and other post-processing, and outputs
a value that @var{treesit-font-lock-settings} accepts. Here's an
a value that @code{treesit-font-lock-settings} accepts. Here's an
example:
@example
@ -4982,7 +4982,7 @@ below: then the major mode needs only to write some indentation rules
and the engine takes care of the rest.
To enable the parser-based indentation engine, either set
@var{treesit-simple-indent-rules} and call
@code{treesit-simple-indent-rules} and call
@code{treesit-major-mode-setup}, or equivalently, set the value of
@code{indent-line-function} to @code{treesit-indent}.

6
doc/lispref/parsing.texi
View file

@ -1692,9 +1692,9 @@ directly translate into operations shown above.
@end example
@defun treesit-range-rules &rest query-specs
This function is used to set @var{treesit-range-settings}. It
takes care of compiling queries and other post-processing, and outputs
a value that @var{treesit-range-settings} can have.
This function is used to set @code{treesit-range-settings}. It takes
care of compiling queries and other post-processing, and outputs a
value that @code{treesit-range-settings} can have.
It takes a series of @var{query-spec}s, where each @var{query-spec} is
a @var{query} preceded by zero or more @var{keyword}/@var{value}

25
doc/misc/gnus.texi
View file

@ -713,7 +713,6 @@ Choosing a Mail Back End
Browsing the Web
* Archiving Mail::
* Web Searches:: Creating groups from articles that match a string.
* RSS:: Reading RDF site summary.
@ -17247,7 +17246,6 @@ Gnus has been getting a bit of a collection of back ends for providing
interfaces to these sources.
@menu
* Archiving Mail::
* Web Searches:: Creating groups from articles that match a string.
* RSS:: Reading RDF site summary.
@end menu
@ -17264,29 +17262,6 @@ cases, it makes a lot of sense to let the Gnus Agent (@pxref{Gnus
Unplugged}) handle downloading articles, and then you can read them at
leisure from your local disk. No more World Wide Wait for you.
@node Archiving Mail
@subsection Archiving Mail
@cindex archiving mail
@cindex backup of mail
Some of the back ends, notably @code{nnml}, @code{nnfolder}, and
@code{nnmaildir}, now actually store the article marks with each group.
For these servers, archiving and restoring a group while preserving
marks is fairly simple.
(Preserving the group level and group parameters as well still
requires ritual dancing and sacrifices to the @file{.newsrc.eld} deity
though.)
To archive an entire @code{nnml}, @code{nnfolder}, or @code{nnmaildir}
server, take a recursive copy of the server directory. There is no need
to shut down Gnus, so archiving may be invoked by @code{cron} or
similar. You restore the data by restoring the directory tree, and
adding a server definition pointing to that directory in Gnus. The
@ref{Article Backlog}, @ref{Asynchronous Fetching} and other things
might interfere with overwriting data, so you may want to shut down Gnus
before you restore the data.
@node Web Searches
@subsection Web Searches
@cindex nnweb

34
etc/NEWS.29
View file

@ -139,6 +139,11 @@ known to have problems, such as undesirable frame positioning and
various issues with keyboard input of sequences such as 'C-;' and
'C-S-u'.
Note that, unlike the X build of Emacs, the PGTK build cannot
automatically switch to text-mode interface (thus emulating '-nw') if
it cannot determine the default display; it will instead complain and
ask you to invoke it with the explicit '-nw' option.
---
** Emacs no longer reduces the size of the Japanese dictionary.
Building Emacs includes generation of a Japanese dictionary, which is
@ -1844,10 +1849,10 @@ this includes "binary" buffers like 'archive-mode' and 'image-mode'.
+++
*** New command 'package-upgrade'.
This command allows you to upgrade packages without using 'M-x
list-packages'. A package that comes with the Emacs distribution can
only be upgraded after you install, once, a newer version from ELPA
via the package-menu displayed by 'list-packages'.
This command allows you to upgrade packages without using 'list-packages'.
A package that comes with the Emacs distribution can only be upgraded
after you install, once, a newer version from ELPA via the
package-menu displayed by 'list-packages'.
+++
*** New command 'package-upgrade-all'.
@ -1908,10 +1913,10 @@ enabled.
In addition, when this option is non-nil, built-in packages for which
a new version is available in archives can be upgraded via the package
menu produced by 'M-x list-packages'. If you do set this option
non-nil, we recommend not to use the 'U' command, but instead to use
'/ u' to show the packages which can be upgraded, and then decide
which ones of them you actually want to update from the archives.
menu produced by 'list-packages'. If you do set this option non-nil,
we recommend not to use the 'U' command, but instead to use '/ u' to
show the packages which can be upgraded, and then decide which ones of
them you actually want to update from the archives.
If you customize this option, we recommend you place its non-default
setting in your early-init file.
@ -3871,6 +3876,19 @@ The following generalized variables have been made obsolete:
'standard-case-table', 'syntax-table', 'visited-file-modtime',
'window-height', 'window-width', and 'x-get-secondary-selection'.
---
** The 'dotimes' loop variable can no longer be manipulated in the loop body.
Previously, the 'dotimes' loop counter could be modified inside the
loop body, but only in code using dynamic binding. Now the behavior
is the same as when using lexical binding: changes to the loop
variable have no effect on subsequent iterations. That is,
(dotimes (i 10)
(print i)
(setq i (+ i 6)))
now always prints the numbers 0 .. 9.
* Lisp Changes in Emacs 29.1

2
lisp/comint.el
View file

@ -1543,6 +1543,8 @@ Intended to be added to `isearch-mode-hook' in `comint-mode'."
(setq isearch-message-function nil)
(setq isearch-wrap-function nil)
(setq isearch-push-state-function nil)
;; Force isearch to not change mark.
(setq isearch-opoint (point))
(kill-local-variable 'isearch-lazy-count)
(remove-hook 'isearch-mode-end-hook 'comint-history-isearch-end t)
(unless isearch-suspended

2
lisp/emacs-lisp/benchmark.el
View file

@ -152,7 +152,7 @@ to call it without any argument."
(defmacro benchmark-progn (&rest body)
"Evaluate BODY and message the time taken.
The return value is the value of the final form in BODY."
(declare (debug body) (indent 0))
(declare (debug t) (indent 0))
(let ((value (make-symbol "value"))
(start (make-symbol "start"))
(gcs (make-symbol "gcs"))

8
lisp/emacs-lisp/package.el
View file

@ -1106,8 +1106,12 @@ untar into a directory named DIR; otherwise, signal an error."
;; Add the directory that will contain the autoload file to
;; the load path. We don't hard-code `pkg-dir', to avoid
;; issues if the package directory is moved around.
(or (and load-file-name (file-name-directory load-file-name))
(car load-path)))))
;; `loaddefs-generate' has code to do this for us, but it's
;; not currently exposed. (Bug#63625)
(or (and load-file-name
(directory-file-name
(file-name-directory load-file-name)))
(car load-path)))))
(let ((buf (find-buffer-visiting output-file)))
(when buf (kill-buffer buf)))
auto-name))

16
lisp/international/mule.el
View file

@ -2484,10 +2484,12 @@ This function is intended to be added to `auto-coding-functions'."
;; called as part of visiting a file, as opposed
;; to when saving a buffer to a file.
(if (and enable-multibyte-characters
;; 'charset' will signal an error in
;; coding-system-equal, since it isn't a
;; coding-system. So test that up front.
;; 'charset' and 'iso-2022' will signal
;; an error in coding-system-equal, since
;; they aren't coding-systems. So test
;; that up front.
(not (equal sym-type 'charset))
(not (equal sym-type 'iso-2022))
(coding-system-equal 'utf-8 sym-type)
(coding-system-equal 'utf-8 bfcs-type))
buffer-file-coding-system
@ -2540,11 +2542,13 @@ This function is intended to be added to `auto-coding-functions'."
(bfcs-type
(coding-system-type buffer-file-coding-system)))
(if (and enable-multibyte-characters
;; 'charset' will signal an error in
;; coding-system-equal, since it isn't a
;; coding-system. So test that up front.
;; 'charset' and 'iso-2022' will signal an error
;; in coding-system-equal, since they aren't
;; coding-systems. So test that up front.
(not (equal sym-type 'charset))
(not (equal bfcs-type 'charset))
(not (equal sym-type 'iso-2022))
(not (equal bfcs-type 'iso-2022))
(coding-system-equal 'utf-8 sym-type)
(coding-system-equal 'utf-8 bfcs-type))
buffer-file-coding-system

3
lisp/net/shr.el
View file

@ -1215,7 +1215,6 @@ START, and END. Note that START and END should be markers."
(add-text-properties
start (point)
(list 'shr-url url
'shr-tab-stop t
'button t
'category 'shr ; For button.el button buffers.
'help-echo (let ((parsed (url-generic-parse-url
@ -1240,6 +1239,8 @@ START, and END. Note that START and END should be markers."
;; Make separate regions not `eq' so that they'll get
;; separate mouse highlights.
'mouse-face (list 'highlight)))
(when (< start (point))
(add-text-properties start (1+ start) '(shr-tab-stop t)))
;; Don't overwrite any keymaps that are already in the buffer (i.e.,
;; image keymaps).
(while (and start

8
lisp/net/tramp.el
View file

@ -1670,8 +1670,9 @@ The structure consists of method, user, domain, host, port,
localname (file name on remote host), and hop.
Unless NODEFAULT is non-nil, method, user and host are expanded
to their default values. For the other file name parts, no
default values are used."
to their default values. Hop is set to nil if NODEFAULT is non-nil.
For the other file name parts, no default values are used."
(save-match-data
(unless (tramp-tramp-file-p name)
(tramp-user-error nil "Not a Tramp file name: \"%s\"" name))
@ -1697,7 +1698,8 @@ default values are used."
(when (string-match tramp-postfix-ipv6-regexp host)
(setq host (replace-match "" nil t host))))
(unless nodefault
(if nodefault
(setq hop nil)
(when hop
(setq v (tramp-dissect-hop-name hop)
hop (and hop (tramp-make-tramp-hop-name v))))

3
lisp/pcmpl-linux.el
View file

@ -119,7 +119,8 @@ Test is done using `equal'."
(with-temp-buffer
(apply #'call-process
"systemctl" nil '(t nil) nil
"list-units" "--full" "--legend=no" "--plain" args)
;; "--legend=no" doesn't exist before systemd v248
"list-units" "--full" "--no-legend" "--plain" args)
(goto-char (point-min))
(let (result)
(while (re-search-forward (rx bol (group (+ (not space)))

7
lisp/pixel-scroll.el
View file

@ -290,6 +290,10 @@ This is and alternative of `scroll-down'. Scope moves upward."
(scroll-down 1) ; relay on robust method
(pixel-scroll-pixel-down amt))))))
;; isearch-scroll support
(put 'pixel-scroll-up 'scroll-command t)
(put 'pixel-scroll-down 'scroll-command t)
(defun pixel-bob-at-top-p (amt)
"Return non-nil if window-start is at beginning of the current buffer.
Window must be vertically scrolled by not more than AMT pixels."
@ -728,6 +732,9 @@ wheel."
(message (error-message-string '(end-of-buffer))))))))))
(mwheel-scroll event nil))))
;; isearch-scroll support
(put 'pixel-scroll-precision 'scroll-command t)
(defun pixel-scroll-kinetic-state (&optional window)
"Return the kinetic scroll state of WINDOW.
If WINDOW is nil, return the state of the current window.

20
lisp/progmodes/c-ts-mode.el
View file

@ -627,6 +627,13 @@ MODE is either `c' or `cpp'."
(function_definition
declarator: (_) @c-ts-mode--fontify-declarator)
;; When a function definition has preproc directives in its body,
;; it can't correctly parse into a function_definition. We still
;; want to highlight the function_declarator correctly, hence
;; this rule. See bug#63390 for more detail.
((function_declarator) @c-ts-mode--fontify-declarator
(:pred c-ts-mode--top-level-declarator
@c-ts-mode--fontify-declarator))
(parameter_declaration
declarator: (_) @c-ts-mode--fontify-declarator)
@ -750,6 +757,19 @@ For NODE, OVERRIDE, START, END, and ARGS, see
(treesit-node-start identifier) (treesit-node-end identifier)
face override start end))))
(defun c-ts-mode--top-level-declarator (node)
"Return non-nil if NODE is a top-level function_declarator."
;; These criterion are observed in
;; xterm.c:x_draw_glyphless_glyph_string_foreground on emacs-29
;; branch, described in bug#63390. They might not cover all cases
;; where a function_declarator is at top-level, outside of a
;; function_definition. We might need to amend them as we discover
;; more cases.
(let* ((parent (treesit-node-parent node))
(grandparent (treesit-node-parent parent)))
(and (equal (treesit-node-type parent) "ERROR")
(null grandparent))))
(defun c-ts-mode--fontify-variable (node override start end &rest _)
"Fontify an identifier node if it is a variable.
Don't fontify if it is a function identifier. For NODE,

9
lisp/progmodes/project.el
View file

@ -1808,11 +1808,12 @@ invoked immediately without any dispatch menu."
(symbol :tag "Single command")))
(defcustom project-switch-use-entire-map nil
"Make `project-switch-project' use entire `project-prefix-map'.
"Whether `project-switch-project' will use the entire `project-prefix-map'.
If nil, `project-switch-project' will only recognize commands
listed in `project-switch-commands' and signal an error when
others are invoked. Otherwise, all keys in `project-prefix-map'
are legal even if they aren't listed in the dispatch menu."
listed in `project-switch-commands', and will signal an error
when other commands are invoked. If this is non-nil, all the
keys in `project-prefix-map' are valid even if they aren't
listed in the dispatch menu produced from `project-switch-commands'."
:type 'boolean
:group 'project
:version "28.1")

6
lisp/progmodes/python.el
View file

@ -6754,8 +6754,6 @@ implementations: `python-mode' and `python-ts-mode'."
(setq-local prettify-symbols-alist python-prettify-symbols-alist)
(python-skeleton-add-menu-items)
(make-local-variable 'python-shell-internal-buffer)
(add-hook 'flymake-diagnostic-functions #'python-flymake nil t))
@ -6779,6 +6777,8 @@ implementations: `python-mode' and `python-ts-mode'."
(add-hook 'which-func-functions #'python-info-current-defun nil t)
(python-skeleton-add-menu-items)
(when python-indent-guess-indent-offset
(python-indent-guess-indent-offset)))
@ -6805,6 +6805,8 @@ implementations: `python-mode' and `python-ts-mode'."
#'python--treesit-defun-name)
(treesit-major-mode-setup)
(python-skeleton-add-menu-items)
(when python-indent-guess-indent-offset
(python-indent-guess-indent-offset))

15
lisp/tab-bar.el
View file

@ -1333,8 +1333,8 @@ Negative TAB-NUMBER counts tabs from the end of the tab bar."
(ws
;; `window-state-put' fails when called in the minibuffer
(when (minibuffer-selected-window)
(select-window (minibuffer-selected-window)))
(when (window-minibuffer-p)
(select-window (get-mru-window)))
(window-state-put ws nil 'safe)))
;; Select the minibuffer when it was active before switching tabs
@ -1345,8 +1345,8 @@ Negative TAB-NUMBER counts tabs from the end of the tab bar."
;; another tab, then after going back to the first tab, it has
;; such inconsistent state that the current buffer is the minibuffer,
;; but its window is not active. So try to undo this mess.
(when (and (minibufferp) (not (active-minibuffer-window)))
(other-window 1))
(when (and (window-minibuffer-p) (not (active-minibuffer-window)))
(select-window (get-mru-window)))
(when tab-bar-history-mode
(setq tab-bar-history-omit t))
@ -1569,8 +1569,8 @@ After the tab is created, the hooks in
(when tab-bar-new-tab-choice
;; Handle the case when it's called in the active minibuffer.
(when (minibuffer-selected-window)
(select-window (minibuffer-selected-window)))
(when (window-minibuffer-p)
(select-window (get-mru-window)))
(let ((ignore-window-parameters t)
(window--sides-inhibit-check t))
(if (eq tab-bar-new-tab-choice 'clone)
@ -1587,7 +1587,8 @@ After the tab is created, the hooks in
(window-state-put (window-state-get)))
;; Create a new window to get rid of old window parameters
;; (e.g. prev/next buffers) of old window.
(split-window) (delete-window))))
(split-window nil window-safe-min-width t)
(delete-window))))
(let ((buffer
(if (and (functionp tab-bar-new-tab-choice)

2
lisp/window.el
View file

@ -6391,7 +6391,7 @@ windows can get as small as `window-safe-min-height' and
(selected-window)))
(delete-other-windows-internal window root)
;; Create a new window to replace the existing one.
(setq window (prog1 (split-window window)
(setq window (prog1 (split-window window window-safe-min-width t)
(delete-window window)))))
(set-window-dedicated-p window nil)

74
src/sqlite.c
View file

@ -23,6 +23,8 @@ YOSHIDA <syohex@gmail.com>, which can be found at:
https://github.com/syohex/emacs-sqlite3 */
#include <config.h>
#include <c-strcase.h>
#include "lisp.h"
#include "coding.h"
@ -30,6 +32,17 @@ YOSHIDA <syohex@gmail.com>, which can be found at:
#include <sqlite3.h>
/* Support for loading SQLite extensions requires the ability to
enable and disable loading of extensions (by default this is
disabled, and we want to keep it that way). The required macro is
available since SQLite 3.13. */
# if defined HAVE_SQLITE3_LOAD_EXTENSION && \
defined SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION
# define HAVE_LOAD_EXTENSION 1
# else
# define HAVE_LOAD_EXTENSION 0
# endif
#ifdef WINDOWSNT
# include <windows.h>
@ -75,11 +88,14 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_exec,
DEF_DLL_FN (SQLITE_API int, sqlite3_prepare_v2,
(sqlite3*, const char*, int, sqlite3_stmt**, const char**));
# ifdef HAVE_SQLITE3_LOAD_EXTENSION
# if HAVE_LOAD_EXTENSION
DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension,
(sqlite3*, const char*, const char*, char**));
# undef sqlite3_load_extension
# define sqlite3_load_extension fn_sqlite3_load_extension
DEF_DLL_FN (SQLITE_API int, sqlite3_db_config, (sqlite3*, int, ...));
# undef sqlite3_db_config
# define sqlite3_db_config fn_sqlite3_db_config
# endif
# undef sqlite3_finalize
@ -170,8 +186,9 @@ load_dll_functions (HMODULE library)
LOAD_DLL_FN (library, sqlite3_column_text);
LOAD_DLL_FN (library, sqlite3_column_name);
LOAD_DLL_FN (library, sqlite3_exec);
# ifdef HAVE_SQLITE3_LOAD_EXTENSION
# if HAVE_LOAD_EXTENSION
LOAD_DLL_FN (library, sqlite3_load_extension);
LOAD_DLL_FN (library, sqlite3_db_config);
# endif
LOAD_DLL_FN (library, sqlite3_prepare_v2);
return true;
@ -669,7 +686,7 @@ DEFUN ("sqlite-pragma", Fsqlite_pragma, Ssqlite_pragma, 2, 2, 0,
SSDATA (concat2 (build_string ("PRAGMA "), pragma)));
}
#ifdef HAVE_SQLITE3_LOAD_EXTENSION
#if HAVE_LOAD_EXTENSION
DEFUN ("sqlite-load-extension", Fsqlite_load_extension,
Ssqlite_load_extension, 2, 2, 0,
doc: /* Load an SQlite MODULE into DB.
@ -684,9 +701,28 @@ Only modules on Emacs' list of allowed modules can be loaded. */)
CHECK_STRING (module);
/* Add names of useful and free modules here. */
const char *allowlist[3] = { "pcre", "csvtable", NULL };
const char *allowlist[] = {
"base64",
"cksumvfs",
"compress",
"csv",
"csvtable",
"fts3",
"icu",
"pcre",
"percentile",
"regexp",
"rot13",
"rtree",
"sha1",
"uuid",
"vfslog",
"zipfile",
NULL
};
char *name = SSDATA (Ffile_name_nondirectory (module));
/* Possibly skip past a common prefix. */
/* Possibly skip past a common prefix (libsqlite3_mod_ is used by
Debian, see https://packages.debian.org/source/sid/sqliteodbc). */
const char *prefix = "libsqlite3_mod_";
if (!strncmp (name, prefix, strlen (prefix)))
name += strlen (prefix);
@ -697,7 +733,7 @@ Only modules on Emacs' list of allowed modules can be loaded. */)
if (strlen (*allow) < strlen (name)
&& !strncmp (*allow, name, strlen (*allow))
&& (!strcmp (name + strlen (*allow), ".so")
|| !strcmp (name + strlen (*allow), ".DLL")))
|| !strcasecmp (name + strlen (*allow), ".dll")))
{
do_allow = true;
break;
@ -707,15 +743,25 @@ Only modules on Emacs' list of allowed modules can be loaded. */)
if (!do_allow)
xsignal1 (Qsqlite_error, build_string ("Module name not on allowlist"));
int result = sqlite3_load_extension
(XSQLITE (db)->db,
SSDATA (ENCODE_FILE (Fexpand_file_name (module, Qnil))),
NULL, NULL);
if (result == SQLITE_OK)
return Qt;
/* Expand all Lisp data explicitly, so as to avoid signaling an
error while extension loading is enabled -- we don't want to
"leak" this outside this function. */
sqlite3 *sdb = XSQLITE (db)->db;
char *ext_fn = SSDATA (ENCODE_FILE (Fexpand_file_name (module, Qnil)));
/* Temporarily enable loading extensions via the C API. */
int result = sqlite3_db_config (sdb, SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION, 1,
NULL);
if (result == SQLITE_OK)
{
result = sqlite3_load_extension (sdb, ext_fn, NULL, NULL);
/* Disable loading extensions via C API. */
sqlite3_db_config (sdb, SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION, 0, NULL);
if (result == SQLITE_OK)
return Qt;
}
return Qnil;
}
#endif /* HAVE_SQLITE3_LOAD_EXTENSION */
#endif /* HAVE_LOAD_EXTENSION */
DEFUN ("sqlite-next", Fsqlite_next, Ssqlite_next, 1, 1, 0,
doc: /* Return the next result set from SET.
@ -825,7 +871,7 @@ syms_of_sqlite (void)
defsubr (&Ssqlite_commit);
defsubr (&Ssqlite_rollback);
defsubr (&Ssqlite_pragma);
#ifdef HAVE_SQLITE3_LOAD_EXTENSION
#if HAVE_LOAD_EXTENSION
defsubr (&Ssqlite_load_extension);
#endif
defsubr (&Ssqlite_next);

23
test/src/sqlite-tests.el
View file

@ -197,10 +197,13 @@
(sqlite-load-extension db "/usr/lib/sqlite3/"))
(should-error
(sqlite-load-extension db "/usr/lib/sqlite3"))
(should
(memq
(sqlite-load-extension db "/usr/lib/sqlite3/pcre.so")
'(nil t)))
(if (eq system-type 'windows-nt)
(should
(eq (sqlite-load-extension db "/usr/lib/sqlite3/pcre.dll")
(file-readable-p "/usr/lib/sqlite3/pcre.dll")))
(should
(eq (sqlite-load-extension db "/usr/lib/sqlite3/pcre.so")
(file-readable-p "/usr/lib/sqlite3/pcre.so"))))
(should-error
(sqlite-load-extension
@ -211,11 +214,13 @@
(should-error
(sqlite-load-extension
db "/usr/lib/x86_64-linux-gnu/libsqlite3_mod_csvtable"))
(should
(memq
(sqlite-load-extension
db "/usr/lib/x86_64-linux-gnu/libsqlite3_mod_csvtable.so")
'(nil t)))))
(if (eq system-type 'windows-nt)
(should
(eq (sqlite-load-extension db "/usr/lib/sqlite3/csvtable.dll")
(file-readable-p "/usr/lib/sqlite3/csvtable.dll")))
(should
(eq (sqlite-load-extension db "/usr/lib/x86_64-linux-gnu/libsqlite3_mod_csvtable.so")
(file-readable-p "/usr/lib/x86_64-linux-gnu/libsqlite3_mod_csvtable.so"))))))
(ert-deftest sqlite-blob ()
(skip-unless (sqlite-available-p))

2
test/src/treesit-tests.el
View file

@ -69,7 +69,7 @@
(should
(equal (treesit-node-string
(treesit-parser-root-node parser))
"(ERROR)"))
"(document)"))
(insert "[1,2,3]")
(should