commit d727796e1f7d7af71c898a8cd0d263f9cf34992c (HEAD, refs/remotes/origin/master) Author: Lars Ingebrigtsen Date: Sat Dec 11 09:02:52 2021 +0100 Don't leave open cursors when listing sqlite data * lisp/sqlite-mode.el (sqlite-mode-list-data) (sqlite--mode--list-data): Don't leave open cursor (because they block other processes from deleting stuff). (sqlite-mode-delete): Adjust to new layout. diff --git a/lisp/sqlite-mode.el b/lisp/sqlite-mode.el index 48916b2311..6714f41f6f 100644 --- a/lisp/sqlite-mode.el +++ b/lisp/sqlite-mode.el @@ -36,11 +36,9 @@ :interactive nil (buffer-disable-undo) (setq-local buffer-read-only t - truncate-lines t - sqlite-mode--statements nil)) + truncate-lines t)) (defvar sqlite--db nil) -(defvar sqlite-mode--statements nil) ;;;###autoload (defun sqlite-mode-open-file (file) @@ -138,9 +136,7 @@ (get-text-property (point) 'sqlite--row)))) (unless row (user-error "No table under point")) - (let ((stmt (sqlite-select sqlite--db - (format "select * from %s" (car row)) nil 'set)) - (inhibit-read-only t)) + (let ((inhibit-read-only t)) (save-excursion (forward-line 1) (if (looking-at " ") @@ -148,8 +144,7 @@ (delete-region (point) (if (re-search-forward "^[^ ]" nil t) (match-beginning 0) (point-max))) - (sqlite--mode--list-data (list stmt (car row))) - (push stmt sqlite-mode--statements)))))) + (sqlite--mode--list-data (list (car row) 0))))))) (defun sqlite-mode--more-data (stmt) (let ((inhibit-read-only t)) @@ -158,16 +153,30 @@ (sqlite--mode--list-data stmt))) (defun sqlite--mode--list-data (data) - (let* ((stmt (car data)) - (table (cadr data)) - (rows - (cl-loop for i from 0 upto 1000 - for row = (sqlite-next stmt) - while row - collect row))) - (sqlite-mode--tablify (sqlite-columns stmt) rows (cons 'row table) " ") - (when (sqlite-more-p stmt) - (insert (buttonize " More data...\n" #'sqlite-mode--more-data data))))) + (let* ((table (car data)) + (rowid (cadr data)) + stmt) + (unwind-protect + (progn + (setq stmt + (sqlite-select + sqlite--db + (format "select rowid, * from %s where rowid >= ?" table) + (list rowid) + 'set)) + (sqlite-mode--tablify (sqlite-columns stmt) + (cl-loop for i from 0 upto 1000 + for row = (sqlite-next stmt) + while row + do (setq rowid (car row)) + collect row) + (cons 'row table) + " ") + (when (sqlite-more-p stmt) + (insert (buttonize " More data...\n" #'sqlite-mode--more-data + (list table rowid))))) + (when stmt + (sqlite-finalize stmt))))) (defun sqlite-mode-delete () "Delete the row under point." @@ -178,19 +187,6 @@ (when (or (not (consp table)) (not (eq (car table) 'row))) (user-error "No row under point")) - ;; We have to remove all open statements before we can delete - ;; something. FIXME -- perhaps this should be changed not to use - ;; long-lived statements, since this presumably locks the file for - ;; other users, too. - (dolist (stmt sqlite-mode--statements) - (ignore-errors (sqlite-finalize stmt))) - (setq sqlite-mode--statements nil) - (save-excursion - (goto-char (point-min)) - (let (match) - (while (setq match (text-property-search-forward 'button-data)) - (delete-region (prop-match-beginning match) - (prop-match-end match))))) (sqlite-execute sqlite--db (format "delete from %s where %s" @@ -198,7 +194,7 @@ (string-join (mapcar (lambda (column) (format "%s = ?" (car (split-string column " ")))) - (sqlite-mode--column-names (cdr table))) + (cons "rowid" (sqlite-mode--column-names (cdr table)))) " and ")) row) (delete-region (line-beginning-position) (progn (forward-line 1) (point))))) commit 5d476a9ed892e390e05eab73e7b57a4b879a1780 Author: Lars Ingebrigtsen Date: Sat Dec 11 08:18:02 2021 +0100 Add FIXME comment * lisp/sqlite-mode.el (sqlite-mode-delete): New command. (sqlite--mode--list-data, sqlite-mode-list-data): Adjust to new command. diff --git a/lisp/sqlite-mode.el b/lisp/sqlite-mode.el index 5e0410e483..48916b2311 100644 --- a/lisp/sqlite-mode.el +++ b/lisp/sqlite-mode.el @@ -178,7 +178,10 @@ (when (or (not (consp table)) (not (eq (car table) 'row))) (user-error "No row under point")) - ;; We have to remove all open statements before we can delete something. + ;; We have to remove all open statements before we can delete + ;; something. FIXME -- perhaps this should be changed not to use + ;; long-lived statements, since this presumably locks the file for + ;; other users, too. (dolist (stmt sqlite-mode--statements) (ignore-errors (sqlite-finalize stmt))) (setq sqlite-mode--statements nil) commit 7cbda71617f52adde8872c6d2d260e94e4b52edd Author: Lars Ingebrigtsen Date: Sat Dec 11 08:11:10 2021 +0100 Add an sqlite-mode-delete command * lisp/sqlite-mode.el (sqlite-mode-delete): New command. (sqlite--mode--list-data, sqlite-mode-list-data): Adjust to new command. diff --git a/lisp/sqlite-mode.el b/lisp/sqlite-mode.el index e33a040f7e..5e0410e483 100644 --- a/lisp/sqlite-mode.el +++ b/lisp/sqlite-mode.el @@ -28,16 +28,19 @@ (defvar-keymap sqlite-mode-map "g" #'sqlite-mode-list-tables "c" #'sqlite-mode-list-columns - "RET" #'sqlite-mode-list-data) + "RET" #'sqlite-mode-list-data + "DEL" #'sqlite-mode-delete) (define-derived-mode sqlite-mode special-mode "Sqlite" "This mode lists the contents of an .sqlite3 file" :interactive nil (buffer-disable-undo) (setq-local buffer-read-only t - truncate-lines t)) + truncate-lines t + sqlite-mode--statements nil)) (defvar sqlite--db nil) +(defvar sqlite-mode--statements nil) ;;;###autoload (defun sqlite-mode-open-file (file) @@ -62,10 +65,11 @@ (car table))))) entries)) (sqlite-mode--tablify '("Table Name" "Number of Rows") - (nreverse entries)) + (nreverse entries) + 'table) (goto-char (point-min)))) -(defun sqlite-mode--tablify (columns rows &optional prefix) +(defun sqlite-mode--tablify (columns rows type &optional prefix) (let ((widths (mapcar (lambda (i) @@ -94,6 +98,7 @@ (nth i row) (string-replace "\n" " " (or elem ""))))))) (put-text-property start (point) 'sqlite--row row) + (put-text-property start (point) 'sqlite--type type) (insert "\n"))))) (defun sqlite-mode-list-columns () @@ -129,7 +134,8 @@ (defun sqlite-mode-list-data () "List the data from the table under poing." (interactive nil sqlite-mode) - (let ((row (get-text-property (point) 'sqlite--row))) + (let ((row (and (eq (get-text-property (point) 'sqlite--type) 'table) + (get-text-property (point) 'sqlite--row)))) (unless row (user-error "No table under point")) (let ((stmt (sqlite-select sqlite--db @@ -142,7 +148,8 @@ (delete-region (point) (if (re-search-forward "^[^ ]" nil t) (match-beginning 0) (point-max))) - (sqlite--mode--list-data stmt)))))) + (sqlite--mode--list-data (list stmt (car row))) + (push stmt sqlite-mode--statements)))))) (defun sqlite-mode--more-data (stmt) (let ((inhibit-read-only t)) @@ -150,16 +157,48 @@ (delete-region (point) (progn (forward-line 1) (point))) (sqlite--mode--list-data stmt))) -(defun sqlite--mode--list-data (stmt) - (let ((rows - (cl-loop for i from 0 upto 1000 - for row = (sqlite-next stmt) - while row - collect row))) - (sqlite-mode--tablify (sqlite-columns stmt) rows " ") +(defun sqlite--mode--list-data (data) + (let* ((stmt (car data)) + (table (cadr data)) + (rows + (cl-loop for i from 0 upto 1000 + for row = (sqlite-next stmt) + while row + collect row))) + (sqlite-mode--tablify (sqlite-columns stmt) rows (cons 'row table) " ") (when (sqlite-more-p stmt) - (insert (buttonize " More data...\n" - #'sqlite-mode--more-data stmt))))) + (insert (buttonize " More data...\n" #'sqlite-mode--more-data data))))) + +(defun sqlite-mode-delete () + "Delete the row under point." + (interactive nil sqlite-mode) + (let ((table (get-text-property (point) 'sqlite--type)) + (row (get-text-property (point) 'sqlite--row)) + (inhibit-read-only t)) + (when (or (not (consp table)) + (not (eq (car table) 'row))) + (user-error "No row under point")) + ;; We have to remove all open statements before we can delete something. + (dolist (stmt sqlite-mode--statements) + (ignore-errors (sqlite-finalize stmt))) + (setq sqlite-mode--statements nil) + (save-excursion + (goto-char (point-min)) + (let (match) + (while (setq match (text-property-search-forward 'button-data)) + (delete-region (prop-match-beginning match) + (prop-match-end match))))) + (sqlite-execute + sqlite--db + (format "delete from %s where %s" + (cdr table) + (string-join + (mapcar (lambda (column) + (format "%s = ?" (car (split-string column " ")))) + (sqlite-mode--column-names (cdr table))) + " and ")) + row) + (delete-region (line-beginning-position) (progn (forward-line 1) (point))))) (provide 'sqlite-mode) commit 17569c94954dc1d9d47155a8ca987d8ff4855180 Author: Lars Ingebrigtsen Date: Sat Dec 11 07:47:34 2021 +0100 Fix Fsqlite_finalize book-keeping * src/sqlite.c (Fsqlite_finalize): Mark the object as dead. diff --git a/src/sqlite.c b/src/sqlite.c index 42a7a3a026..c1f3e7b599 100644 --- a/src/sqlite.c +++ b/src/sqlite.c @@ -290,7 +290,7 @@ DEFUN ("sqlite-close", Fsqlite_close, Ssqlite_close, 1, 1, 0, check_sqlite (db, false); sqlite3_close (XSQLITE (db)->db); XSQLITE (db)->db = NULL; - return Qnil; + return Qt; } /* Bind values in a statement like @@ -647,6 +647,7 @@ This will free the resources held by SET. */) { check_sqlite (set, true); sqlite3_finalize (XSQLITE (set)->stmt); + XSQLITE (set)->db = NULL; return Qt; } diff --git a/test/src/sqlite-tests.el b/test/src/sqlite-tests.el index 412ea29189..7ccea1c2a5 100644 --- a/test/src/sqlite-tests.el +++ b/test/src/sqlite-tests.el @@ -79,7 +79,9 @@ (should (equal (sqlite-next set) '("bar" 2))) (should-not (sqlite-next set)) - (should-not (sqlite-more-p set)))) + (should-not (sqlite-more-p set)) + (sqlite-finalize set) + (should-error (sqlite-next set)))) (ert-deftest sqlite-chars () (skip-unless (sqlite-available-p)) commit 19233f650168b8298075d7ae330dbeda9748b57d Author: Stefan Kangas Date: Sat Dec 11 07:10:02 2021 +0100 ; * etc/NEWS: Fix wording in recent entry. diff --git a/etc/NEWS b/etc/NEWS index a40c8f82a5..b0dfa301d3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -93,7 +93,7 @@ the 'variable-pitch' face, or add this to your "~/.emacs": +++ ** Emacs now comes with optional built-in support for sqlite3. -This allows you to examine/manipulate sqlite3 databases. +This allows you to examine and manipulate sqlite3 databases. ** New command 'sqlite-mode-open-file' for examining an sqlite3 file. This uses the new 'sqlite-mode' which allows listing the tables commit b3318193021ab47c51910dcececde2add881653f Merge: fb11575f3c 5708da48d1 Author: Stefan Kangas Date: Sat Dec 11 06:56:31 2021 +0100 Merge from origin/emacs-28 5708da48d1 Revert "Make `M-x run-python' select the window again" aa2872a127 Make `M-x run-python' select the window again c8e19b3a84 Don't bug out on certain empty elements with ids commit fb11575f3cfe90b409a6ff364ba4c70777537499 Author: Lars Ingebrigtsen Date: Sat Dec 11 06:50:58 2021 +0100 Improve sqlite-mode--tablify tables * lisp/sqlite-mode.el (sqlite-mode--tablify): Tweak column widths and sanitize newlines. diff --git a/lisp/sqlite-mode.el b/lisp/sqlite-mode.el index 9edb85b61a..e33a040f7e 100644 --- a/lisp/sqlite-mode.el +++ b/lisp/sqlite-mode.el @@ -76,7 +76,7 @@ (when prefix (insert prefix)) (dotimes (i (length widths)) - (insert (propertize (format (format "%%-%ds" (nth i widths)) + (insert (propertize (format (format "%%-%ds " (nth i widths)) (nth i columns)) 'face 'header-line))) (insert "\n") @@ -85,11 +85,14 @@ (when prefix (insert prefix)) (dotimes (i (length widths)) - (insert (format (format "%%%s%ds" - (if (numberp (nth i row)) - "" "-") - (nth i widths)) - (or (nth i row) "")))) + (let ((elem (nth i row))) + (insert (format (format "%%%s%ds " + (if (numberp elem) + "" "-") + (nth i widths)) + (if (numberp elem) + (nth i row) + (string-replace "\n" " " (or elem ""))))))) (put-text-property start (point) 'sqlite--row row) (insert "\n"))))) commit ebf59d1a28b49b391b8025d7017bacf853c01aa2 Author: Lars Ingebrigtsen Date: Sat Dec 11 06:40:01 2021 +0100 Check whether the sqlite supports sqlite3_load_extension * configure.ac: Check for sqlite3_load_extension, which is apparently missing in some versions. * src/sqlite.c: Add guards. (Fsqlite_load_extension): Ifdef out on systems that doesn't have it. diff --git a/configure.ac b/configure.ac index 5eb23849b5..8d15c70d84 100644 --- a/configure.ac +++ b/configure.ac @@ -2695,6 +2695,11 @@ if test "${with_sqlite3}" != "no"; then if test "${opsys}" = "mingw32"; then SQLITE3_LIBS= fi + AC_CHECK_LIB(sqlite3, sqlite3_load_extension, + HAVE_SQLITE3_LOAD_EXTENSION=yes, HAVE_SQLITE3_LOAD_EXTENSION=no) + if test "$HAVE_SQLITE3_LOAD_EXTENSION" = "yes"; then + AC_DEFINE(HAVE_SQLITE3_LOAD_EXTENSION, 1, [Define to 1 if sqlite3 supports loading extensions.]) + fi fi fi diff --git a/src/sqlite.c b/src/sqlite.c index 50989434ff..42a7a3a026 100644 --- a/src/sqlite.c +++ b/src/sqlite.c @@ -65,11 +65,16 @@ DEF_DLL_FN (SQLITE_API const char*, sqlite3_column_name, (sqlite3_stmt*, int)); DEF_DLL_FN (SQLITE_API int, sqlite3_exec, (sqlite3*, const char*, int (*callback)(void*,int,char**,char**), void*, char**)); -DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension, - (sqlite3*, const char*, const char*, char**)); DEF_DLL_FN (SQLITE_API int, sqlite3_prepare_v2, (sqlite3*, const char*, int, sqlite3_stmt**, const char**)); +# ifdef HAVE_SQLITE3_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 +# endif + # undef sqlite3_finalize # undef sqlite3_close # undef sqlite3_open_v2 @@ -91,7 +96,6 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_prepare_v2, # undef sqlite3_column_text # undef sqlite3_column_name # undef sqlite3_exec -# undef sqlite3_load_extension # undef sqlite3_prepare_v2 # define sqlite3_finalize fn_sqlite3_finalize @@ -115,7 +119,6 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_prepare_v2, # define sqlite3_column_text fn_sqlite3_column_text # define sqlite3_column_name fn_sqlite3_column_name # define sqlite3_exec fn_sqlite3_exec -# define sqlite3_load_extension fn_sqlite3_load_extension # define sqlite3_prepare_v2 fn_sqlite3_prepare_v2 static bool @@ -142,7 +145,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 LOAD_DLL_FN (library, sqlite3_load_extension); +# endif LOAD_DLL_FN (library, sqlite3_prepare_v2); return true; } @@ -576,6 +581,7 @@ DEFUN ("sqlite-rollback", Fsqlite_rollback, Ssqlite_rollback, 1, 1, 0, return sqlite_exec (XSQLITE (db)->db, "rollback"); } +#ifdef HAVE_SQLITE3_LOAD_EXTENSION DEFUN ("sqlite-load-extension", Fsqlite_load_extension, Ssqlite_load_extension, 2, 2, 0, doc: /* Load an SQlite module into DB. @@ -593,6 +599,7 @@ MODULE should be the file name of an SQlite module .so file. */) return Qt; return Qnil; } +#endif /* HAVE_SQLITE3_LOAD_EXTENSION */ DEFUN ("sqlite-next", Fsqlite_next, Ssqlite_next, 1, 1, 0, doc: /* Return the next result set from SET. */) @@ -691,7 +698,9 @@ syms_of_sqlite (void) defsubr (&Ssqlite_transaction); defsubr (&Ssqlite_commit); defsubr (&Ssqlite_rollback); +#ifdef HAVE_SQLITE3_LOAD_EXTENSION defsubr (&Ssqlite_load_extension); +#endif defsubr (&Ssqlite_next); defsubr (&Ssqlite_columns); defsubr (&Ssqlite_more_p); commit ad1b80d91dfae992c91d36446af5357f77739bfc Author: Lars Ingebrigtsen Date: Sat Dec 11 06:31:42 2021 +0100 Fix sqlite-mode.el build problems * lisp/sqlite-mode.el (sqlite-mode-list-tables): Fix function rename usage. diff --git a/lisp/sqlite-mode.el b/lisp/sqlite-mode.el index 0e018b62d5..9edb85b61a 100644 --- a/lisp/sqlite-mode.el +++ b/lisp/sqlite-mode.el @@ -23,6 +23,8 @@ ;;; Code: +(require 'cl-lib) + (defvar-keymap sqlite-mode-map "g" #'sqlite-mode-list-tables "c" #'sqlite-mode-list-columns @@ -45,7 +47,7 @@ (format "*SQLite %s*" (file-name-nondirectory file)))) (sqlite-mode) (setq-local sqlite--db (sqlite-open file)) - (sqlite-list-tables)) + (sqlite-mode-list-tables)) (defun sqlite-mode-list-tables () "Re-list the tables from the currently selected database." commit 385f2faf347b18eb4624f97020a49ae7e3f315e2 Author: Lars Ingebrigtsen Date: Sat Dec 11 06:26:37 2021 +0100 Fix some sqlite doc string typos * src/sqlite.c (Fsqlite_load_extension, Fsqlite_more_p): Fix typos in doc strings. diff --git a/src/sqlite.c b/src/sqlite.c index b1843bc573..50989434ff 100644 --- a/src/sqlite.c +++ b/src/sqlite.c @@ -578,7 +578,7 @@ DEFUN ("sqlite-rollback", Fsqlite_rollback, Ssqlite_rollback, 1, 1, 0, DEFUN ("sqlite-load-extension", Fsqlite_load_extension, Ssqlite_load_extension, 2, 2, 0, - doc: /* Load a an SQlite module into DB. + doc: /* Load an SQlite module into DB. MODULE should be the file name of an SQlite module .so file. */) (Lisp_Object db, Lisp_Object module) { @@ -622,7 +622,7 @@ DEFUN ("sqlite-columns", Fsqlite_columns, Ssqlite_columns, 1, 1, 0, } DEFUN ("sqlite-more-p", Fsqlite_more_p, Ssqlite_more_p, 1, 1, 0, - doc: /* Say whether there's any further results in SET. */) + doc: /* Say whether there are any further results in SET. */) (Lisp_Object set) { check_sqlite (set, true); diff --git a/test/src/sqlite-tests.el b/test/src/sqlite-tests.el index 3fffa0100b..412ea29189 100644 --- a/test/src/sqlite-tests.el +++ b/test/src/sqlite-tests.el @@ -53,8 +53,6 @@ (sqlite-select db "select * from test1" nil 'full) '(("col1" "col2" "col3" "col4") ("foo" 2 9.45 "bar")))))) -;; (setq db (sqlite-open)) - (ert-deftest sqlite-set () (skip-unless (sqlite-available-p)) (let ((db (sqlite-open)) commit e5f71051a00a4ceb63cadc2513cb9619a1adffcc Author: Lars Ingebrigtsen Date: Sat Dec 11 06:23:57 2021 +0100 Add a new mode for examining sqlite files * lisp/sqlite-mode.el: New file. diff --git a/etc/NEWS b/etc/NEWS index 6f7ce0ab53..a40c8f82a5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -95,6 +95,10 @@ the 'variable-pitch' face, or add this to your "~/.emacs": ** Emacs now comes with optional built-in support for sqlite3. This allows you to examine/manipulate sqlite3 databases. +** New command 'sqlite-mode-open-file' for examining an sqlite3 file. +This uses the new 'sqlite-mode' which allows listing the tables +in a file, the columns, and the contents of the tables. + --- ** 'write-file' will now copy some file mode bits. If the current buffer is visiting a file that is executable, the diff --git a/lisp/sqlite-mode.el b/lisp/sqlite-mode.el new file mode 100644 index 0000000000..0e018b62d5 --- /dev/null +++ b/lisp/sqlite-mode.el @@ -0,0 +1,161 @@ +;;; sqlite-mode.el --- Mode for examining sqlite3 database files -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(defvar-keymap sqlite-mode-map + "g" #'sqlite-mode-list-tables + "c" #'sqlite-mode-list-columns + "RET" #'sqlite-mode-list-data) + +(define-derived-mode sqlite-mode special-mode "Sqlite" + "This mode lists the contents of an .sqlite3 file" + :interactive nil + (buffer-disable-undo) + (setq-local buffer-read-only t + truncate-lines t)) + +(defvar sqlite--db nil) + +;;;###autoload +(defun sqlite-mode-open-file (file) + "Browse the contents of an sqlite file." + (interactive "fSQLite file name: ") + (pop-to-buffer (get-buffer-create + (format "*SQLite %s*" (file-name-nondirectory file)))) + (sqlite-mode) + (setq-local sqlite--db (sqlite-open file)) + (sqlite-list-tables)) + +(defun sqlite-mode-list-tables () + "Re-list the tables from the currently selected database." + (interactive nil sqlite-mode) + (let ((inhibit-read-only t) + (db sqlite--db) + (entries nil)) + (erase-buffer) + (dolist (table (sqlite-select db "select name from sqlite_schema where type = 'table' and name not like 'sqlite_%' order by name")) + (push (list (car table) + (caar (sqlite-select db (format "select count(*) from %s" + (car table))))) + entries)) + (sqlite-mode--tablify '("Table Name" "Number of Rows") + (nreverse entries)) + (goto-char (point-min)))) + +(defun sqlite-mode--tablify (columns rows &optional prefix) + (let ((widths + (mapcar + (lambda (i) + (1+ (seq-max (mapcar (lambda (row) + (length (format "%s" (nth i row)))) + (cons columns rows))))) + (number-sequence 0 (1- (length columns)))))) + (when prefix + (insert prefix)) + (dotimes (i (length widths)) + (insert (propertize (format (format "%%-%ds" (nth i widths)) + (nth i columns)) + 'face 'header-line))) + (insert "\n") + (dolist (row rows) + (let ((start (point))) + (when prefix + (insert prefix)) + (dotimes (i (length widths)) + (insert (format (format "%%%s%ds" + (if (numberp (nth i row)) + "" "-") + (nth i widths)) + (or (nth i row) "")))) + (put-text-property start (point) 'sqlite--row row) + (insert "\n"))))) + +(defun sqlite-mode-list-columns () + "List the columns of the table under point." + (interactive nil sqlite-mode) + (let ((row (get-text-property (point) 'sqlite--row))) + (unless row + (user-error "No table under point")) + (let ((columns (sqlite-mode--column-names (car row))) + (inhibit-read-only t)) + (save-excursion + (forward-line 1) + (if (looking-at " ") + ;; Delete the info. + (delete-region (point) (if (re-search-forward "^[^ ]" nil t) + (match-beginning 0) + (point-max))) + ;; Insert the info. + (dolist (column columns) + (insert (format " %s\n" column)))))))) + +(defun sqlite-mode--column-names (table) + (let ((sql + (caar + (sqlite-select + sqlite--db + "select sql from sqlite_master where tbl_name = ? AND type = 'table'" + (list table))))) + (mapcar + #'string-trim + (split-string (replace-regexp-in-string "^.*(\\|)$" "" sql) ",")))) + +(defun sqlite-mode-list-data () + "List the data from the table under poing." + (interactive nil sqlite-mode) + (let ((row (get-text-property (point) 'sqlite--row))) + (unless row + (user-error "No table under point")) + (let ((stmt (sqlite-select sqlite--db + (format "select * from %s" (car row)) nil 'set)) + (inhibit-read-only t)) + (save-excursion + (forward-line 1) + (if (looking-at " ") + ;; Delete the info. + (delete-region (point) (if (re-search-forward "^[^ ]" nil t) + (match-beginning 0) + (point-max))) + (sqlite--mode--list-data stmt)))))) + +(defun sqlite-mode--more-data (stmt) + (let ((inhibit-read-only t)) + (beginning-of-line) + (delete-region (point) (progn (forward-line 1) (point))) + (sqlite--mode--list-data stmt))) + +(defun sqlite--mode--list-data (stmt) + (let ((rows + (cl-loop for i from 0 upto 1000 + for row = (sqlite-next stmt) + while row + collect row))) + (sqlite-mode--tablify (sqlite-columns stmt) rows " ") + (when (sqlite-more-p stmt) + (insert (buttonize " More data...\n" + #'sqlite-mode--more-data stmt))))) + +(provide 'sqlite-mode) + +;;; sqlite-mode.el ends here commit 7364b60fe9cd37c4ea7650f00df2d6cb4cd601da Author: Lars Ingebrigtsen Date: Sat Dec 11 05:22:42 2021 +0100 Fix comment in heading diff --git a/lisp/sqlite.el b/lisp/sqlite.el index a47689cff2..dccdda16ac 100644 --- a/lisp/sqlite.el +++ b/lisp/sqlite.el @@ -1,4 +1,4 @@ -;;; sqlite.el --- Tests for empty.el -*- lexical-binding: t; -*- +;;; sqlite.el --- Functions for interacting with sqlite3 databases -*- lexical-binding: t; -*- ;; Copyright (C) 2021 Free Software Foundation, Inc. commit d2081b2b33164da84ac7ca9a2abf1e9e03cd255b Author: Lars Ingebrigtsen Date: Sat Dec 11 04:57:22 2021 +0100 Add NEWS entry for sqlite diff --git a/etc/NEWS b/etc/NEWS index 5285f526d4..6f7ce0ab53 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -91,6 +91,10 @@ the 'variable-pitch' face, or add this to your "~/.emacs": * Changes in Emacs 29.1 ++++ +** Emacs now comes with optional built-in support for sqlite3. +This allows you to examine/manipulate sqlite3 databases. + --- ** 'write-file' will now copy some file mode bits. If the current buffer is visiting a file that is executable, the commit 3d38d1d1345aa65c4018b42e6c648606e32216f8 Author: Lars Ingebrigtsen Date: Sat Dec 11 04:55:57 2021 +0100 Add sqlite3 support to Emacs * configure.ac: Add check for the sqlite library. * doc/lispref/text.texi (Database): Document it. * lisp/sqlite.el: New file. * lisp/term/w32-win.el (dynamic-library-alist): Add a mapping. * src/Makefile.in (SQLITE3_LIBS): Add the libraries. * src/alloc.c (union emacs_align_type): Add a Lisp_Sqlite struct. * src/data.c (Ftype_of): Add sqlite. * src/emacs.c (main): Load the syms. * src/lisp.h (DEFINE_GDB_SYMBOL_BEGIN): Add PVEC_SQLITE. (GCALIGNED_STRUCT): New struct to keep data for sqlite database objects and statement objects. (SQLITEP, SQLITE, CHECK_SQLITE, XSQLITE): New macros for accessing the objects. * src/pdumper.c (dump_vectorlike): Update hash. (dump_vectorlike): Don't dump it. * src/print.c (print_vectorlike): Add a printer for the sqlite object. * src/sqlite.c: New file. * test/src/sqlite-tests.el: Add tests. diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index 634d6f3f3b..620ab0bed0 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES @@ -288,6 +288,7 @@ HAVE_UTMP_H HAVE_VFORK HAVE_VFORK_H HAVE_WEBP +HAVE_SQLITE3 HAVE_WCHAR_H HAVE_WCHAR_T HAVE_WINDOW_SYSTEM diff --git a/configure.ac b/configure.ac index 0c23b60805..5eb23849b5 100644 --- a/configure.ac +++ b/configure.ac @@ -448,6 +448,7 @@ OPTION_DEFAULT_ON([gif],[don't compile with GIF image support]) OPTION_DEFAULT_ON([png],[don't compile with PNG image support]) OPTION_DEFAULT_ON([rsvg],[don't compile with SVG image support]) OPTION_DEFAULT_ON([webp],[don't compile with WebP image support]) +OPTION_DEFAULT_ON([sqlite3],[don't compile with sqlite3 support]) OPTION_DEFAULT_ON([lcms2],[don't compile with Little CMS support]) OPTION_DEFAULT_ON([libsystemd],[don't compile with libsystemd support]) OPTION_DEFAULT_ON([cairo],[don't compile with Cairo drawing]) @@ -2681,6 +2682,22 @@ if test "${with_webp}" != "no"; then fi fi +### Use -lsqlite3 if available, unless '--with-sqlite3=no' +HAVE_SQLITE3=no +if test "${with_sqlite3}" != "no"; then + AC_CHECK_LIB(sqlite3, sqlite3_open_v2, HAVE_SQLITE3=yes, HAVE_SQLITE3=no) + if test "$HAVE_SQLITE3" = "yes"; then + SQLITE3_LIBS=-lsqlite3 + AC_SUBST(SQLITE3_LIBS) + LIBS="$SQLITE3_LIBS $LIBS" + AC_DEFINE(HAVE_SQLITE3, 1, [Define to 1 if you have the libsqlite3 library (-lsqlite).]) + # Windows loads libwebp dynamically + if test "${opsys}" = "mingw32"; then + SQLITE3_LIBS= + fi + fi +fi + HAVE_IMAGEMAGICK=no if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" || test "${HAVE_W32}" = "yes" || \ test "${HAVE_BE_APP}" = "yes"; then @@ -6155,7 +6172,7 @@ emacs_config_features= for opt in ACL BE_APP CAIRO DBUS FREETYPE GCONF GIF GLIB GMP GNUTLS GPM GSETTINGS \ HARFBUZZ IMAGEMAGICK JPEG JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 \ M17N_FLT MODULES NATIVE_COMP NOTIFY NS OLDXMENU PDUMPER PNG RSVG SECCOMP \ - SOUND THREADS TIFF TOOLKIT_SCROLL_BARS \ + SOUND SQLITE3 THREADS TIFF TOOLKIT_SCROLL_BARS \ UNEXEC WEBP X11 XAW3D XDBE XFT XIM XINPUT2 XPM XWIDGETS X_TOOLKIT \ ZLIB; do @@ -6202,6 +6219,7 @@ AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D Does Emacs use a png library? ${HAVE_PNG} $LIBPNG Does Emacs use -lrsvg-2? ${HAVE_RSVG} Does Emacs use -lwebp? ${HAVE_WEBP} + Does Emacs use -lsqlite3? ${HAVE_SQLITE3} Does Emacs use cairo? ${HAVE_CAIRO} Does Emacs use -llcms2? ${HAVE_LCMS2} Does Emacs use imagemagick? ${HAVE_IMAGEMAGICK} diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 4f47a1d1bb..b773ba8fb9 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -1224,6 +1224,7 @@ Text * Base 64:: Conversion to or from base 64 encoding. * Checksum/Hash:: Computing cryptographic hashes. * GnuTLS Cryptography:: Cryptographic algorithms imported from GnuTLS. +* Database:: Interacting with an SQL database. * Parsing HTML/XML:: Parsing HTML and XML. * Atomic Changes:: Installing several buffer changes atomically. * Change Hooks:: Supplying functions to be run when text is changed. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 03adb541f9..e964d7b53c 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -60,6 +60,7 @@ the character after point. * Base 64:: Conversion to or from base 64 encoding. * Checksum/Hash:: Computing cryptographic hashes. * GnuTLS Cryptography:: Cryptographic algorithms imported from GnuTLS. +* Database:: Interacting with an SQL database. * Parsing HTML/XML:: Parsing HTML and XML. * Parsing JSON:: Parsing and generating JSON values. * JSONRPC:: JSON Remote Procedure Call protocol @@ -5135,6 +5136,151 @@ On success, it returns a list of a binary string (the output) and the IV used. @end defun +@node Database +@section Database + + Emacs can be compiled with built-in SQLite support. + +@defun sqlite-available-p +The function returns non-@code{nil} if built-in SQLite support is +available in this Emacs session. +@end defun + +When SQLite support is available, the following functions can be used. + +@defun sqlite-open &optional file +This function opens @var{file} as a database file. If it doesn't +exist, a new database will be created and stored there. If this +argument is missing or @code{nil}, a new in-memory database is created +instead. + +The return value is a @dfn{database object} that can be used as the +argument to most of the subsequent functions in this section of the +manual. +@end defun + +@defun sqlitep +The database object returned by the @code{sqlite-open} function +satisfies this predicate. +@end defun + +@defun sqlite-close db +Close the database @var{db}. It's usually not necessary to call this +function explicitly---the database will automatically be closed if +Emacs shuts down or the database object is garbage collected. +@end defun + +@defun sqlite-execute db statement &optional values +Execute the @acronym{SQL} @var{statement}. For instance: + +@lisp +(sqlite-execute db "insert into foo values ('bar', 2)") +@end lisp + +If the optional @var{values} parameter is present, it should be either +a list or a vector of values to bind while executing the statement. +For instance: + +@lisp +(sqlite-execute db "insert into foo values (?, ?)" '("bar" 2)) +@end lisp + +This has exactly the same effect as the first form, but is more +efficient and safer (because it doesn't involve any string parsing or +interpolation). + +The number of affected rows is returned. For instance, an +@samp{insert} statement will return @samp{1}, but an @samp{update} +statement may return zero or a higher number. +@end defun + +@defun sqlite-select db query &optional values result-type +Select some data from @var{db} and return them. For instance: + +@lisp +(sqlite-select db "select * from foo where key = 2") + @result{} (("bar" 2)) +@end lisp + +As with the @code{sqlite-execute} command, you can pass in a list or a +vector of values that will be bound before executing the select: + +@lisp +(sqlite-select db "select * from foo where key = ?" [2]) + @result{} (("bar" 2)) +@end lisp + +This is usually more efficient and safer than the first method. + +This function, by default, returns a list of matching rows, where each +row is a list of column values. If @var{return-type} is @code{full}, +the names of the columns (as a list of strings) will be returned as +the first element in the return value. + +If @var{return-type} is @code{set}, this function will return a +@dfn{statement object} instead. This object can be interrogated by +the @code{sqlite-next}, @code{sqlite-columns} and @code{sqlite-more-p} +functions. If the result set is small, it's often more convenient to +just return the data directly, but if the result set is large (or if +you won't be using all the data from the set), using the @code{set} +method will allocate a lot less data, and therefore be more efficient. +@end defun + +@defun sqlite-next statement +This function returns the next row in the result set returned by +@code{sqlite-select}. + +@lisp +(sqlite-next stmt) + @result{} ("bar" 2) +@end lisp +@end defun + +@defun sqlite-columns statement +This function returns the column names of the result set returned by +@code{sqlite-select}. + +@lisp +(sqlite-columns stmt) + @result{} ("name" "issue") +@end lisp +@end defun + +@defun sqlite-more-p statement +This predicate says whether there is more data to be fetched in the +result set returned by @code{sqlite-select}. +@end defun + +@defun sqlite-finalize statement +If @var{statement} is not going to be used any more, calling this +function will free the resources bound by @var{statement}. This is +usually not necessary---when the statement object is +garbage-collected, this will happen automatically. +@end defun + +@defun sqlite-transaction db +Start a transaction in @var{db}. When in a transaction, other readers +of the database won't access the results until the transaction has +been committed. +@end defun + +@defun sqlite-commit db +End a transaction and write the data out to file. +@end defun + +@defun sqlite-rollback db +End a transaction and discard any changes that have been made. +@end defun + +@defmac with-sqlite-transaction db &body body +Like @code{progn}, but executes @var{body} with a transaction held, +and do a commit at the end. +@end defmac + +@defun sqlite-load-extension db module +Load an extension into @var{db}. Extensions are usually @file{.so} files. +@end defun + @node Parsing HTML/XML @section Parsing HTML and XML @cindex parsing html diff --git a/lisp/sqlite.el b/lisp/sqlite.el new file mode 100644 index 0000000000..a47689cff2 --- /dev/null +++ b/lisp/sqlite.el @@ -0,0 +1,42 @@ +;;; sqlite.el --- Tests for empty.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(defmacro with-sqlite-transaction (db &rest body) + "Execute BODY while holding a transaction for DB." + (declare (indent 1) (debug (form body))) + (let ((db-var (gensym))) + `(let ((,db-var ,db)) + (if (sqlite-available-p) + (unwind-protect + (progn + (sqlite-transaction ,db-var) + ,@body) + (sqlite-commit ,db-var)) + (progn + ,@body))))) + +(provide 'sqlite) + +;;; sqlite.el ends here diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 8b745c495d..0ee010b6c8 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -275,6 +275,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") '(gif "libgif-5.dll" "giflib4.dll" "libungif4.dll" "libungif.dll"))) '(svg "librsvg-2-2.dll") '(webp "libwebp-7.dll" "libwebp.dll") + '(sqlite3 "libsqlite3-0.dll") '(gdk-pixbuf "libgdk_pixbuf-2.0-0.dll") '(glib "libglib-2.0-0.dll") '(gio "libgio-2.0-0.dll") diff --git a/src/Makefile.in b/src/Makefile.in index d276df2247..3a8445db2d 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -238,6 +238,8 @@ IMAGEMAGICK_CFLAGS= @IMAGEMAGICK_CFLAGS@ LIBXML2_LIBS = @LIBXML2_LIBS@ LIBXML2_CFLAGS = @LIBXML2_CFLAGS@ +SQLITE3_LIBS = @SQLITE3_LIBS@ + GETADDRINFO_A_LIBS = @GETADDRINFO_A_LIBS@ LCMS2_LIBS = @LCMS2_LIBS@ @@ -426,7 +428,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \ doprnt.o intervals.o textprop.o composite.o xml.o lcms.o $(NOTIFY_OBJ) \ $(XWIDGETS_OBJ) \ profiler.o decompress.o \ - thread.o systhread.o \ + thread.o systhread.o sqlite.o \ $(if $(HYBRID_MALLOC),sheap.o) \ $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \ $(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ) \ @@ -549,7 +551,8 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \ $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(HARFBUZZ_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LCMS2_LIBS) \ $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS) \ - $(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT_LIBS) $(XINPUT_LIBS) $(HAIKU_LIBS) + $(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT_LIBS) $(XINPUT_LIBS) $(HAIKU_LIBS) \ + $(SQLITE3_LIBS) ## FORCE it so that admin/unidata can decide whether this file is ## up-to-date. Although since charprop depends on bootstrap-emacs, diff --git a/src/alloc.c b/src/alloc.c index 55c30847bb..9f52a414d6 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -125,6 +125,7 @@ union emacs_align_type struct Lisp_Overlay Lisp_Overlay; struct Lisp_Sub_Char_Table Lisp_Sub_Char_Table; struct Lisp_Subr Lisp_Subr; + struct Lisp_Sqlite Lisp_Sqlite; struct Lisp_User_Ptr Lisp_User_Ptr; struct Lisp_Vector Lisp_Vector; struct terminal terminal; diff --git a/src/data.c b/src/data.c index b2c395831a..f07667b000 100644 --- a/src/data.c +++ b/src/data.c @@ -259,6 +259,8 @@ for example, (type-of 1) returns `integer'. */) return Qxwidget; case PVEC_XWIDGET_VIEW: return Qxwidget_view; + case PVEC_SQLITE: + return Qsqlite; /* "Impossible" cases. */ case PVEC_MISC_PTR: case PVEC_OTHER: diff --git a/src/emacs.c b/src/emacs.c index 4734faf33c..3fc055aed9 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2183,6 +2183,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem #endif syms_of_window (); syms_of_xdisp (); + syms_of_sqlite (); syms_of_font (); #ifdef HAVE_WINDOW_SYSTEM syms_of_fringe (); diff --git a/src/lisp.h b/src/lisp.h index d44ab55453..92ab05b422 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1083,6 +1083,7 @@ enum pvec_type PVEC_CONDVAR, PVEC_MODULE_FUNCTION, PVEC_NATIVE_COMP_UNIT, + PVEC_SQLITE, /* These should be last, for internal_equal and sxhash_obj. */ PVEC_COMPILED, @@ -2570,6 +2571,17 @@ xmint_pointer (Lisp_Object a) return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Misc_Ptr)->pointer; } +struct Lisp_Sqlite +{ + union vectorlike_header header; + void *db; + void *stmt; + char *name; + void (*finalizer) (void *); + bool eof; + bool is_statement; +} GCALIGNED_STRUCT; + struct Lisp_User_Ptr { union vectorlike_header header; @@ -2647,6 +2659,31 @@ XUSER_PTR (Lisp_Object a) return XUNTAG (a, Lisp_Vectorlike, struct Lisp_User_Ptr); } +INLINE bool +SQLITEP (Lisp_Object x) +{ + return PSEUDOVECTORP (x, PVEC_SQLITE); +} + +INLINE bool +SQLITE (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_SQLITE); +} + +INLINE void +CHECK_SQLITE (Lisp_Object x) +{ + CHECK_TYPE (SQLITE (x), Qsqlitep, x); +} + +INLINE struct Lisp_Sqlite * +XSQLITE (Lisp_Object a) +{ + eassert (SQLITEP (a)); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Sqlite); +} + INLINE bool BIGNUMP (Lisp_Object x) { @@ -3793,6 +3830,9 @@ extern Lisp_Object safe_eval (Lisp_Object); extern bool pos_visible_p (struct window *, ptrdiff_t, int *, int *, int *, int *, int *, int *); +/* Defined in sqlite.c. */ +extern void syms_of_sqlite (void); + /* Defined in xsettings.c. */ extern void syms_of_xsettings (void); diff --git a/src/pdumper.c b/src/pdumper.c index 7ff079dfcf..c758bc8929 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2948,7 +2948,7 @@ dump_vectorlike (struct dump_context *ctx, Lisp_Object lv, dump_off offset) { -#if CHECK_STRUCTS && !defined HASH_pvec_type_F5BA506141 +#if CHECK_STRUCTS && !defined HASH_pvec_type_19F6CF5169 # error "pvec_type changed. See CHECK_STRUCTS comment in config.h." #endif const struct Lisp_Vector *v = XVECTOR (lv); @@ -3028,6 +3028,8 @@ dump_vectorlike (struct dump_context *ctx, error_unsupported_dump_object (ctx, lv, "mutex"); case PVEC_CONDVAR: error_unsupported_dump_object (ctx, lv, "condvar"); + case PVEC_SQLITE: + error_unsupported_dump_object (ctx, lv, "sqlite"); case PVEC_MODULE_FUNCTION: error_unsupported_dump_object (ctx, lv, "module function"); default: diff --git a/src/print.c b/src/print.c index adadb289de..214f1d12c1 100644 --- a/src/print.c +++ b/src/print.c @@ -1875,6 +1875,22 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, } break; #endif + case PVEC_SQLITE: + { + print_c_string ("#db); + strout (buf, i, i, printcharfun); + if (XSQLITE (obj)->is_statement) + { + i = sprintf (buf, " stmt=%p", XSQLITE (obj)->stmt); + strout (buf, i, i, printcharfun); + } + i = sprintf (buf, " name=%s", XSQLITE (obj)->name); + strout (buf, i, i, printcharfun); + printchar ('>', printcharfun); + } + break; + default: emacs_abort (); } diff --git a/src/sqlite.c b/src/sqlite.c new file mode 100644 index 0000000000..b1843bc573 --- /dev/null +++ b/src/sqlite.c @@ -0,0 +1,708 @@ +/* +Copyright (C) 2021 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . + +This file is based on the emacs-sqlite3 package written by Syohei +YOSHIDA , which can be found at: + + https://github.com/syohex/emacs-sqlite3 +*/ + +#include +#include "lisp.h" +#include "coding.h" + +#ifdef HAVE_SQLITE3 + +#include + +#ifdef WINDOWSNT + +# include +# include "w32common.h" +# include "w32.h" + +DEF_DLL_FN (SQLITE_API int, sqlite3_finalize, (sqlite3_stmt*)); +DEF_DLL_FN (SQLITE_API int, sqlite3_close, (sqlite3*)); +DEF_DLL_FN (SQLITE_API int, sqlite3_open_v2, + (const char*, sqlite3**, int, const char*)); +DEF_DLL_FN (SQLITE_API int, sqlite3_reset, (sqlite3_stmt*)); +DEF_DLL_FN (SQLITE_API int, sqlite3_bind_text, + (sqlite3_stmt*, int, const char*, int, void(*)(void*))); +DEF_DLL_FN (SQLITE_API int, sqlite3_bind_int64, + (sqlite3_stmt*, int, sqlite3_int64)); +DEF_DLL_FN (SQLITE_API int, sqlite3_bind_double, (sqlite3_stmt*, int, double)); +DEF_DLL_FN (SQLITE_API int, sqlite3_bind_null, (sqlite3_stmt*, int)); +DEF_DLL_FN (SQLITE_API int, sqlite3_bind_int, (sqlite3_stmt*, int, int)); +DEF_DLL_FN (SQLITE_API const char*, sqlite3_errmsg, (sqlite3*)); +DEF_DLL_FN (SQLITE_API int, sqlite3_step, (sqlite3_stmt*)); +DEF_DLL_FN (SQLITE_API int, sqlite3_changes, (sqlite3*)); +DEF_DLL_FN (SQLITE_API int, sqlite3_column_count, (sqlite3_stmt*)); +DEF_DLL_FN (SQLITE_API int, sqlite3_column_type, (sqlite3_stmt*, int)); +DEF_DLL_FN (SQLITE_API sqlite3_int64, sqlite3_column_int64, + (sqlite3_stmt*, int)); +DEF_DLL_FN (SQLITE_API double, sqlite3_column_double, (sqlite3_stmt*, int)); +DEF_DLL_FN (SQLITE_API const void*, sqlite3_column_blob, + (sqlite3_stmt*, int)); +DEF_DLL_FN (SQLITE_API int, sqlite3_column_bytes, (sqlite3_stmt*, int)); +DEF_DLL_FN (SQLITE_API const unsigned char*, sqlite3_column_text, + (sqlite3_stmt*, int)); +DEF_DLL_FN (SQLITE_API const char*, sqlite3_column_name, (sqlite3_stmt*, int)); +DEF_DLL_FN (SQLITE_API int, sqlite3_exec, + (sqlite3*, const char*, int (*callback)(void*,int,char**,char**), + void*, char**)); +DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension, + (sqlite3*, const char*, const char*, char**)); +DEF_DLL_FN (SQLITE_API int, sqlite3_prepare_v2, + (sqlite3*, const char*, int, sqlite3_stmt**, const char**)); + +# undef sqlite3_finalize +# undef sqlite3_close +# undef sqlite3_open_v2 +# undef sqlite3_reset +# undef sqlite3_bind_text +# undef sqlite3_bind_int64 +# undef sqlite3_bind_double +# undef sqlite3_bind_null +# undef sqlite3_bind_int +# undef sqlite3_errmsg +# undef sqlite3_step +# undef sqlite3_changes +# undef sqlite3_column_count +# undef sqlite3_column_type +# undef sqlite3_column_int64 +# undef sqlite3_column_double +# undef sqlite3_column_blob +# undef sqlite3_column_bytes +# undef sqlite3_column_text +# undef sqlite3_column_name +# undef sqlite3_exec +# undef sqlite3_load_extension +# undef sqlite3_prepare_v2 + +# define sqlite3_finalize fn_sqlite3_finalize +# define sqlite3_close fn_sqlite3_close +# define sqlite3_open_v2 fn_sqlite3_open_v2 +# define sqlite3_reset fn_sqlite3_reset +# define sqlite3_bind_text fn_sqlite3_bind_text +# define sqlite3_bind_int64 fn_sqlite3_bind_int64 +# define sqlite3_bind_double fn_sqlite3_bind_double +# define sqlite3_bind_null fn_sqlite3_bind_null +# define sqlite3_bind_int fn_sqlite3_bind_int +# define sqlite3_errmsg fn_sqlite3_errmsg +# define sqlite3_step fn_sqlite3_step +# define sqlite3_changes fn_sqlite3_changes +# define sqlite3_column_count fn_sqlite3_column_count +# define sqlite3_column_type fn_sqlite3_column_type +# define sqlite3_column_int64 fn_sqlite3_column_int64 +# define sqlite3_column_double fn_sqlite3_column_double +# define sqlite3_column_blob fn_sqlite3_column_blob +# define sqlite3_column_bytes fn_sqlite3_column_bytes +# define sqlite3_column_text fn_sqlite3_column_text +# define sqlite3_column_name fn_sqlite3_column_name +# define sqlite3_exec fn_sqlite3_exec +# define sqlite3_load_extension fn_sqlite3_load_extension +# define sqlite3_prepare_v2 fn_sqlite3_prepare_v2 + +static bool +load_dll_functions (HMODULE library) +{ + LOAD_DLL_FN (library, sqlite3_finalize); + LOAD_DLL_FN (library, sqlite3_close); + LOAD_DLL_FN (library, sqlite3_open_v2); + LOAD_DLL_FN (library, sqlite3_reset); + LOAD_DLL_FN (library, sqlite3_bind_text); + LOAD_DLL_FN (library, sqlite3_bind_int64); + LOAD_DLL_FN (library, sqlite3_bind_double); + LOAD_DLL_FN (library, sqlite3_bind_null); + LOAD_DLL_FN (library, sqlite3_bind_int); + LOAD_DLL_FN (library, sqlite3_errmsg); + LOAD_DLL_FN (library, sqlite3_step); + LOAD_DLL_FN (library, sqlite3_changes); + LOAD_DLL_FN (library, sqlite3_column_count); + LOAD_DLL_FN (library, sqlite3_column_type); + LOAD_DLL_FN (library, sqlite3_column_int64); + LOAD_DLL_FN (library, sqlite3_column_double); + LOAD_DLL_FN (library, sqlite3_column_blob); + LOAD_DLL_FN (library, sqlite3_column_bytes); + LOAD_DLL_FN (library, sqlite3_column_text); + LOAD_DLL_FN (library, sqlite3_column_name); + LOAD_DLL_FN (library, sqlite3_exec); + LOAD_DLL_FN (library, sqlite3_load_extension); + LOAD_DLL_FN (library, sqlite3_prepare_v2); + return true; +} + +static bool +sqlite_loaded_p (void) +{ + Lisp_Object found = Fassq (Qsqlite3, Vlibrary_cache); + + return CONSP (found) && EQ (XCDR (found), Qt); +} +#endif /* WINDOWSNT */ + +static bool +init_sqlite_functions (void) +{ +#ifdef WINDOWSNT + if (sqlite_loaded_p ()) + return true; + else + { + HMODULE library; + + if (!(library = w32_delayed_load (Qsqlite3))) + { + message1 ("sqlite3 library not found"); + return false; + } + + if (! load_dll_functions (library)) + goto bad_library; + + Vlibrary_cache = Fcons (Fcons (Qsqlite3, Qt), Vlibrary_cache); + return true; + } + + bad_library: + Vlibrary_cache = Fcons (Fcons (Qsqlite3, Qnil), Vlibrary_cache); + + return false; +#else /* !WINDOWSNT */ + return true; +#endif /* !WINDOWSNT */ +} + + +static void +sqlite_free (void *arg) +{ + struct Lisp_Sqlite *ptr = (struct Lisp_Sqlite *)arg; + if (ptr->is_statement) + sqlite3_finalize (ptr->stmt); + else if (ptr->db) + sqlite3_close (ptr->db); + xfree (ptr->name); + xfree (ptr); +} + +static Lisp_Object +encode_string (Lisp_Object string) +{ + if (STRING_MULTIBYTE (string)) + return encode_string_utf_8 (string, Qnil, 0, Qt, Qt); + else + return string; +} + +static Lisp_Object +make_sqlite (bool is_statement, void *db, void *stmt, char *name) +{ + struct Lisp_Sqlite *ptr + = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Sqlite, PVEC_SQLITE); + ptr->is_statement = is_statement; + ptr->finalizer = sqlite_free; + ptr->db = db; + ptr->name = name; + ptr->stmt = stmt; + ptr->eof = false; + return make_lisp_ptr (ptr, Lisp_Vectorlike); +} + +static void +check_sqlite (Lisp_Object db, bool is_statement) +{ + init_sqlite_functions (); + CHECK_SQLITE (db); + if (is_statement && !XSQLITE (db)->is_statement) + xsignal1 (Qerror, build_string ("Invalid set object")); + else if (!is_statement && XSQLITE (db)->is_statement) + xsignal1 (Qerror, build_string ("Invalid database object")); + if (!is_statement && !XSQLITE (db)->db) + xsignal1 (Qerror, build_string ("Database closed")); + else if (is_statement && !XSQLITE (db)->db) + xsignal1 (Qerror, build_string ("Statement closed")); +} + +static int db_count = 0; + +DEFUN ("sqlite-open", Fsqlite_open, Ssqlite_open, 0, 1, 0, + doc: /* Open FILE as an sqlite database. +If FILE is nil, an in-memory database will be opened instead. */) + (Lisp_Object file) +{ + char *name; + init_sqlite_functions (); + + if (!NILP (file)) + { + CHECK_STRING (file); + name = xstrdup (SSDATA (Fexpand_file_name (file, Qnil))); + } + else + /* In-memory database. These have to have different names to + refer to different databases. */ + name = xstrdup (SSDATA (CALLN (Fformat, build_string (":memory:%d"), + make_int (++db_count)))); + + sqlite3 *sdb; + int ret = sqlite3_open_v2 (name, + &sdb, + SQLITE_OPEN_FULLMUTEX + | SQLITE_OPEN_READWRITE + | SQLITE_OPEN_CREATE + | (NILP (file) ? SQLITE_OPEN_MEMORY : 0) +#ifdef SQLITE_OPEN_URI + | SQLITE_OPEN_URI +#endif + | 0, NULL); + + if (ret != SQLITE_OK) + return Qnil; + + return make_sqlite (false, sdb, NULL, name); +} + +DEFUN ("sqlite-close", Fsqlite_close, Ssqlite_close, 1, 1, 0, + doc: /* Close the database DB. */) + (Lisp_Object db) +{ + check_sqlite (db, false); + sqlite3_close (XSQLITE (db)->db); + XSQLITE (db)->db = NULL; + return Qnil; +} + +/* Bind values in a statement like + "insert into foo values (?, ?, ?)". */ +static const char * +bind_values (sqlite3 *db, sqlite3_stmt *stmt, Lisp_Object values) +{ + sqlite3_reset (stmt); + int len; + if (VECTORP (values)) + len = ASIZE (values); + else + len = list_length (values); + + for (int i = 0; i < len; ++i) + { + int ret = SQLITE_MISMATCH; + Lisp_Object value; + if (VECTORP (values)) + value = AREF (values, i); + else + { + value = XCAR (values); + values = XCDR (values); + } + Lisp_Object type = Ftype_of (value); + + if (EQ (type, Qstring)) + { + Lisp_Object encoded = encode_string (value); + ret = sqlite3_bind_text (stmt, i + 1, + SSDATA (encoded), SBYTES (encoded), + NULL); + } + else if (EQ (type, Qinteger)) + { + if (BIGNUMP (value)) + ret = sqlite3_bind_int64 (stmt, i + 1, bignum_to_intmax (value)); + else + ret = sqlite3_bind_int64 (stmt, i + 1, XFIXNUM (value)); + } + else if (EQ (type, Qfloat)) + ret = sqlite3_bind_double (stmt, i + 1, XFLOAT_DATA (value)); + else if (NILP (value)) + ret = sqlite3_bind_null (stmt, i + 1); + else if (EQ (value, Qt)) + ret = sqlite3_bind_int (stmt, i + 1, 1); + else if (EQ (value, Qfalse)) + ret = sqlite3_bind_int (stmt, i + 1, 0); + else + return "invalid argument"; + + if (ret != SQLITE_OK) + return sqlite3_errmsg (db); + } + + return NULL; +} + +DEFUN ("sqlite-execute", Fsqlite_execute, Ssqlite_execute, 2, 3, 0, + doc: /* Execute a non-select SQL statement. +If VALUES is non-nil, it should be a list of values to bind when +executing a statement like + + insert into foo values (?, ?, ...) + +The number of affected rows is returned. */) + (Lisp_Object db, Lisp_Object query, Lisp_Object values) +{ + check_sqlite (db, false); + CHECK_STRING (query); + if (!(NILP (values) || CONSP (values) || VECTORP (values))) + xsignal1 (Qerror, build_string ("VALUES must be a list or a vector")); + + sqlite3 *sdb = XSQLITE (db)->db; + Lisp_Object retval = Qnil; + const char *errmsg = NULL; + Lisp_Object encoded = encode_string (query); + sqlite3_stmt *stmt = NULL; + + /* We only execute the first statement -- if there's several + (separated by a semicolon), the subsequent statements won't be + done. */ + int ret = sqlite3_prepare_v2 (sdb, SSDATA (encoded), -1, &stmt, NULL); + if (ret != SQLITE_OK) + { + if (stmt != NULL) + { + sqlite3_finalize (stmt); + sqlite3_reset (stmt); + } + + errmsg = sqlite3_errmsg (sdb); + goto exit; + } + + /* Bind ? values. */ + if (!NILP (values)) { + const char *err = bind_values (sdb, stmt, values); + if (err != NULL) + { + errmsg = err; + goto exit; + } + } + + ret = sqlite3_step (stmt); + sqlite3_finalize (stmt); + if (ret != SQLITE_OK && ret != SQLITE_DONE) + { + errmsg = sqlite3_errmsg (sdb); + goto exit; + } + + retval = make_fixnum (sqlite3_changes (sdb)); + + exit: + if (errmsg != NULL) + xsignal1 (Qerror, build_string (errmsg)); + + return retval; +} + +static Lisp_Object +row_to_value (sqlite3_stmt *stmt) +{ + int len = sqlite3_column_count (stmt); + Lisp_Object values = Qnil; + + for (int i = 0; i < len; ++i) + { + Lisp_Object v = Qnil; + + switch (sqlite3_column_type (stmt, i)) + { + case SQLITE_INTEGER: + v = make_int (sqlite3_column_int64 (stmt, i)); + break; + + case SQLITE_FLOAT: + v = make_float (sqlite3_column_double (stmt, i)); + break; + + case SQLITE_BLOB: + v = + code_convert_string_norecord + (make_string (sqlite3_column_blob (stmt, i), + sqlite3_column_bytes (stmt, i)), + Qutf_8, false); + break; + + case SQLITE_NULL: + v = Qnil; + break; + + case SQLITE_TEXT: + v = + code_convert_string_norecord + (make_string ((const char*)sqlite3_column_text (stmt, i), + sqlite3_column_bytes (stmt, i)), + Qutf_8, false); + break; + } + + values = Fcons (v, values); + } + + return Fnreverse (values); +} + +static Lisp_Object +column_names (sqlite3_stmt *stmt) +{ + Lisp_Object columns = Qnil; + int count = sqlite3_column_count (stmt); + for (int i = 0; i < count; ++i) + columns = Fcons (build_string (sqlite3_column_name (stmt, i)), columns); + + return Fnreverse (columns); +} + +DEFUN ("sqlite-select", Fsqlite_select, Ssqlite_select, 2, 4, 0, + doc: /* Select data from the database DB that matches QUERY. +If VALUES is non-nil, they are values that will be interpolated into a +parametrised statement. + +By default, the return value is a list where the first element is a +list of column names, and the rest of the elements are the matching data. + +RETURN-TYPE can be either nil (which means that the matching data +should be returned as a list of rows), or `full' (the same, but the +first element in the return list will be the column names), or `set', +which means that we return a set object that can be queried with +`sqlite-next' and other functions to get the data. */) + (Lisp_Object db, Lisp_Object query, Lisp_Object values, + Lisp_Object return_type) +{ + check_sqlite (db, false); + CHECK_STRING (query); + + if (!(NILP (values) || CONSP (values) || VECTORP (values))) + xsignal1 (Qerror, build_string ("VALUES must be a list or a vector")); + + sqlite3 *sdb = XSQLITE (db)->db; + Lisp_Object retval = Qnil; + const char *errmsg = NULL; + Lisp_Object encoded = encode_string (query); + + sqlite3_stmt *stmt = NULL; + int ret = sqlite3_prepare_v2 (sdb, SSDATA (encoded), SBYTES (encoded), + &stmt, NULL); + if (ret != SQLITE_OK) + { + if (stmt) + sqlite3_finalize (stmt); + + goto exit; + } + + /* Query with parameters. */ + if (!NILP (values)) + { + const char *err = bind_values (sdb, stmt, values); + if (err != NULL) + { + sqlite3_finalize (stmt); + errmsg = err; + goto exit; + } + } + + /* Return a handle to get the data. */ + if (EQ (return_type, Qset)) + { + retval = make_sqlite (true, db, stmt, XSQLITE (db)->name); + goto exit; + } + + /* Return the data directly. */ + Lisp_Object data = Qnil; + while ((ret = sqlite3_step (stmt)) == SQLITE_ROW) + data = Fcons (row_to_value (stmt), data); + + if (EQ (return_type, Qfull)) + retval = Fcons (column_names (stmt), Fnreverse (data)); + else + retval = Fnreverse (data); + sqlite3_finalize (stmt); + + exit: + if (errmsg != NULL) + xsignal1 (Qerror, build_string (errmsg)); + + return retval; +} + +static Lisp_Object +sqlite_exec (sqlite3 *sdb, const char *query) +{ + int ret = sqlite3_exec (sdb, query, NULL, NULL, NULL); + if (ret != SQLITE_OK) + return Qnil; + + return Qt; +} + +DEFUN ("sqlite-transaction", Fsqlite_transaction, Ssqlite_transaction, 1, 1, 0, + doc: /* Start a transaction in DB. */) + (Lisp_Object db) +{ + check_sqlite (db, false); + return sqlite_exec (XSQLITE (db)->db, "begin"); +} + +DEFUN ("sqlite-commit", Fsqlite_commit, Ssqlite_commit, 1, 1, 0, + doc: /* Commit a transaction in DB. */) + (Lisp_Object db) +{ + check_sqlite (db, false); + return sqlite_exec (XSQLITE (db)->db, "commit"); +} + +DEFUN ("sqlite-rollback", Fsqlite_rollback, Ssqlite_rollback, 1, 1, 0, + doc: /* Roll back a transaction in DB. */) + (Lisp_Object db) +{ + check_sqlite (db, false); + return sqlite_exec (XSQLITE (db)->db, "rollback"); +} + +DEFUN ("sqlite-load-extension", Fsqlite_load_extension, + Ssqlite_load_extension, 2, 2, 0, + doc: /* Load a an SQlite module into DB. +MODULE should be the file name of an SQlite module .so file. */) + (Lisp_Object db, Lisp_Object module) +{ + check_sqlite (db, false); + CHECK_STRING (module); + + sqlite3 *sdb = XSQLITE (db)->db; + int result = sqlite3_load_extension (sdb, + SSDATA (Fexpand_file_name (module, Qnil)), + NULL, NULL); + if (result == SQLITE_OK) + return Qt; + return Qnil; +} + +DEFUN ("sqlite-next", Fsqlite_next, Ssqlite_next, 1, 1, 0, + doc: /* Return the next result set from SET. */) + (Lisp_Object set) +{ + check_sqlite (set, true); + + int ret = sqlite3_step (XSQLITE (set)->stmt); + if (ret != SQLITE_ROW && ret != SQLITE_OK && ret != SQLITE_DONE) + xsignal1 (Qerror, build_string (sqlite3_errmsg (XSQLITE (set)->db))); + + if (ret == SQLITE_DONE) + { + XSQLITE (set)->eof = true; + return Qnil; + } + + return row_to_value (XSQLITE (set)->stmt); +} + +DEFUN ("sqlite-columns", Fsqlite_columns, Ssqlite_columns, 1, 1, 0, + doc: /* Return the column names of SET. */) + (Lisp_Object set) +{ + check_sqlite (set, true); + return column_names (XSQLITE (set)->stmt); +} + +DEFUN ("sqlite-more-p", Fsqlite_more_p, Ssqlite_more_p, 1, 1, 0, + doc: /* Say whether there's any further results in SET. */) + (Lisp_Object set) +{ + check_sqlite (set, true); + + if (XSQLITE (set)->eof) + return Qnil; + else + return Qt; +} + +DEFUN ("sqlite-finalize", Fsqlite_finalize, Ssqlite_finalize, 1, 1, 0, + doc: /* Mark this SET as being finished. +This will free the resources held by SET. */) + (Lisp_Object set) +{ + check_sqlite (set, true); + sqlite3_finalize (XSQLITE (set)->stmt); + return Qt; +} + +#endif /* HAVE_SQLITE3 */ + +DEFUN ("sqlitep", Fsqlitep, Ssqlitep, 1, 1, 0, + doc: /* Say whether OBJECT is an SQlite object. */) + (Lisp_Object object) +{ +#ifdef HAVE_SQLITE3 + return SQLITE (object)? Qt: Qnil; +#else + return Qnil; +#endif +} + +DEFUN ("sqlite-available-p", Fsqlite_available_p, Ssqlite_available_p, 0, 0, 0, + doc: /* Return t if sqlite3 support is available in this instance of Emacs.*/) + (void) +{ +#ifdef HAVE_SQLITE3 +# ifdef WINDOWSNT + Lisp_Object found = Fassq (Qsqlite3, Vlibrary_cache); + if (CONSP (found)) + return XCDR (found); + else + { + Lisp_Object status; + status = init_sqlite_functions () ? Qt : Qnil; + Vlibrary_cache = Fcons (Fcons (Qsqlite3, status), Vlibrary_cache); + return status; + } +# else + return Qt; +#endif +#else + return Qnil; +#endif +} + +void +syms_of_sqlite (void) +{ +#ifdef HAVE_SQLITE3 + defsubr (&Ssqlite_open); + defsubr (&Ssqlite_close); + defsubr (&Ssqlite_execute); + defsubr (&Ssqlite_select); + defsubr (&Ssqlite_transaction); + defsubr (&Ssqlite_commit); + defsubr (&Ssqlite_rollback); + defsubr (&Ssqlite_load_extension); + defsubr (&Ssqlite_next); + defsubr (&Ssqlite_columns); + defsubr (&Ssqlite_more_p); + defsubr (&Ssqlite_finalize); + DEFSYM (Qset, "set"); + DEFSYM (Qfull, "full"); +#endif + defsubr (&Ssqlitep); + DEFSYM (Qsqlitep, "sqlitep"); + defsubr (&Ssqlite_available_p); + DEFSYM (Qfalse, "false"); + DEFSYM (Qsqlite, "sqlite"); + DEFSYM (Qsqlite3, "sqlite3"); +} diff --git a/test/src/sqlite-tests.el b/test/src/sqlite-tests.el new file mode 100644 index 0000000000..3fffa0100b --- /dev/null +++ b/test/src/sqlite-tests.el @@ -0,0 +1,175 @@ +;;; sqlite-tests.el --- Tests for sqlite.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'ert) +(require 'ert-x) + +(ert-deftest sqlite-select () + (skip-unless (sqlite-available-p)) + (let ((db (sqlite-open))) + (should (eq (type-of db) 'sqlite)) + (should (sqlitep db)) + (should-not (sqlitep 'foo)) + + (should + (zerop + (sqlite-execute + db "create table if not exists test1 (col1 text, col2 integer, col3 float, col4 blob)"))) + + (should-error + (sqlite-execute + db "insert into test1 (col1, col2, col3, col4) values ('foo', 2, 9.45, 'bar', 'zot')")) + + (should + (= + (sqlite-execute + db "insert into test1 (col1, col2, col3, col4) values ('foo', 2, 9.45, 'bar')") + 1)) + + (should + (equal + (sqlite-select db "select * from test1" nil 'full) + '(("col1" "col2" "col3" "col4") ("foo" 2 9.45 "bar")))))) + +;; (setq db (sqlite-open)) + +(ert-deftest sqlite-set () + (skip-unless (sqlite-available-p)) + (let ((db (sqlite-open)) + set) + (should + (zerop + (sqlite-execute + db "create table if not exists test1 (col1 text, col2 integer)"))) + + (should + (= + (sqlite-execute db "insert into test1 (col1, col2) values ('foo', 1)") + 1)) + (should + (= + (sqlite-execute db "insert into test1 (col1, col2) values ('bar', 2)") + 1)) + + (setq set (sqlite-select db "select * from test1" nil 'set)) + (should (sqlitep set)) + (should (sqlite-more-p set)) + (should (equal (sqlite-next set) + '("foo" 1))) + (should (equal (sqlite-next set) + '("bar" 2))) + (should-not (sqlite-next set)) + (should-not (sqlite-more-p set)))) + +(ert-deftest sqlite-chars () + (skip-unless (sqlite-available-p)) + (let (db) + (setq db (sqlite-open)) + (sqlite-execute + db "create table if not exists test2 (col1 text, col2 integer)") + (sqlite-execute + db "insert into test2 (col1, col2) values ('fóo', 3)") + (sqlite-execute + db "insert into test2 (col1, col2) values ('fó‚o', 3)") + (sqlite-execute + db "insert into test2 (col1, col2) values ('f‚o', 4)") + (should + (equal (sqlite-select db "select * from test2" nil 'full) + '(("col1" "col2") ("fóo" 3) ("fó‚o" 3) ("f‚o" 4)))))) + +(ert-deftest sqlite-numbers () + (skip-unless (sqlite-available-p)) + (let (db) + (setq db (sqlite-open)) + (sqlite-execute + db "create table if not exists test3 (col1 integer)") + (let ((big (expt 2 50)) + (small (expt 2 10))) + (sqlite-execute db (format "insert into test3 values (%d)" small)) + (sqlite-execute db (format "insert into test3 values (%d)" big)) + (should + (equal + (sqlite-select db "select * from test3") + (list (list small) (list big))))))) + +(ert-deftest sqlite-param () + (skip-unless (sqlite-available-p)) + (let (db) + (setq db (sqlite-open)) + (sqlite-execute + db "create table if not exists test4 (col1 text, col2 number)") + (sqlite-execute db "insert into test4 values (?, ?)" (list "foo" 1)) + (should + (equal + (sqlite-select db "select * from test4 where col2 = ?" '(1)) + '(("foo" 1)))) + (should + (equal + (sqlite-select db "select * from test4 where col2 = ?" [1]) + '(("foo" 1)))))) + +(ert-deftest sqlite-binary () + (skip-unless (sqlite-available-p)) + (let (db) + (setq db (sqlite-open)) + (sqlite-execute + db "create table if not exists test5 (col1 text, col2 number)") + (let ((string (with-temp-buffer + (set-buffer-multibyte nil) + (insert 0 1 2) + (buffer-string)))) + (should-not (multibyte-string-p string)) + (sqlite-execute + db "insert into test5 values (?, ?)" (list string 2)) + (let ((out (caar + (sqlite-select db "select col1 from test5 where col2 = 2")))) + (should (equal out string)))))) + +(ert-deftest sqlite-different-dbs () + (skip-unless (sqlite-available-p)) + (let (db1 db2) + (setq db1 (sqlite-open)) + (setq db2 (sqlite-open)) + (sqlite-execute + db1 "create table if not exists test6 (col1 text, col2 number)") + (sqlite-execute + db2 "create table if not exists test6 (col1 text, col2 number)") + (sqlite-execute + db1 "insert into test6 values (?, ?)" '("foo" 2)) + (should (sqlite-select db1 "select * from test6")) + (should-not (sqlite-select db2 "select * from test6")))) + +(ert-deftest sqlite-close-dbs () + (skip-unless (sqlite-available-p)) + (let (db) + (setq db (sqlite-open)) + (sqlite-execute + db "create table if not exists test6 (col1 text, col2 number)") + (sqlite-execute db "insert into test6 values (?, ?)" '("foo" 2)) + (should (sqlite-select db "select * from test6")) + (sqlite-close db) + (should-error (sqlite-select db "select * from test6")))) + +;;; sqlite-tests.el ends here commit af1c5ec0fcd3f25234cfe2986c873ff2e5ed63a0 Author: Lars Ingebrigtsen Date: Sat Dec 11 04:16:00 2021 +0100 Fix bibtex-biblatex-entry-alist sorting when using latex * lisp/textmodes/bibtex.el (bibtex-biblatex-entry-alist): Sort PhdThesis and TechReport correctly when using the latex variant (bug#52354). diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index c06e8bfa1b..2dd4e8e7af 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -839,6 +839,24 @@ for a new entry." ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4) ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5) ("url") ("urldate"))) + ("PhdThesis" "PhD Thesis" + (("author") + ("title" "Title of the PhD thesis") + ("school" "School where the PhD thesis was written") + ("year")) + nil + (("type" "Type of the PhD thesis") + ("address" "Address of the school (if not part of field \"school\") or country") + ("month") ("note"))) + ("TechReport" "Technical Report" + (("author") + ("title" "Title of the technical report (BibTeX converts it to lowercase)") + ("institution" "Sponsoring institution of the report") + ("year")) + nil + (("type" "Type of the report (if other than \"technical report\")") + ("number" "Number of the technical report") + ("address") ("month") ("note"))) ("Unpublished" "Unpublished" (("author") ("title") ("date" nil nil 1) ("year" nil nil -1)) nil commit c9cb59bc4f68d6050451bc0a619fd3eb6a6ed554 Author: Stefan Kangas Date: Fri Dec 10 15:47:09 2021 +0100 * etc/TODO: Entry about converting to defvar-keymap. diff --git a/etc/TODO b/etc/TODO index cd06b1ea26..22f5c09960 100644 --- a/etc/TODO +++ b/etc/TODO @@ -80,6 +80,10 @@ all interactive commands to see if they are only relevant in one particular mode. This requires care as some commands might be useful outside of the mode they were written for. +** Convert defvar foo-mode-map to defvar-keymap +Verify the conversion by comparing the value of the keymap before +converting it and after (you can see the value in 'C-h v'). + ** Write more tests Pick a fixed bug from the database, write a test case to make sure it stays fixed. Or pick your favorite programming major-mode, and write commit eba5cd3ca1acc581c4670e484ddc70a77d778192 Author: Stefan Kangas Date: Fri Dec 10 15:39:23 2021 +0100 ; * lisp/dired.el: Remove code commented out since 2000. diff --git a/lisp/dired.el b/lisp/dired.el index 4e2a32de67..b964fd9c18 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2066,12 +2066,6 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map ":v" 'epa-dired-do-verify) (define-key map ":s" 'epa-dired-do-sign) (define-key map ":e" 'epa-dired-do-encrypt) - - ;; No need to do this, now that top-level items are fewer. - ;;;; - ;; Get rid of the Edit menu bar item to save space. - ;;(define-key map [menu-bar edit] 'undefined) - map) "Local keymap for Dired mode buffers.") commit 9ccd3d323110cbb8f2a6f16655c241b5f42bbcbc Author: Stefan Kangas Date: Fri Dec 10 15:33:54 2021 +0100 Use defvar-keymap for package-menu-mode-map * lisp/emacs-lisp/package.el (package-menu-mode-map): Use defvar-keymap. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 66bbd631a7..de4cebccca 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2768,35 +2768,33 @@ either a full name or nil, and EMAIL is a valid email address." ;;;; Package menu mode. -(defvar package-menu-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map tabulated-list-mode-map) - (define-key map "\C-m" 'package-menu-describe-package) - (define-key map "u" 'package-menu-mark-unmark) - (define-key map "\177" 'package-menu-backup-unmark) - (define-key map "d" 'package-menu-mark-delete) - (define-key map "i" 'package-menu-mark-install) - (define-key map "U" 'package-menu-mark-upgrades) - (define-key map "r" 'revert-buffer) - (define-key map "~" 'package-menu-mark-obsolete-for-deletion) - (define-key map "w" 'package-browse-url) - (define-key map "x" 'package-menu-execute) - (define-key map "h" 'package-menu-quick-help) - (define-key map "H" #'package-menu-hide-package) - (define-key map "?" 'package-menu-describe-package) - (define-key map "(" #'package-menu-toggle-hiding) - (define-key map (kbd "/ /") 'package-menu-clear-filter) - (define-key map (kbd "/ a") 'package-menu-filter-by-archive) - (define-key map (kbd "/ d") 'package-menu-filter-by-description) - (define-key map (kbd "/ k") 'package-menu-filter-by-keyword) - (define-key map (kbd "/ N") 'package-menu-filter-by-name-or-description) - (define-key map (kbd "/ n") 'package-menu-filter-by-name) - (define-key map (kbd "/ s") 'package-menu-filter-by-status) - (define-key map (kbd "/ v") 'package-menu-filter-by-version) - (define-key map (kbd "/ m") 'package-menu-filter-marked) - (define-key map (kbd "/ u") 'package-menu-filter-upgradable) - map) - "Local keymap for `package-menu-mode' buffers.") +(defvar-keymap package-menu-mode-map + :doc "Local keymap for `package-menu-mode' buffers." + :parent tabulated-list-mode-map + "C-m" #'package-menu-describe-package + "u" #'package-menu-mark-unmark + "DEL" #'package-menu-backup-unmark + "d" #'package-menu-mark-delete + "i" #'package-menu-mark-install + "U" #'package-menu-mark-upgrades + "r" #'revert-buffer + "~" #'package-menu-mark-obsolete-for-deletion + "w" #'package-browse-url + "x" #'package-menu-execute + "h" #'package-menu-quick-help + "H" #'package-menu-hide-package + "?" #'package-menu-describe-package + "(" #'package-menu-toggle-hiding + "/ /" #'package-menu-clear-filter + "/ a" #'package-menu-filter-by-archive + "/ d" #'package-menu-filter-by-description + "/ k" #'package-menu-filter-by-keyword + "/ N" #'package-menu-filter-by-name-or-description + "/ n" #'package-menu-filter-by-name + "/ s" #'package-menu-filter-by-status + "/ v" #'package-menu-filter-by-version + "/ m" #'package-menu-filter-marked + "/ u" #'package-menu-filter-upgradable) (easy-menu-define package-menu-mode-menu package-menu-mode-map "Menu for `package-menu-mode'." commit 88ea736c351c5a44460dff0de03010e764b64ab8 Author: Stefan Kangas Date: Fri Dec 10 14:11:22 2021 +0100 ; * etc/NEWS: Improve recently added entry. diff --git a/etc/NEWS b/etc/NEWS index 0fee98d119..5285f526d4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -617,8 +617,9 @@ flagging an image in either the thumbnail or display buffer shows the next image. --- -*** Now shows image information in the header line. -This replaces the message shown at the bottom of the screen. +*** Image information is now shown in the header line. +This replaces the message most navigation commands in the thumbnail +buffer used to show at the bottom of the screen. +++ *** 'image-dired-show-all-from-dir-max-files' has been increased to 500. commit 79825f724f5d04820d154725f83186efaa2b90e8 Author: Lars Ingebrigtsen Date: Fri Dec 10 13:11:26 2021 +0100 Make keymap-lookup work for keymap results, too * lisp/keymap.el (keymap-lookup): Make this function work for non-symbol lookups, too (bug#52374). diff --git a/lisp/keymap.el b/lisp/keymap.el index 48f087c528..fd91689f88 100644 --- a/lisp/keymap.el +++ b/lisp/keymap.el @@ -411,9 +411,10 @@ specified buffer position instead of point are used." (error "Can't pass in both keymap and position")) (if keymap (let ((value (lookup-key keymap (key-parse key) accept-default))) - (when (and (not no-remap) + (if (and (not no-remap) (symbolp value)) - (or (command-remapping value) value))) + (or (command-remapping value) value) + value)) (key-binding (kbd key) accept-default no-remap position))) (defun keymap-local-lookup (keys &optional accept-default) commit 5708da48d1c7017b937e0fbfeb7de77bb3ba084e (refs/remotes/origin/emacs-28) Author: Lars Ingebrigtsen Date: Fri Dec 10 13:07:24 2021 +0100 Revert "Make `M-x run-python' select the window again" This reverts commit aa2872a12770282ede3548ed3fcab00c5a5b9f18. This led to a test failure. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 6357c4f2d3..f1c3e75bb7 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -2994,9 +2994,8 @@ killed." (mapconcat #'identity args " "))) (with-current-buffer buffer (inferior-python-mode)) + (when show (display-buffer buffer)) (and internal (set-process-query-on-exit-flag process nil)))) - (when show - (pop-to-buffer proc-buffer-name)) proc-buffer-name)))) ;;;###autoload @@ -3028,6 +3027,7 @@ process buffer for a list of commands.)" (python-shell-make-comint (or cmd (python-shell-calculate-command)) (python-shell-get-process-name dedicated) show))) + (set-buffer buffer) (get-buffer-process buffer))) (defun run-python-internal () commit aa2872a12770282ede3548ed3fcab00c5a5b9f18 Author: Kévin Le Gouguec Date: Fri Dec 10 13:05:49 2021 +0100 Make `M-x run-python' select the window again * lisp/progmodes/python.el (python-shell-make-comint): Make `M-x run-python' select the window again like in 27.2 (bug#52380). diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index f1c3e75bb7..6357c4f2d3 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -2994,8 +2994,9 @@ killed." (mapconcat #'identity args " "))) (with-current-buffer buffer (inferior-python-mode)) - (when show (display-buffer buffer)) (and internal (set-process-query-on-exit-flag process nil)))) + (when show + (pop-to-buffer proc-buffer-name)) proc-buffer-name)))) ;;;###autoload @@ -3027,7 +3028,6 @@ process buffer for a list of commands.)" (python-shell-make-comint (or cmd (python-shell-calculate-command)) (python-shell-get-process-name dedicated) show))) - (set-buffer buffer) (get-buffer-process buffer))) (defun run-python-internal () commit c8e19b3a8446b37faba44b04dce37b2c3b44e199 Author: Lars Ingebrigtsen Date: Fri Dec 10 12:46:55 2021 +0100 Don't bug out on certain empty elements with ids * lisp/net/shr.el (shr-descend): Fix empty-element #id targetting (bug#52391). diff --git a/lisp/net/shr.el b/lisp/net/shr.el index f33272fad8..48590fd675 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -605,7 +605,7 @@ size, and full-buffer size." (insert ? ) (shr-mark-fill start)) (put-text-property (1- (point)) (point) 'display "")) - (put-text-property start (1+ start) 'shr-target-id id)) + (put-text-property (1- (point)) (point) 'shr-target-id id)) ;; If style is set, then this node has set the color. (when style (shr-colorize-region commit e98ca32176871011451b04c0b952aef07d658f72 Author: Lars Ingebrigtsen Date: Fri Dec 10 12:32:49 2021 +0100 Make dired-buffers-for-dir expand the DIR argument * lisp/dired.el (dired-buffers-for-dir): Expand DIR argument (bug#52395). (dired-find-buffer-nocreate, dired-clean-up-after-deletion): Adjust callers. diff --git a/lisp/dired.el b/lisp/dired.el index d0e547ba0b..4e2a32de67 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1265,8 +1265,7 @@ The return value is the target column for the file names." ;; Don't try to find a wildcard as a subdirectory. (string-equal dirname (file-name-directory dirname))) (let* ((cur-buf (current-buffer)) - (buffers (nreverse - (dired-buffers-for-dir (expand-file-name dirname)))) + (buffers (nreverse (dired-buffers-for-dir dirname))) (cur-buf-matches (and (memq cur-buf buffers) ;; Wildcards must match, too: (equal dired-directory dirname)))) @@ -2967,7 +2966,7 @@ directories below DIR. The list is in reverse order of buffer creation, most recent last. As a side effect, killed dired buffers for DIR are removed from `dired-buffers'." - (setq dir (file-name-as-directory dir)) + (setq dir (file-name-as-directory (expand-file-name dir))) (let (result buf) (dolist (elt dired-buffers) (setq buf (cdr elt)) @@ -3518,7 +3517,7 @@ If the buffer has a wildcard pattern, check that it matches FILE. FILE may be nil, in which case ignore it. Return list of buffers where FUN succeeded (i.e., returned non-nil)." (let (success-list) - (dolist (buf (dired-buffers-for-dir (expand-file-name directory) file)) + (dolist (buf (dired-buffers-for-dir directory file)) (with-current-buffer buf (when (apply fun args) (push (buffer-name buf) success-list)))) @@ -3567,8 +3566,7 @@ confirmation. To disable the confirmation, see (file-name-nondirectory fn)))) (not dired-clean-confirm-killing-deleted-buffers)) (kill-buffer buf))) - (let ((buf-list (dired-buffers-for-dir (expand-file-name fn) - nil 'subdirs))) + (let ((buf-list (dired-buffers-for-dir fn nil 'subdirs))) (and buf-list (or (and dired-clean-confirm-killing-deleted-buffers (y-or-n-p