mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-21 06:55:39 +00:00
e4760109ac
* lisp/ansi-color.el (ansi-color--ensure-context): * lisp/doc-view.el (doc-view-svg-face): * lisp/external-completion.el (external-completion-table): * lisp/ffap.el (ffap-ro-mode-hook, ffap-gnus-hook): * lisp/find-file.el: * lisp/flow-ctrl.el (flow-control-c-s-replacement) (flow-control-c-q-replacement): * lisp/forms.el (forms-multi-line): * lisp/help.el (search-forward-help-for-help): * lisp/hi-lock.el (hi-lock-use-overlays): * lisp/image.el (find-image): * lisp/isearch.el (isearch-forward, isearch-forward-regexp) (isearch-lazy-count-format): * lisp/jsonrpc.el (jsonrpc--continue, initialize-instance): * lisp/mouse-copy.el (mouse-kill-preserving-secondary): * lisp/pixel-scroll.el (pixel-bob-at-top-p) (pixel-scroll-down-and-set-window-vscroll): * lisp/printing.el (pr-gv-command, pr-gs-command) (pr-gs-switches): * lisp/register.el (register-use-preview): * lisp/repeat.el (repeat-check-key): * lisp/saveplace.el (save-place-abbreviate-file-names): * lisp/select.el (gui--clipboard-selection-unchanged-p): * lisp/ses.el (ses-header-row): * lisp/simple.el (transpose-sexps-default-function) (normal-erase-is-backspace, normal-erase-is-backspace-mode): * lisp/sqlite-mode.el (sqlite-mode): * lisp/tempo.el (tempo-insert-region): * lisp/term.el (term-mode-map, term-mode, term-char-mode): Checkdoc fixes.
217 lines
8.0 KiB
EmacsLisp
217 lines
8.0 KiB
EmacsLisp
;;; sqlite-mode.el --- Mode for examining sqlite3 database files -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2021-2024 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")
|
|
(declare-function sqlite-close "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"))
|
|
(if (file-remote-p file)
|
|
(error "Remote SQLite files are not yet supported"))
|
|
(pop-to-buffer (get-buffer-create
|
|
(format "*SQLite %s*" (file-name-nondirectory file))))
|
|
(sqlite-mode)
|
|
(setq-local sqlite--db (sqlite-open file))
|
|
(unless (sqlitep sqlite--db)
|
|
(error "`sqlite-open' failed to open SQLite file"))
|
|
(add-hook 'kill-buffer-hook (lambda () (sqlite-close sqlite--db)) nil t)
|
|
(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 "^[^ \t]" 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."
|
|
(mapcar (lambda (row) (nth 1 row)) (sqlite-select sqlite--db (format "pragma table_info(%s)" table))))
|
|
|
|
(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
|