1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-23 07:19:15 +00:00
emacs/lisp/sqlite-mode.el
Yoav Marco 72b1007987 (sqlite-mode--column-names): Suppport nested parens
* lisp/sqlite-mode.el (sqlite-mode--column-names): Make parsing
more resilient (bug#55363).

Copyright-paperwork-exempt: yes
2022-05-11 14:05:37 +02:00

225 lines
8.1 KiB
EmacsLisp

;;; sqlite-mode.el --- Mode for examining sqlite3 database files -*- lexical-binding: t; -*-
;; Copyright (C) 2021-2022 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 <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'cl-lib)
(declare-function sqlite-execute "sqlite.c")
(declare-function sqlite-more-p "sqlite.c")
(declare-function sqlite-next "sqlite.c")
(declare-function sqlite-columns "sqlite.c")
(declare-function sqlite-finalize "sqlite.c")
(declare-function sqlite-select "sqlite.c")
(declare-function sqlite-open "sqlite.c")
(defvar-keymap sqlite-mode-map
"g" #'sqlite-mode-list-tables
"c" #'sqlite-mode-list-columns
"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))
(defvar sqlite--db nil)
;;;###autoload
(defun sqlite-mode-open-file (file)
"Browse the contents of an sqlite file."
(interactive "fSQLite file name: ")
(unless (sqlite-available-p)
(error "This Emacs doesn't have SQLite support, so it can't view SQLite files"))
(pop-to-buffer (get-buffer-create
(format "*SQLite %s*" (file-name-nondirectory file))))
(sqlite-mode)
(setq-local sqlite--db (sqlite-open file))
(sqlite-mode-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_master 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)
'table)
(goto-char (point-min))))
(defun sqlite-mode--tablify (columns rows type &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))
(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)
(put-text-property start (point) 'sqlite--type type)
(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)
"Return a list of the column names for TABLE."
(let ((sql
(caar
(sqlite-select
sqlite--db
"select sql from sqlite_master where tbl_name = ? AND type = 'table'"
(list table)))))
(with-temp-buffer
(insert sql)
(mapcar #'string-trim
(split-string
;; Extract the args to CREATE TABLE. Point is
;; currently at its end.
(buffer-substring
(1- (point)) ; right before )
(1+ (progn (backward-sexp) (point)))) ; right after (
",")))))
(defun sqlite-mode-list-data ()
"List the data from the table under point."
(interactive nil sqlite-mode)
(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 ((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 (list (car row) 0)))))))
(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 (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."
(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"))
(unless (yes-or-no-p "Really delete the row under point? ")
(user-error "Not deleting"))
(sqlite-execute
sqlite--db
(format "delete from %s where %s"
(cdr table)
(string-join
(mapcar (lambda (column)
(format "%s = ?" (car (split-string column " "))))
(cons "rowid" (sqlite-mode--column-names (cdr table))))
" and "))
row)
(delete-region (line-beginning-position) (progn (forward-line 1) (point)))))
(provide 'sqlite-mode)
;;; sqlite-mode.el ends here