mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-11 09:20:51 +00:00
49910adf87
* lisp/sqlite-mode.el (require): * lisp/net/eudc.el (require): * lisp/arc-mode.el (require): Require subr-x, since these files are using macros from there. * lisp/emacs-lisp/subr-x.el (with-memoization): Move from here... * lisp/subr.el (with-memoization): ... to here, as it's used from the preloaded cl-generic.el file. * lisp/emacs-lisp/cl-generic.el (cl--generic-compiler): Don't use the autoloaded `byte-compile' function during bootstrap. (cl--generic-get-dispatcher): Don't require subr-x, either. cl-generic has been preloaded since 2015, and most usages of it (in preloaded files) work fine. In particular, using `cl-defgeneric' is unproblematic. However, `cl-defmethod' would end up pulling in the byte compiler (at load time), which would make it impossible to use `cl-defmethod' in pre-loaded files, and this change fixes that (but possibly not in the most self-evidently correct way).
226 lines
8.1 KiB
EmacsLisp
226 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)
|
|
(eval-when-compile (require 'subr-x))
|
|
|
|
(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
|