├── .github └── FUNDING.yml ├── sql-workbench-pkg.el ├── Cask ├── ob-workbench.el ├── sqlcmd.el ├── company-swb.el ├── README.md ├── swb-iconnection.el ├── swb-connection-mysql.el ├── swb-connection-mssql.el └── sql-workbench.el /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | 3 | github: [Fuco1] 4 | patreon: matusgoljer 5 | ko_fi: matusgoljer 6 | custom: https://www.paypal.com/cgi-bin/webscr?cmd=_s-xclick&hosted_button_id=A5PMGVKCQBT88 7 | -------------------------------------------------------------------------------- /sql-workbench-pkg.el: -------------------------------------------------------------------------------- 1 | (define-package "sql-workbench" "0.0.1" "Org Mode powered DBMS workbench." 2 | '((hydra nil) 3 | (json-mode nil) 4 | (shut-up nil) 5 | (ov nil) 6 | (f nil) 7 | (s nil) 8 | (dash nil))) 9 | -------------------------------------------------------------------------------- /Cask: -------------------------------------------------------------------------------- 1 | (source gnu) 2 | (source melpa) 3 | 4 | (package "sql-workbench" "0.0.1" "Org Mode powered DBMS workbench.") 5 | 6 | (depends-on "dash") 7 | (depends-on "s") 8 | (depends-on "f") 9 | (depends-on "ov") 10 | (depends-on "shut-up") 11 | (depends-on "json-mode") 12 | (depends-on "hydra") 13 | -------------------------------------------------------------------------------- /ob-workbench.el: -------------------------------------------------------------------------------- 1 | (defvar org-babel-default-header-args:workbench 2 | `((:with-header . "no")) 3 | "Default arguments for evaluating a swb block.") 4 | 5 | (defun org-babel-execute:workbench (body params) 6 | (message "%s" params) 7 | (let ((query (org-babel-expand-body:sql body params)) 8 | (connection swb-connection) 9 | (with-header (equal "yes" (cdr (assq :with-header params))))) 10 | (swb-query-fetch-tuples connection query with-header))) 11 | 12 | (defvar org-babel-default-header-args:swb 13 | `((:results . "value")) 14 | "Default arguments for evaluating a swb block.") 15 | 16 | (defun org-babel-execute:swb (body params) 17 | (let* ((work-buffer (cdr (assoc :session params))) 18 | (connection (with-current-buffer work-buffer swb-connection)) 19 | (result nil) 20 | (result-buffer (generate-new-buffer "*result*"))) 21 | (with-current-buffer work-buffer 22 | (swb-query-format-result 23 | connection 24 | (swb--expand-columns-in-select-query (s-trim body)) 25 | result-buffer 26 | (lambda (status) 27 | (funcall (swb--result-callback connection body) status) 28 | (let ((raw-result 29 | (buffer-substring-no-properties 30 | (save-excursion 31 | (goto-char (point-min)) 32 | (forward-line) 33 | (point)) 34 | (save-excursion 35 | (goto-char (point-max)) 36 | (forward-line -1) 37 | (point))))) 38 | (setq result (org-table-to-lisp raw-result)))))) 39 | (while (not result) 40 | (sit-for 0.25)) 41 | (with-selected-window (get-buffer-window result-buffer) 42 | (if (< 0 (buffer-size (current-buffer))) 43 | (kill-buffer-and-window) 44 | (kill-buffer result-buffer))) 45 | result)) 46 | 47 | (provide 'ob-workbench) 48 | -------------------------------------------------------------------------------- /sqlcmd.el: -------------------------------------------------------------------------------- 1 | ;;; -*- lexical-binding: t -*- 2 | 3 | (require 'comint) 4 | 5 | (defun sqlcmd (host user password &optional database no-select no-display) 6 | (interactive 7 | (list (read-from-minibuffer "Host: " (swb--get-default-host)) 8 | (read-from-minibuffer "User: " (swb--get-default-user)) 9 | (read-passwd "Password: " nil (swb--get-default-password)) 10 | (read-from-minibuffer "Database: " (swb--get-default-database)))) 11 | (let* ((name (concat "sqlcmd-" (md5 (concat host user database)))) 12 | (buffer (get-buffer-create name))) 13 | (unless no-display 14 | (if no-select 15 | (display-buffer buffer) 16 | (pop-to-buffer buffer))) 17 | (with-current-buffer buffer 18 | (unless (comint-check-proc buffer) 19 | (let* ((extra (when database 20 | (list "-d" database)))) 21 | (apply 'make-comint-in-buffer 22 | name 23 | buffer 24 | "/opt/mssql-tools/bin/sqlcmd" 25 | nil 26 | "-S" 27 | host 28 | "-U" 29 | user 30 | "-P" 31 | password 32 | "-s" "|" 33 | extra) 34 | (sqlcmd-mode))) 35 | buffer))) 36 | 37 | (defvar sqlcmd-suppressed-output-sink-function nil) 38 | 39 | (defun sqlcmd-maybe-suppress-output (output) 40 | (if (and sqlcmd-suppressed-output-sink-function 41 | (let ((m (string-match-p comint-prompt-regexp output))) 42 | (or (not m) 43 | (not (= 0 m))))) 44 | (progn 45 | (when (functionp sqlcmd-suppressed-output-sink-function) 46 | (funcall sqlcmd-suppressed-output-sink-function output)) 47 | "") 48 | output)) 49 | 50 | (define-derived-mode sqlcmd-mode comint-mode "sql-cmd" 51 | "Major mode for the sqlcmd comint buffer." 52 | (setq comint-prompt-regexp (rx (1+ digit) (any "~" ">"))) 53 | (setq comint-process-echoes nil) 54 | (add-hook 'comint-preoutput-filter-functions 55 | 'sqlcmd-maybe-suppress-output 56 | nil t)) 57 | 58 | (provide 'sqlcmd) 59 | -------------------------------------------------------------------------------- /company-swb.el: -------------------------------------------------------------------------------- 1 | ;;; company-swb.el --- swb backend for company. -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2017 Matúš Goljer 4 | 5 | ;; Author: Matúš Goljer 6 | ;; Maintainer: Matúš Goljer 7 | ;; Version: 0.0.1 8 | ;; Created: 21st November 2016 9 | ;; Package-requires: ((dash "2.10.0") (s "1.5.0")) 10 | ;; Keywords: data 11 | 12 | ;; This program is free software; you can redistribute it and/or 13 | ;; modify it under the terms of the GNU General Public License 14 | ;; as published by the Free Software Foundation; either version 3 15 | ;; of the License, or (at your option) any later version. 16 | 17 | ;; This program is distributed in the hope that it will be useful, 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 | ;; GNU General Public License for more details. 21 | 22 | ;; You should have received a copy of the GNU General Public License 23 | ;; along with this program. If not, see . 24 | 25 | ;;; Commentary: 26 | 27 | ;; TODO: Better error handling (font-lock the error) 28 | 29 | ;;; Code: 30 | 31 | (require 'dash) 32 | (require 's) 33 | 34 | (require 'sql-workbench) 35 | 36 | (defun company-swb (command &optional arg &rest ignored) 37 | (interactive (list 'interactive)) 38 | (cl-case command 39 | (meta (company-swb--meta arg)) 40 | (sorted t) 41 | (annotation (company-swb--annotation arg)) 42 | (interactive (company-begin-backend 'company-swb)) 43 | (prefix (and (eq major-mode 'swb-mode) 44 | (company-grab-symbol))) 45 | (candidates (let* ((tables (swb--get-tables (swb-get-query-at-point))) 46 | (table-alias (save-excursion 47 | (backward-char (1+ (length arg))) 48 | (when (looking-at "\\.") 49 | (company-grab-symbol)))) 50 | (tables (or (--when-let (--first 51 | (equal (cadr it) table-alias) 52 | tables) 53 | (list it)) 54 | tables))) 55 | (--filter (string-prefix-p arg it) 56 | (-concat 57 | (-mapcat (-lambda ((table alias)) 58 | (--map (propertize 59 | it 'meta table) 60 | (swb-company-get-table-columns 61 | swb-connection 62 | table))) 63 | tables) 64 | ;; TODO: this is often invalid... we need 65 | ;; to decide by context if we want to add 66 | ;; all tables or only those in `tables' 67 | (unless table-alias 68 | (--map (propertize it 'meta "table") 69 | (swb-get-tables swb-connection))))))))) 70 | 71 | (defun company-swb--meta (candidate) 72 | (get-text-property 0 'meta candidate)) 73 | 74 | (defun company-swb--annotation (candidate) 75 | (format " (%s)" (get-text-property 0 'meta candidate))) 76 | 77 | (defun my-sql-get-context (sql position) 78 | (with-temp-buffer 79 | (insert sql) 80 | (goto-char position) 81 | (when (re-search-backward (regexp-opt 82 | (list 83 | "from" 84 | "join" 85 | "select" 86 | "delete" 87 | "insert" 88 | )) nil t) 89 | (let ((keyword (match-string 0))) 90 | (pcase keyword 91 | ("from" 1) 92 | ("join" 2) 93 | ("select" 3) 94 | ("delete" 4) 95 | ("insert" 5)))))) 96 | 97 | (provide 'company-swb) 98 | ;;; company-swb.el ends here 99 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # sql-workbench 2 | 3 | Working with SQL the convenient way! 4 | 5 | # Using sql-workbench 6 | 7 | Currently supported engines are MySQL and MSSQL (work in progress). 8 | The available features (non-exhaustive list): 9 | 10 | | Feature | MySQL | MSSQL | 11 | |--------------------------------|-------|-------| 12 | | Send queries | ✓ | ✓ | 13 | | Get column types and metadata | ✓ | ✓ | 14 | | Company-based autocompletion | ✓ | ✓ | 15 | | Quick data preview | ✓ | ❌ | 16 | | Describe table | ✓ | ✓ | 17 | | Show number of rows in a table | ✓ | ❌ | 18 | | Query for list of all tables | ✓ | ✓ | 19 | | Copy data from result buffer | ✓ | ✓ | 20 | 21 | ## Connecting to a server 22 | 23 | Run `M-x swb-new-workbench`. It will prompt for `engine` `host`, 24 | `port`, `user`, `password`, and the database name to use. 25 | 26 | The workbench buffer will open. 27 | 28 | ## Using the workbench buffer 29 | 30 | The workbench (source) buffer is the sql-workbench's main interface to 31 | the database. Here are some things you can do with it. 32 | 33 | * `swb-send-current-query` (`C-c C-c`) takes the sql statement at 34 | point and runs it on the database. The results will be displayed in 35 | the `*swb-results*` buffer. With `C-u` the result will be shown in 36 | a new permanent buffer, meaning it will not replace its content 37 | after a new query is run. With `C-0` the results will be inserted 38 | in-line into the source buffer. With `C-1` (experimental) a 39 | time-series graph will be inserted into the source buffer. This 40 | feature requires a working R installation with several packages, see 41 | the `swb-send-current-query` function help for info. 42 | 43 | * `swb-describe-table` (`C-c C-t`) prompts for a table name, and 44 | displays the table schema in the `*swb-results*` buffer. 45 | 46 | * `swb-show-data-in-table` (`C-c C-d`) prompts for a table name, and 47 | displays the first 500 entries in that table. 48 | 49 | Because the workbench buffer is just a regular buffer you can do all 50 | the usual things with it including saving it to a file and then 51 | reopening it later. It is also autosaved and backed up (if this is 52 | enabled) so you don't have to worry about losing your work. 53 | 54 | You can store the current connection information (except password) 55 | using `swb-store-connection-to-file` (`C-c C-s`). The information will 56 | be appended as [file-local 57 | variables](https://www.gnu.org/software/emacs/manual/html_node/emacs/File-Variables.html). 58 | Next time you open the file these will automatically become 59 | buffer-local. If you then execute a statement sql-workbench will 60 | automatically reconnect using the stored connection information. This 61 | makes resuming work between sessions super easy. 62 | 63 | If you customize the variable `swb-crypt-key` to be an email 64 | associated with a gpg key, the password will be also stored as 65 | encrypted base64-encoded string with this key set as recipient. 66 | 67 | ## Using the results buffer 68 | 69 | The results buffer uses `swb-result-mode` which is derived from 70 | `org-mode` and contains an Org Mode table. All the features of Org 71 | Mode (tables) therefore work automatically in the results buffer as 72 | well. However, the button is made read-only to prevent accidental 73 | change of the data. Consequently, some commands work without the `C-` 74 | or `C-c` prefixes for increased convenience. 75 | 76 | Use `f`, `b`, `n`, `p` (or arrow keys) for navigation, `j` to jump to 77 | a specific column. 78 | 79 | Use `s` to sort rows. The sorting happens "offline" in the result 80 | buffer only, not by querying the database server. 81 | 82 | `+` and `%` produce the sum or the average of the column or a region. 83 | 84 | `c` and `r` allow you to copy the column or row(s) in various formats, 85 | such as csv, php array, R tibble or SQL values. 86 | 87 | `g` will revert the buffer by running the same query again. 88 | 89 | For more information run `C-h m` in the result buffer and see the list 90 | of key bindings. 91 | 92 | # Integration with other packages 93 | 94 | ## company 95 | 96 | There is an experimental [company](http://company-mode.github.io/) backend `company-swb`. To enable it run 97 | 98 | (push 'company-swb company-backends) 99 | 100 | and then enable `M-x company-mode` in the swb buffer. 101 | -------------------------------------------------------------------------------- /swb-iconnection.el: -------------------------------------------------------------------------------- 1 | ;;; swb-iconnection.el --- Basic interface for talking to databases. 2 | 3 | ;; Copyright (C) 2015-2017 Matúš Goljer 4 | 5 | ;; Author: Matúš Goljer 6 | ;; Maintainer: Matúš Goljer 7 | ;; Version: 0.0.1 8 | ;; Created: 26th July 2015 9 | ;; Keywords: data 10 | 11 | ;; This program is free software; you can redistribute it and/or 12 | ;; modify it under the terms of the GNU General Public License 13 | ;; as published by the Free Software Foundation; either version 3 14 | ;; of the License, or (at your option) any later version. 15 | 16 | ;; This program is distributed in the hope that it will be useful, 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 | ;; GNU General Public License for more details. 20 | 21 | ;; You should have received a copy of the GNU General Public License 22 | ;; along with this program. If not, see . 23 | 24 | ;;; Commentary: 25 | 26 | ;; Here we define the interface for talking to databases. To support 27 | ;; a new database, it would be enough to implement all the required 28 | ;; methods. 29 | 30 | ;;; Code: 31 | 32 | (require 'eieio) 33 | 34 | (defclass swb-iconnection () 35 | ((host :initarg :host 36 | :initform "localhost" 37 | :type string 38 | :protection :protected 39 | :accessor swb-get-host 40 | :documentation 41 | "IP or URL where the database is located. 42 | Should not contain port number, use the `port' attribute for 43 | that.") 44 | (port :initarg :port 45 | :type integer 46 | :initform 3306 47 | :protection :protected 48 | :accessor swb-get-port 49 | :documentation "Port.") 50 | (user :initarg :user 51 | :type string 52 | :protection :protected 53 | :accessor swb-get-user 54 | :documentation "User.") 55 | (password :initarg :password 56 | :type string 57 | :protection :protected 58 | :documentation "Password.") 59 | (database :initarg :database 60 | :initform "" 61 | :type string 62 | :protection :protected 63 | :accessor swb-get-database 64 | :documentation "Database.") 65 | (engine :type string) 66 | (active-queries :initarg :activequeries 67 | :initform nil 68 | :protection :protected 69 | :accessor swb-get-active-queries 70 | :writer swb-set-active-queries 71 | :documentation "Actively running queries for this connection.")) 72 | :abstract t 73 | :documentation 74 | "Connection interface for work with the database.") 75 | 76 | (defmethod swb-prepare-cmd-args ((this swb-iconnection) query extra-args) 77 | "Prepare the argument list for the RDBS client process. 78 | 79 | THIS is an instance of `swb-iconnection'. 80 | 81 | QUERY is the query. 82 | 83 | EXTRA-ARGS are any extra arguments to pass to the process.") 84 | 85 | ;; TODO: show status in the mode line or header line somehow. The 86 | ;; sentinel can update it once the process is finished. 87 | (defmethod swb-query ((this swb-iconnection) query buffer &rest args) 88 | "Run a QUERY asynchronously. 89 | 90 | BUFFER is a buffer where the result is stored. 91 | 92 | ARGS is a plist with additional arguments: 93 | 94 | - :extra-args are extra arguments which should be passed to the 95 | underlying process.") 96 | 97 | (defmethod swb-query-synchronously ((this swb-iconnection) query buffer &rest args) 98 | "Run a QUERY synchronously. 99 | 100 | BUFFER is a buffer where the result is stored. 101 | 102 | ARGS is a plist with additional arguments: 103 | 104 | - :extra-args are extra arguments which should be passed to the 105 | underlying process.") 106 | 107 | (defmethod swb-query-format-result ((this swb-iconnection) query buffer &optional callback) 108 | "Run QUERY and format its result in a `swb-result-mode' compatible way. 109 | 110 | BUFFER is a buffer where the result is stored. 111 | 112 | The backend *must* make sure to run the CALLBACK function once 113 | the result is received in its entirety and properly rendered (as 114 | an org table). One option is to wrap it into the process 115 | sentinel code and call when the state changes to finished. 116 | 117 | The CALLBACK function takes one argument, t or nil indicating if 118 | the query ended successfully (t) or with an error (nil).") 119 | 120 | (defmethod swb-query-fetch-column ((this swb-iconnection) query) 121 | "Run QUERY and return a list of values. 122 | 123 | The query should return one column only. The resulting list is 124 | such that each successive element of the list represent nth row 125 | of the result set (= column). 126 | 127 | Data are retrieved synchronously.") 128 | 129 | (defmethod swb-query-fetch-one ((this swb-iconnection) query) 130 | "Run QUERY and return a value. 131 | 132 | The query should return one column and one row only. 133 | 134 | Data are retrieved synchronously." 135 | (car (swb-query-fetch-column this query))) 136 | 137 | (defmethod swb-query-fetch-tuples ((this swb-iconnection) query &optional with-header) 138 | "Run QUERY and return a list of tuples, one for each row. 139 | 140 | Each tuple contains as many elements as there were columns 141 | returned, in that order. 142 | 143 | Data are retrieved synchronously.") 144 | 145 | (defmethod swb-query-fetch-plist ((this swb-iconnection) query) 146 | "Run QUERY and return a list of plists, one for each row. 147 | 148 | Each plist has as key the symbol :column and as value the 149 | corresponding value. 150 | 151 | Data are retrieved synchronously.") 152 | 153 | (defmethod swb-query-fetch-alist ((this swb-iconnection) query) 154 | "Run QUERY and return a list of alists, one for each row. 155 | 156 | Each alist has as key the symbol `column' and as value the 157 | corresponding value. 158 | 159 | Data are retrieved synchronously.") 160 | 161 | ;; Helper methods 162 | 163 | (defmethod swb-get-databases ((this swb-iconnection)) 164 | "Return a list of databases available at this connection.") 165 | 166 | (defmethod swb-get-tables ((this swb-iconnection)) 167 | "Return a list of tables available at this connection in current database.") 168 | 169 | (defmethod swb-get-table-info ((this swb-iconnection) table) 170 | "Return information about TABLE. 171 | 172 | The returned data is backend specific." 173 | (swb-query-fetch-plist this (swb-get-table-info-query this table))) 174 | 175 | (defmethod swb-get-table-info-query ((this swb-iconnection) table) 176 | "Return the query which returns information about TABLE.") 177 | 178 | (defmethod swb-company-get-table-columns ((this swb-iconnection) table) 179 | (--map (plist-get it :Field) (swb-get-table-info this table))) 180 | 181 | (defmethod swb-connection-use-database ((this swb-iconnection) database) 182 | "Set DATABASE as default database for this connection" 183 | (oset this database database)) 184 | 185 | (defmethod swb-R-get-connection ((this swb-iconnection) &optional var) 186 | (let ((conf (format 187 | "list(user = %S, password = %S, host = %S, port = %S, dbname = %S)" 188 | (oref this user) 189 | (oref this password) 190 | (oref this host) 191 | (oref this port) 192 | (oref this database))) 193 | (var (or var "swb__con__"))) 194 | (format "%s <- rlang::invoke(dbConnect, c(MariaDB(), %s))" var conf))) 195 | 196 | (provide 'swb-iconnection) 197 | ;;; swb-iconnection.el ends here 198 | -------------------------------------------------------------------------------- /swb-connection-mysql.el: -------------------------------------------------------------------------------- 1 | ;;; swb-connection-mysql.el --- Implementation of connection for MySQL. -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2015-2017 Matúš Goljer 4 | 5 | ;; Author: Matúš Goljer 6 | ;; Maintainer: Matúš Goljer 7 | ;; Version: 0.0.1 8 | ;; Created: 26th July 2015 9 | ;; Keywords: data 10 | 11 | ;; This program is free software; you can redistribute it and/or 12 | ;; modify it under the terms of the GNU General Public License 13 | ;; as published by the Free Software Foundation; either version 3 14 | ;; of the License, or (at your option) any later version. 15 | 16 | ;; This program is distributed in the hope that it will be useful, 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 | ;; GNU General Public License for more details. 20 | 21 | ;; You should have received a copy of the GNU General Public License 22 | ;; along with this program. If not, see . 23 | 24 | ;;; Commentary: 25 | 26 | ;;; Code: 27 | 28 | (require 'dash) 29 | (require 's) 30 | 31 | (require 'eieio) 32 | (require 'swb-iconnection) 33 | 34 | ;; For the interactive sentinel 35 | (declare-function swb-result-mode "sql-workbench") 36 | (declare-function swb-result-forward-cell "sql-workbench") 37 | 38 | (defun swb-mysql--prepare-buffer (buffer) 39 | "Prepare BUFFER to receive the query results." 40 | (with-current-buffer buffer 41 | (read-only-mode -1) 42 | (erase-buffer) 43 | (set (make-local-variable 'font-lock-defaults) nil) 44 | (set (make-local-variable 'font-lock-keywords) nil))) 45 | 46 | (defun swb-mysql--fix-table-to-org-hline () 47 | "Replace the initial and terminal the + in the hline with |." 48 | (beginning-of-line) 49 | (delete-char 1) 50 | (insert "|") 51 | (end-of-line) 52 | (delete-char -1) 53 | (insert "|")) 54 | 55 | ;; Field 4: `name` 56 | ;; Catalog: `def` 57 | ;; Database: `test` 58 | ;; Table: `b` 59 | ;; Org_table: `users` 60 | ;; Type: VAR_STRING 61 | ;; Collation: utf8_general_ci (33) 62 | ;; Length: 765 63 | ;; Max_length: 11 64 | ;; Decimals: 0 65 | ;; Flags: NOT_NULL NO_DEFAULT_VALUE 66 | 67 | (defun swb-mysql--process-metadata (raw-metadata) 68 | "Parse metadata." 69 | (let (r) 70 | (with-temp-buffer 71 | (insert raw-metadata) 72 | (goto-char (point-min)) 73 | (while (re-search-forward "Field.*?`\\(.*?\\)`" nil t) 74 | (let ((name (match-string-no-properties 1)) 75 | (properties nil)) 76 | (re-search-forward "Database.*?`\\(.*?\\)`" nil t) 77 | (push :database properties) 78 | (push (match-string-no-properties 1) properties) 79 | (re-search-forward "Table.*?`\\(.*?\\)`" nil t) 80 | (push :table properties) 81 | (push (match-string-no-properties 1) properties) 82 | (re-search-forward "Org_Table.*?`\\(.*?\\)`" nil t) 83 | (push :original-table properties) 84 | (push (match-string-no-properties 1) properties) 85 | (re-search-forward "Type:[[:space:]]*\\(.*?\\)$" nil t) 86 | (push :type properties) 87 | (push (match-string-no-properties 1) properties) 88 | (re-search-forward "Flags:[ \t]*\\(.*?\\)$" nil t) 89 | (push :flags properties) 90 | (push (match-string-no-properties 1) properties) 91 | (push (cons name (nreverse properties)) r)))) 92 | (nreverse r))) 93 | 94 | (defun swb-mysql--format-result-sentinel (proc state callback) 95 | "Sentinel for PROC once its STATE is exit. 96 | 97 | Format the table so that it is a valid `org-mode' table. 98 | 99 | CALLBACK is called after the process has finished." 100 | ;; TODO: move this cleanup elsewhere, the display code could be 101 | ;; reused between backends 102 | (when (or (equal state "finished\n") 103 | (equal state "exited abnormally with code 1\n")) 104 | (with-current-buffer (process-buffer proc) 105 | (goto-char (point-min)) 106 | (delete-region (point) (search-forward "--------------" nil t 2)) 107 | (let* ((raw-metadata (progn 108 | (delete-region (point) (progn (skip-syntax-forward " ") (point))) 109 | (if (looking-at-p "^Field") 110 | (delete-and-extract-region 111 | (point) 112 | (save-excursion 113 | (when (re-search-forward "^+-" nil t) 114 | (backward-char 2)) 115 | (point))) 116 | "")))) 117 | (when (looking-at "^+-") 118 | (progn 119 | (swb-mysql--fix-table-to-org-hline) 120 | (forward-line 2) 121 | (when (looking-at "^+-") 122 | (swb-mysql--fix-table-to-org-hline)) 123 | (goto-char (point-max)) 124 | (when (re-search-backward "^+-" nil t) 125 | (swb-mysql--fix-table-to-org-hline)) 126 | (forward-line 1))) 127 | ;; here we can be looking at the 128 | ;; - Query OK 129 | ;; - ERROR 130 | ;; - [number] rows in set 131 | (cond 132 | ((looking-at-p "^[0-9]+ row") 133 | (message "%s" (delete-and-extract-region (point) (line-end-position)))) 134 | ((looking-at-p "^Query OK") 135 | (message "%s" (delete-and-extract-region (point) (line-end-position)))) 136 | ((looking-at-p "^ERROR") 137 | (message "%s" (delete-and-extract-region (point) (line-end-position))))) 138 | (delete-region (point) (point-max)) 139 | (setq-local swb-metadata 140 | (swb-mysql--process-metadata raw-metadata)) 141 | (when callback (funcall callback (equal state "finished\n"))))))) 142 | 143 | (defclass swb-connection-mysql (swb-iconnection) 144 | ((engine :type string :initform "mysql")) 145 | :documentation 146 | "Connection implementation for MySQL.") 147 | 148 | (defmethod swb-prepare-cmd-args ((connection swb-connection-mysql) query extra-args) 149 | (-concat extra-args 150 | (unless (member "-B" extra-args) 151 | (list "-vv")) 152 | (list "-A" 153 | "--column-type-info" 154 | "-e" query 155 | "-h" (oref connection host) 156 | "-P" (number-to-string (oref connection port)) 157 | "-u" (oref connection user) 158 | (concat "-p" (oref connection password))) 159 | (when (slot-boundp connection :database) 160 | (list (oref connection database)) ))) 161 | 162 | (defmethod swb-query ((this swb-connection-mysql) query buffer &rest args) 163 | (swb-mysql--prepare-buffer buffer) 164 | (let* ((cmd-args (swb-prepare-cmd-args this query (plist-get args :extra-args))) 165 | (proc (apply 'start-process "swb-query" buffer "mysql" cmd-args)) 166 | (sentinel (plist-get args :sentinel))) 167 | (when sentinel 168 | (set-process-sentinel proc sentinel)) 169 | buffer)) 170 | 171 | (defmethod swb-query-synchronously ((this swb-connection-mysql) query buffer &rest args) 172 | (swb-mysql--prepare-buffer buffer) 173 | (let* ((cmd-args (swb-prepare-cmd-args this query (plist-get args :extra-args)))) 174 | (apply 'call-process "mysql" nil buffer nil cmd-args) 175 | buffer)) 176 | 177 | ;; The sentinel is responsible for setting up proper state for the 178 | ;; result buffer, such as setting `swb-query' to the current query. 179 | (defmethod swb-query-format-result ((this swb-connection-mysql) query buffer &optional callback) 180 | (let ((active-queries (swb-get-active-queries this))) 181 | (push query active-queries) 182 | (swb-set-active-queries this active-queries) 183 | (swb-query this query buffer :extra-args '("-t") :sentinel 184 | (lambda (proc state) 185 | (swb-mysql--format-result-sentinel proc state callback))))) 186 | 187 | (defconst swb-mysql--batch-switches (list "-B" "-N" "--column-names") 188 | "Switch to toggle batch-mode.") 189 | 190 | (defmethod swb-query-fetch-column ((this swb-connection-mysql) query) 191 | (with-temp-buffer 192 | (swb-query-synchronously this query (current-buffer) :extra-args swb-mysql--batch-switches) 193 | (goto-char (point-min)) 194 | (while (looking-at-p "^mysql:") (kill-region (point) (1+ (line-end-position)))) 195 | (cdr (-map 's-trim (split-string (buffer-string) "\n" t))))) 196 | 197 | (defun swb-mysql--fetch-tuples-and-column-names (connection query) 198 | "Mysql helper for `swb-query-fetch-*'. 199 | 200 | Fetch data like `swb-query-fetch-tuples' but as the first item 201 | put a list of column names. 202 | 203 | CONNECTION is an instance of `swb-connection-mysql', QUERY is the 204 | SQL query." 205 | (with-temp-buffer 206 | (swb-query-synchronously connection query (current-buffer) :extra-args swb-mysql--batch-switches) 207 | (let* ((rows (--map (-map 's-trim (split-string it "\t" t)) (split-string (buffer-string) "\n" t)))) 208 | (-drop-while (-lambda ((car)) (and (stringp car) (string-prefix-p "mysql:" car))) rows)))) 209 | 210 | (defmethod swb-query-fetch-tuples ((this swb-connection-mysql) query &optional with-header) 211 | (let ((data (swb-mysql--fetch-tuples-and-column-names this query))) 212 | (if with-header data (cdr data)))) 213 | 214 | (defmethod swb-query-fetch-plist ((this swb-connection-mysql) query) 215 | (-let* (((columns . data) (swb-mysql--fetch-tuples-and-column-names this query)) 216 | (columns (--map (intern (concat ":" it)) columns))) 217 | (-map (lambda (row) 218 | (let (r) 219 | (-zip-with 220 | (lambda (name datum) 221 | (push name r) 222 | (push datum r)) 223 | columns row) 224 | (nreverse r))) 225 | data))) 226 | 227 | (defmethod swb-query-fetch-alist ((this swb-connection-mysql) query) 228 | (-let* (((columns . data) (swb-mysql--fetch-tuples-and-column-names this query)) 229 | (columns (--map (intern it) columns))) 230 | (-map (lambda (row) 231 | (let (r) 232 | (-zip-with 233 | (lambda (name datum) 234 | (push (cons name datum) r)) 235 | columns row) 236 | (nreverse r))) 237 | data))) 238 | 239 | (defmethod swb-get-databases ((this swb-connection-mysql)) 240 | (swb-query-fetch-column this "show databases;")) 241 | 242 | (defmethod swb-get-tables ((this swb-connection-mysql)) 243 | (swb-query-fetch-column this "show tables;")) 244 | 245 | (defmethod swb-get-table-info-query ((this swb-connection-mysql) table) 246 | (format "describe %s" table)) 247 | 248 | (defmethod swb-R-get-connection ((this swb-connection-mysql) &optional var) 249 | (let ((conf (format 250 | "list(user = %S, password = %S, host = %S, port = %S, dbname = %S)" 251 | (oref this user) 252 | (oref this password) 253 | (oref this host) 254 | (oref this port) 255 | (oref this database))) 256 | (var (or var "swb__con__"))) 257 | (format "%s <- rlang::invoke(dbConnect, c(MariaDB(), %s))" var conf))) 258 | 259 | (provide 'swb-connection-mysql) 260 | ;;; swb-connection-mysql.el ends here 261 | -------------------------------------------------------------------------------- /swb-connection-mssql.el: -------------------------------------------------------------------------------- 1 | ;;; swb-connection-mssql.el --- Implementation of connection for MSSQL. -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2021 Matúš Goljer 4 | 5 | ;; Author: Matúš Goljer 6 | ;; Maintainer: Matúš Goljer 7 | ;; Version: 0.0.1 8 | ;; Created: 21 January 2021 9 | ;; Keywords: data 10 | 11 | ;; This program is free software; you can redistribute it and/or 12 | ;; modify it under the terms of the GNU General Public License 13 | ;; as published by the Free Software Foundation; either version 3 14 | ;; of the License, or (at your option) any later version. 15 | 16 | ;; This program is distributed in the hope that it will be useful, 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 | ;; GNU General Public License for more details. 20 | 21 | ;; You should have received a copy of the GNU General Public License 22 | ;; along with this program. If not, see . 23 | 24 | ;;; Commentary: 25 | 26 | ;;; Code: 27 | 28 | (require 'dash) 29 | (require 's) 30 | 31 | (require 'eieio) 32 | (require 'swb-iconnection) 33 | (require 'swb-connection-mysql) 34 | (require 'sqlcmd) 35 | 36 | (defclass swb-connection-mssql (swb-iconnection) 37 | ((engine :type string :initform "mssql") 38 | (comint :initform nil) 39 | (prev-database :type string :initform "")) 40 | :documentation 41 | "Connection implementation for MSSQL.") 42 | 43 | (defun swb-mssql--process-metadata (metadata) 44 | (with-temp-buffer 45 | (insert metadata) 46 | (swb-mssql--sqlcmd-table-to-org-table (current-buffer)) 47 | (-let* ((data (-remove-item 'hline (org-table-to-lisp))) 48 | ((header . items) data) 49 | (header (--map (intern (concat ":" it)) header)) 50 | (raw-plist (--map (-interleave header it) items))) 51 | (--map (-cons* 52 | (plist-get it :name) 53 | :type 54 | (plist-get it :system_type_name) 55 | it) 56 | raw-plist)))) 57 | 58 | (defun swb-mssql--sqlcmd-table-to-org-table (buffer) 59 | "Format the sqlcmd table output as `org-mode' table. 60 | 61 | BUFFER is the buffer with the raw query output" 62 | (with-current-buffer buffer 63 | (goto-char (point-min)) 64 | (insert "|-\n") 65 | (while (re-search-forward "^" nil t) (insert "|")) 66 | (goto-char (point-max)) 67 | (re-search-backward "rows affected" nil t) 68 | (forward-line -1) 69 | (delete-region (point) (point-max)) 70 | (goto-char (point-max)) 71 | (insert "|-") 72 | (goto-char (point-min)) 73 | (forward-line 3) 74 | (org-table-align) 75 | ;; We call `org-table-align' twice because first call only fixes 76 | ;; the table whereas the second call also minimizes the column 77 | ;; widths. 78 | (org-table-align))) 79 | 80 | (defun swb-mssql--format-result-buffer (buffer callback) 81 | "Callback from the comint output filter to process the result. 82 | 83 | This is called on the raw query output after all the output was 84 | received." 85 | (with-current-buffer buffer 86 | (if (save-excursion 87 | (goto-char (point-min)) 88 | (looking-at-p "Msg ")) 89 | (if (= (save-excursion (goto-char (point-max)) (line-number-at-pos)) 2) 90 | (progn 91 | (goto-char (point-min)) 92 | (message (buffer-substring (line-beginning-position) (line-end-position)))) 93 | (display-buffer buffer)) 94 | ;; this is the first "n rows affected" for inserting the 95 | ;; sp_describe_first_result_set result into a temporary table 96 | (delete-region 97 | (point-min) 98 | (save-excursion 99 | (goto-char (point-min)) 100 | (re-search-forward "rows affected" nil t) 101 | (forward-line 1) 102 | (point))) 103 | (let ((data (delete-and-extract-region 104 | (point-min) 105 | (save-excursion 106 | (goto-char (point-min)) 107 | (re-search-forward "rows affected" nil t) 108 | (forward-line 1) 109 | (point))))) 110 | (setq-local swb-metadata (swb-mssql--process-metadata data))) 111 | (swb-mssql--sqlcmd-table-to-org-table (current-buffer)) 112 | (when callback (funcall callback t))))) 113 | 114 | (defun swb--mssql-send-query (query &optional sink get-metadata) 115 | "Send QUERY to the current-buffer's process. 116 | 117 | The `current-buffer' is assumed to be derived from `comint-mode'. 118 | 119 | If SINK is non-nil, set it as 120 | `sqlcmd-suppressed-output-sink-function'. It is assumed to be a 121 | function and it is called from `sqlcmd-maybe-suppress-output' 122 | every time input is received until it is unset or set to nil." 123 | (setq-local sqlcmd-suppressed-output-sink-function (or sink t)) 124 | (comint-send-string 125 | (get-buffer-process (current-buffer)) 126 | (format 127 | "%sDECLARE @query nvarchar(max) = \"%s\";%s 128 | EXEC sp_executesql @query; 129 | go" 130 | (if get-metadata 131 | "drop table if exists #swb_query_meta; 132 | create table #swb_query_meta (is_hidden bit NOT NULL, column_ordinal int NOT NULL, name sysname NULL, is_nullable bit NOT NULL, system_type_id int NOT NULL, system_type_name nvarchar(256) NULL, max_length smallint NOT NULL, precision tinyint NOT NULL, scale tinyint NOT NULL, collation_name sysname NULL, user_type_id int NULL, user_type_database sysname NULL, user_type_schema sysname NULL, user_type_name sysname NULL, assembly_qualified_type_name nvarchar(4000), xml_collection_id int NULL, xml_collection_database sysname NULL, xml_collection_schema sysname NULL, xml_collection_name sysname NULL, is_xml_document bit NOT NULL, is_case_sensitive bit NOT NULL, is_fixed_length_clr_type bit NOT NULL, source_server sysname NULL, source_database sysname NULL, source_schema sysname NULL, source_table sysname NULL, source_column sysname NULL, is_identity_column bit NULL, is_part_of_unique_key bit NULL, is_updateable bit NULL, is_computed_column bit NULL, is_sparse_column_set bit NULL, ordinal_in_order_by_list smallint NULL, order_by_list_length smallint NULL, order_by_is_descending smallint NULL, tds_type_id int NOT NULL, tds_length int NOT NULL, tds_collation_id int NULL, tds_collation_sort_id tinyint NULL);\n" 133 | "") 134 | (replace-regexp-in-string "\"" "\"\"" query) 135 | (if get-metadata 136 | "\ninsert #swb_query_meta EXEC sp_describe_first_result_set @query, null, 0; 137 | select name, system_type_name from #swb_query_meta; 138 | drop table #swb_query_meta" 139 | ""))) 140 | (comint-send-input nil t)) 141 | 142 | (defun swb--mssql-create-comint-maybe (connection) 143 | "Maybe (re)connect CONNECTION or recreate it if its parameters change." 144 | (when (or (not (equal (oref connection prev-database) 145 | (oref connection database))) 146 | (not (oref connection comint)) 147 | (not (buffer-live-p (oref connection comint))) 148 | (not (get-buffer-process (oref connection comint)))) 149 | (when (oref connection comint) 150 | (kill-buffer (oref connection comint))) 151 | (oset connection prev-database (oref connection database)) 152 | (oset connection comint 153 | (sqlcmd 154 | (oref connection host) 155 | (oref connection user) 156 | (oref connection password) 157 | (unless (string-empty-p (oref connection database)) 158 | (oref connection database)) 159 | nil 'no-display)))) 160 | 161 | (defmethod swb-query ((this swb-connection-mssql) query buffer &rest args) 162 | (swb--mssql-create-comint-maybe this) 163 | (swb-mysql--prepare-buffer buffer) 164 | (let ((comint (oref this comint)) 165 | (sentinel (plist-get args :sentinel))) 166 | (with-current-buffer comint 167 | (swb--mssql-send-query 168 | query 169 | (lambda (output) 170 | (with-current-buffer buffer 171 | (insert output) 172 | (save-excursion 173 | (goto-char (point-max)) 174 | (beginning-of-line) 175 | (when (and sentinel 176 | (looking-at-p "1> ")) 177 | (funcall sentinel))))) 178 | 'get-metadata)) 179 | buffer)) 180 | 181 | (defmethod swb-query-synchronously ((this swb-connection-mssql) query buffer &rest args) 182 | (swb--mssql-create-comint-maybe this) 183 | (swb-mysql--prepare-buffer buffer) 184 | (let ((comint (oref this comint)) 185 | (done nil)) 186 | (with-current-buffer comint 187 | (swb--mssql-send-query 188 | query 189 | (lambda (output) 190 | (with-current-buffer buffer 191 | (insert output) 192 | (save-excursion 193 | (goto-char (point-max)) 194 | (beginning-of-line) 195 | (when (looking-at-p "1> ") 196 | (setq done t))))))) 197 | (while (not done) 198 | (sleep-for 0.01)) 199 | buffer)) 200 | 201 | (defmethod swb-query-format-result ((this swb-connection-mssql) query buffer &optional callback) 202 | (let ((active-queries (swb-get-active-queries this))) 203 | (push query active-queries) 204 | (swb-set-active-queries this active-queries) 205 | (swb-query this query buffer 206 | :sentinel 207 | (lambda () 208 | (swb-mssql--format-result-buffer buffer callback))))) 209 | 210 | (defmethod swb-query-fetch-column ((this swb-connection-mssql) query) 211 | (let ((data (swb-query-fetch-plist this query))) 212 | (--map (cadr it) data))) 213 | 214 | (defmethod swb-query-fetch-tuples ((this swb-connection-mssql) query &optional with-header) 215 | (let* ((plists (swb-query-fetch-plist this query)) 216 | (data (--map (-map 'cadr (-partition 2 it)) plists)) 217 | (header (-map (lambda (x) (substring (symbol-name (car x)) 1)) 218 | (-partition 2 (car plists))))) 219 | (if with-header 220 | (cons header data) 221 | data))) 222 | 223 | (defmethod swb-query-fetch-plist ((this swb-connection-mssql) query) 224 | (with-temp-buffer 225 | (swb-query-synchronously this query (current-buffer)) 226 | (swb-mssql--sqlcmd-table-to-org-table (current-buffer)) 227 | (goto-char (point-min)) 228 | (-let* ((data (-remove-item 'hline (org-table-to-lisp))) 229 | ((header . items) data) 230 | (header (--map (intern (concat ":" it)) header))) 231 | (--map (-interleave header it) items)))) 232 | 233 | (defmethod swb-get-databases ((this swb-connection-mssql)) 234 | (swb-query-fetch-column this "SELECT name FROM sys.databases;")) 235 | 236 | (defmethod swb-get-tables ((this swb-connection-mssql)) 237 | (swb-query-fetch-column this "SELECT TABLE_NAME FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_TYPE='BASE TABLE';")) 238 | 239 | (defmethod swb-get-table-info-query ((this swb-connection-mssql) table) 240 | (format 241 | "SELECT 242 | c.Column_Name as [Field], 243 | MAX(c.DATA_TYPE) as [Type], 244 | MAX(c.IS_NULLABLE) as [Null], 245 | STRING_AGG(tc.Constraint_Type, ', ') as [Key], 246 | MAX(c.COLUMN_DEFAULT) as [Default] 247 | FROM 248 | INFORMATION_SCHEMA.COLUMNS c 249 | LEFT JOIN 250 | INFORMATION_SCHEMA.CONSTRAINT_COLUMN_USAGE ccu on ( 251 | c.Column_Name = ccu.Column_Name AND 252 | c.Table_Name = ccu.Table_Name 253 | ) 254 | LEFT JOIN 255 | INFORMATION_SCHEMA.TABLE_CONSTRAINTS tc on ( 256 | ccu.Constraint_Name = tc.Constraint_Name AND 257 | ccu.Table_Name = tc.Table_Name 258 | ) 259 | WHERE 260 | c.Table_Name = '%s' 261 | GROUP BY c.Column_Name, c.ordinal_position 262 | order by c.ordinal_position;" 263 | table)) 264 | 265 | (defmethod swb-R-get-connection ((this swb-connection-mssql) &optional var) 266 | (let ((conf (format 267 | "list(uid = %S, pwd = %S, server = %S, port = %S, database = %S, driver = \"ODBC Driver 17 for SQL Server\")" 268 | (oref this user) 269 | (oref this password) 270 | (oref this host) 271 | (oref this port) 272 | (oref this database))) 273 | (var (or var "swb__con__"))) 274 | (format "%s <- rlang::invoke(dbConnect, c(odbc::odbc(), %s))" var conf))) 275 | 276 | (provide 'swb-connection-mssql) 277 | ;;; swb-connection-mssql.el ends here 278 | -------------------------------------------------------------------------------- /sql-workbench.el: -------------------------------------------------------------------------------- 1 | ;;; sql-workbench.el --- Org Mode powered DBMS workbench. -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2015-2021 Matúš Goljer 4 | 5 | ;; Author: Matúš Goljer 6 | ;; Maintainer: Matúš Goljer 7 | ;; Version: 0.0.1 8 | ;; Created: 21st July 2015 9 | ;; Keywords: data 10 | 11 | ;; This program is free software; you can redistribute it and/or 12 | ;; modify it under the terms of the GNU General Public License 13 | ;; as published by the Free Software Foundation; either version 3 14 | ;; of the License, or (at your option) any later version. 15 | 16 | ;; This program is distributed in the hope that it will be useful, 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 | ;; GNU General Public License for more details. 20 | 21 | ;; You should have received a copy of the GNU General Public License 22 | ;; along with this program. If not, see . 23 | 24 | ;;; Commentary: 25 | 26 | ;;; Code: 27 | 28 | (require 'dash) 29 | (require 's) 30 | (require 'f) 31 | (require 'ov) 32 | (require 'shut-up) 33 | (require 'json-mode) 34 | (require 'hydra) 35 | 36 | (require 'sql) 37 | (require 'org) 38 | (require 'org-table) 39 | (require 'org-src) 40 | (require 'epg) 41 | (require 'ob-workbench) 42 | 43 | (require 'swb-connection-mysql) 44 | (require 'swb-connection-mssql) 45 | 46 | 47 | ;;; Workbench mode 48 | (defgroup sql-workbench () 49 | "Org Mode powered DBMS workbench." 50 | :group 'data 51 | :prefix "swb-") 52 | 53 | (defcustom swb-header-line-format '(" " 54 | (:eval 55 | (if (swb-iconnection-child-p swb-connection) 56 | (concat (swb-get-user swb-connection) 57 | "@" (swb-get-host swb-connection) 58 | ":" (number-to-string (swb-get-port swb-connection)) 59 | " -- " (swb-get-database swb-connection)) 60 | "No connection")) 61 | " " 62 | (:eval 63 | (when (swb-iconnection-child-p swb-connection) 64 | (-when-let (queries (swb-get-active-queries swb-connection)) 65 | (concat 66 | "Active queries: " 67 | (mapconcat 68 | (lambda (x) 69 | (format "[%s]" (s-trim x))) 70 | queries " ")))))) 71 | "The format expression for sql-workbench's header line. 72 | 73 | Has the same format as `mode-line-format'." 74 | :type 'sexp 75 | :group 'sql-workbench) 76 | (put 'swb-header-line-format 'risky-local-variable t) 77 | 78 | (defcustom swb-show-data-row-page-size 500 79 | "How many rows should we retrieve with `swb-show-data-in-table'. 80 | 81 | This number represents a \"page\" of data. Each additional page 82 | loaded loads this many rows." 83 | :type 'integer 84 | :group 'sql-workbench) 85 | 86 | (defcustom swb-crypt-key nil 87 | "Encryption key used for saving passwords in the workbench files." 88 | :type '(choice 89 | (const :tag "No encryption" nil) 90 | (string :tag "Recipient")) 91 | :group 'sql-workbench) 92 | 93 | ;; These four exist to mirror file-local variables storing the 94 | ;; connection info. 95 | (defvar swb-host nil "String determining host.") 96 | (defvar swb-port nil "Number determining port.") 97 | (defvar swb-user nil "String determining user.") 98 | (defvar swb-database nil "String determining database.") 99 | (defvar swb-password nil "Base64 encoded gpg encrypted password.") 100 | (defvar swb-engine nil "Database engine.") 101 | 102 | (put 'swb-host 'safe-local-variable #'stringp) 103 | (put 'swb-port 'safe-local-variable #'stringp) 104 | (put 'swb-user 'safe-local-variable #'stringp) 105 | (put 'swb-database 'safe-local-variable #'stringp) 106 | (put 'swb-password 'safe-local-variable #'stringp) 107 | (put 'swb-engine 'safe-local-variable #'stringp) 108 | 109 | ;; TODO: move these state variables into a defstruct. 110 | ;; TODO: remove this variable? 111 | (defvar swb-result-buffer nil 112 | "Result buffer for this workbench.") 113 | (defvar swb-count 0 ;; only makes sense for the "data" views. 114 | "Number of items in the current table.") 115 | (defvar swb-connection nil 116 | "Connection to the server for this workbench.") 117 | ;; TOOD: make this into a ring. 118 | (defvar swb-query nil 119 | "Last executed query for this result buffer.") 120 | (defvar swb-metadata nil 121 | "Metadata for the last returned result set. 122 | 123 | The format is a list of lists where each item has a form (NAME 124 | . PLIST-META), with the `car' NAME being a string column name and 125 | `cdr' PLIST-META is a plist with additional information. 126 | 127 | The minimal implementation should contain at east the name and 128 | the type of the columns, that is (name :type type). 129 | 130 | See also `swb-get-metadata'.") 131 | (put 'swb-metadata 'permanent-local t) 132 | 133 | (defun swb--get-default-engine () 134 | "Get default engine for this buffer. 135 | 136 | First look if there is a connection. If so, reuse. 137 | 138 | Then look at the local variable `swb-engine'. 139 | 140 | If nothing is found, return nil." 141 | (cond 142 | ((swb-iconnection-child-p swb-connection) 143 | (oref swb-connection engine)) 144 | (swb-engine) 145 | (t nil))) 146 | 147 | (defun swb--get-default-host () 148 | "Get default host for this buffer. 149 | 150 | First look if there is a connection. If so, reuse. 151 | 152 | Then look at the local variable `swb-host'. 153 | 154 | If nothing is found, return nil." 155 | (cond 156 | ((swb-iconnection-child-p swb-connection) 157 | (swb-get-host swb-connection)) 158 | (swb-host) 159 | (t nil))) 160 | 161 | (defun swb--get-default-port () 162 | "Get default port for this buffer. 163 | 164 | First look if there is a connection. If so, reuse. 165 | 166 | Then look at the local variable `swb-port'. 167 | 168 | If nothing is found, return nil." 169 | (cond 170 | ((swb-iconnection-child-p swb-connection) 171 | (swb-get-port swb-connection)) 172 | (swb-port (string-to-number swb-port)) 173 | (t nil))) 174 | 175 | (defun swb--get-default-user () 176 | "Get default user for this buffer. 177 | 178 | First look if there is a connection. If so, reuse. 179 | 180 | Then look at the local variable `swb-user'. 181 | 182 | If nothing is found, return nil." 183 | (cond 184 | ((swb-iconnection-child-p swb-connection) 185 | (swb-get-user swb-connection)) 186 | (swb-user) 187 | (t nil))) 188 | 189 | (defun swb--get-default-password () 190 | "Get default password for this buffer. 191 | 192 | First look if there is a connection. If so, reuse. 193 | 194 | Then look at the local variable `swb-password'. 195 | 196 | If nothing is found, return nil." 197 | (cond 198 | ((swb-iconnection-child-p swb-connection) 199 | (oref swb-connection password)) 200 | (swb-password 201 | (let* ((encrypted-text (base64-decode-string swb-password))) 202 | (setq-local epg-context (epg-make-context nil t t)) 203 | (decode-coding-string 204 | (epg-decrypt-string 205 | epg-context 206 | encrypted-text) 207 | 'utf-8))) 208 | (t nil))) 209 | 210 | (defun swb--get-default-database () 211 | "Get default database for this buffer. 212 | 213 | First look if there is a connection. If so, reuse. 214 | 215 | Then look at the local variable `swb-database'. 216 | 217 | If nothing is found, return nil." 218 | (cond 219 | ((swb-iconnection-child-p swb-connection) 220 | (swb-get-database swb-connection)) 221 | (swb-database) 222 | (t nil))) 223 | 224 | (defun swb--read-connection () 225 | "Read connection data. 226 | 227 | CONNECTION-CONSTRUCTOR is a constructor to create temporary 228 | connection when we query for the list of database." 229 | (let* ((engine (completing-read "Engine: " (list "mysql" "mssql") nil t 230 | (swb--get-default-engine))) 231 | (constructor (swb--get-connection-constructor engine)) 232 | (host (read-from-minibuffer "Host: " (swb--get-default-host))) 233 | (port (read-from-minibuffer "Port: " (--when-let (swb--get-default-port) (number-to-string it)))) 234 | (user (read-from-minibuffer "User: " (swb--get-default-user))) 235 | (password (read-passwd "Password: " nil (swb--get-default-password))) 236 | (database (completing-read "Database: " 237 | (swb-get-databases 238 | (funcall constructor "temp" :host host :port (string-to-number port) :user user :password password)) 239 | nil t nil nil (swb--get-default-database)))) 240 | (list engine host (string-to-number port) user password database))) 241 | 242 | (defun swb--get-connection-constructor (engine) 243 | "Get function to construct a connection object. 244 | 245 | ENGINE is the RDBS engine name." 246 | (intern (concat "swb-connection-" engine))) 247 | 248 | ;; TODO: add a list of named predefined connections I could pick 249 | ;; instead of host (like an alias which would expand to the other 250 | ;; settings) 251 | ;; TODO: make this generic/connection type independent 252 | (defun swb-reconnect (engine host port user password database) 253 | "Reconnect this workbench. 254 | 255 | ENGINE, HOST, PORT, USER, PASSWORD and DATABASE are connection details." 256 | (interactive (swb--read-connection)) 257 | (let* ((constructor (swb--get-connection-constructor engine)) 258 | (connection (funcall constructor (buffer-name) :host host :port port :user user :password password :database database))) 259 | (set (make-local-variable 'swb-connection) connection))) 260 | 261 | (defun swb-maybe-connect () 262 | "If there is no active conncetion, try to (re)connect." 263 | (unless swb-connection 264 | (call-interactively 'swb-reconnect))) 265 | 266 | (defun swb-clone () 267 | "Clone this workbench. 268 | 269 | Open new clean workbench with the same connection details." 270 | (interactive) 271 | (let* ((buffer-name (generate-new-buffer-name "*swb-workbench*")) 272 | (connection (clone swb-connection))) 273 | ;; TODO: abstract this piece and the same code in swb-new-workbench-mysql 274 | (with-current-buffer (get-buffer-create buffer-name) 275 | (swb-mode) 276 | (set (make-local-variable 'swb-connection) connection) 277 | (pop-to-buffer (current-buffer))))) 278 | 279 | 280 | (defalias 'swb-new-workbench 'swb-new-workbench-mysql) 281 | 282 | (defun swb-new-workbench-mysql (engine host port user password database) 283 | "Create new mysql workbench. 284 | 285 | ENGINE, HOST, PORT, USER, PASSWORD and DATABASE are connection details." 286 | (interactive (swb--read-connection)) 287 | (let* ((buffer-name (generate-new-buffer-name "*swb-workbench*"))) 288 | (with-current-buffer (get-buffer-create buffer-name) 289 | (swb-mode) 290 | (swb-reconnect engine host port user password database) 291 | (pop-to-buffer (current-buffer))))) 292 | 293 | 294 | (defun swb-get-query-bounds-at-point () 295 | "Get the bounds of query at point." 296 | (let ((beg (save-excursion 297 | (condition-case _err 298 | (progn 299 | (while (not (and (re-search-backward ";") 300 | (not (nth 4 (syntax-ppss)))))) 301 | (1+ (point))) 302 | (error (point-min))))) 303 | (end (save-excursion 304 | (condition-case _err 305 | (progn 306 | (while (not (and (re-search-forward ";") 307 | (not (nth 4 (syntax-ppss)))))) 308 | (point)) 309 | (error (point-max)))))) 310 | ;; scan all the org elements from beg and if there is any 311 | ;; non-paragraph element move the beg after it 312 | (save-excursion 313 | (goto-char beg) 314 | (while (< (point) end) 315 | (let ((el (org-element-at-point))) 316 | (when (not (eq (org-element-type el) 'paragraph)) 317 | (setq beg (org-element-property :end el))) 318 | (goto-char (org-element-property :end el))))) 319 | (cons beg end))) 320 | 321 | (defun swb--get-tables (sql) 322 | "Get the tables mentioned in SQL query." 323 | (let ((keywords (concat 324 | "[^`]\\_<" 325 | (regexp-opt 326 | (list "where" "order" "group" "join" "set" "limit")) "\\_>")) 327 | (all-tables nil)) 328 | (with-temp-buffer 329 | (insert sql) 330 | ;; get tables from `from' 331 | (goto-char (point-min)) 332 | (-when-let (beg (re-search-forward 333 | (regexp-opt (list "from" "update") 'symbols) 334 | nil t)) 335 | (-when-let (end (or (when (re-search-forward keywords nil t) 336 | (match-beginning 0)) 337 | (point-max))) 338 | (let* ((tables (buffer-substring-no-properties beg end)) 339 | (tables (replace-regexp-in-string "[`;]" "" tables)) 340 | (tables (split-string tables ",")) 341 | (tables (-map 's-trim tables)) 342 | (tables (--map (split-string it " \\(as\\)?" t) tables))) 343 | (setq all-tables (-concat all-tables tables))))) 344 | ;; get tables from `join' 345 | (goto-char (point-min)) 346 | (catch 'swb-join-done 347 | (while t 348 | (-if-let (beg (re-search-forward 349 | (regexp-opt (list "join") 'symbols) 350 | nil t)) 351 | (-when-let (end (or (when (re-search-forward 352 | (regexp-opt (list "on" "where" "using") 'symbols) nil t) 353 | (match-beginning 0)) 354 | (point-max))) 355 | (let* ((tables (buffer-substring-no-properties beg end)) 356 | (tables (replace-regexp-in-string "[`;]" "" tables)) 357 | (tables (split-string tables ",")) 358 | (tables (-map 's-trim tables)) 359 | (tables (--map (split-string it " \\(as\\)?" t) tables))) 360 | (setq all-tables (-concat all-tables tables)))) 361 | (throw 'swb-join-done t)))) 362 | (goto-char (point-min)) 363 | (-when-let (beg (re-search-forward "alter +table +" nil t)) 364 | (skip-syntax-forward " ") 365 | (setq all-tables (-concat all-tables (list (list (symbol-name (symbol-at-point)))))))) 366 | all-tables)) 367 | 368 | (defun swb--get-query-columns-from-query (query) 369 | "Get columns in the projection part of a select QUERY. 370 | 371 | If QUERY is not a select, return nil." 372 | (with-temp-buffer 373 | (insert query) 374 | (goto-char (point-min)) 375 | (when (search-forward "select " nil t) 376 | (let ((start (point))) 377 | (when-let ((end (when (search-forward "from " nil t) 378 | (forward-char -5) 379 | (point)))) 380 | (-map 's-trim (s-split "," (buffer-substring-no-properties start end)))))))) 381 | 382 | (defun swb--expand-columns-in-select-query (query) 383 | "Expand columns in the projection part of a select QUERY. 384 | 385 | A simple star-expansion is available: a single star will match 386 | any sequence of characters. The star can be at the sides or in 387 | the middle of a column, multiple stars are supported. 388 | 389 | Examples: 390 | 391 | results has columns: 392 | - id 393 | - amount_result 394 | - amount_user 395 | - total_result 396 | - user_name 397 | - user_name_short 398 | 399 | select *result from results; -- => amount_result, total_result 400 | 401 | select amount_* from results; -- => amount_result, amount_user 402 | 403 | select id, *name* from results; -- => id, user_name, user_name_short" 404 | (if (string-match-p "\\`select.*" query) 405 | (let* ((tables (swb--get-tables query)) 406 | (columns (-mapcat (-lambda ((table alias)) 407 | (--map (propertize 408 | (plist-get it :Field) 409 | 'meta table) 410 | (swb-query-fetch-plist 411 | swb-connection 412 | (format "describe %s" table)))) 413 | tables)) 414 | (query-columns (swb--get-query-columns-from-query query))) 415 | (concat 416 | "select " 417 | (mapconcat 418 | (lambda (column) 419 | (or (and (string-match-p "\\*" column) 420 | (not (string-match-p "^\\(.*?\\.\\)?\\*" column)) 421 | (not (string-match-p "(\\*)" column)) 422 | (s-join ", " (--filter (string-match-p 423 | (replace-regexp-in-string "\\*" ".*" column) 424 | it) 425 | columns))) 426 | column)) 427 | query-columns 428 | ", ") 429 | " " 430 | (progn 431 | (string-match "\\(?:.\\|\n\\)*\\(from \\(.\\|\n\\)*\\)" query) 432 | (match-string 1 query)))) 433 | query)) 434 | 435 | ;; TODO: this might be connection-specific too, so we should probably 436 | ;; move it to the class 437 | (defun swb-get-query-at-point () 438 | "Get query at point." 439 | (-let* (((beg . end) 440 | (if (region-active-p) 441 | (cons (region-beginning) (region-end)) 442 | (swb-get-query-bounds-at-point))) 443 | (q (buffer-substring-no-properties beg end)) 444 | (with-expanded-star (swb--expand-columns-in-select-query (s-trim q)))) 445 | (org-babel-expand-noweb-references 446 | `("sql" 447 | ,with-expanded-star 448 | ((:noweb . "yes")) 449 | "" nil beg "(ref:%s)")))) 450 | 451 | (defun swb-copy-query-at-point () 452 | "Copy query at point as new kill." 453 | (interactive) 454 | (let ((q (swb-get-query-at-point))) 455 | (kill-new q) 456 | (message "Copied 1 query"))) 457 | 458 | (defun swb--get-result-buffer () 459 | "Return the result buffer for this workbench." 460 | (if (buffer-live-p swb-result-buffer) 461 | swb-result-buffer 462 | (if (string-match-p "workbench" (buffer-name)) 463 | (get-buffer-create (replace-regexp-in-string "workbench" "result" (buffer-name))) 464 | (get-buffer-create (concat "*swb-result-" (buffer-name) "*"))))) 465 | 466 | (defun swb--remove-active-query (connection query) 467 | "Update CONNECTION by removing QUERY from active queries." 468 | ;; TODO: this should be done in the connection handler, 469 | ;; `swb-mysql--format-result-sentinel'. We can't do it right now 470 | ;; because the query is not know at that time in the mysql handler. 471 | ;; Create an object "query" to abstract this? 472 | (swb-set-active-queries 473 | connection 474 | (-remove-item query (swb-get-active-queries connection)))) 475 | 476 | (defun swb--result-as-graph (data metadata annotations) 477 | "Render DATA as a time-series graph. 478 | 479 | DATA is a data structure created with `org-table-to-lisp'. First 480 | non-empty row which is not 'hline is assumed to contain column 481 | names. This MUST be present. 482 | 483 | METADATA is an instance of `swb-metadata' describing the result 484 | set. 485 | 486 | ANNOTATIONS are parsed from the first comment before the query. 487 | The comment must have format 488 | 489 | -- :keyword value [:keyword value]* 490 | 491 | Supported annotations are: 492 | 493 | - :normalize-scale t/nil/string 494 | Normalize all observations to common scale. 495 | t => yes, pick first observation as base scale 496 | nil => [default] no 497 | string => name of the observation to be used as base scale 498 | 499 | - :fill t/nil/value 500 | Fill missing values. 501 | t => [default] fill missing (NULL) values with 0 502 | nil => do not fill any missing values 503 | value => fill missing (NULL) values with value 504 | 505 | 506 | Several heuristics are used to determine the index, key and 507 | observation columns. 508 | 509 | - Index column defines the time index of the time series, for 510 | example daily or monthly timestamps. We take the first column 511 | with database type date to be the index column. 512 | 513 | - The key index defines a unique time series and observation. 514 | One data table can contain multiple time series, for example 515 | determined by user_id. There, the combination of index (date) 516 | and user_id would uniquely identify a particular observation. 517 | The table can have multiple keys. 518 | 519 | We identify the keys as all columns ending with 520 | \"id\" (case-insensitive). 521 | 522 | - For the observations, any column which holds decimal, float or 523 | double data will be taken as observation. The table can have 524 | multiple observations. 525 | 526 | The plotting is done with the statistical software R, therefore 527 | this feature requires a present working installation of R in 528 | version at least 3.6. Several other packages are also necessary: 529 | 530 | - dplyr 531 | - tidyr 532 | - tsibble 533 | - ggplot2 534 | - fabletools 535 | - lubridate 536 | 537 | To install packages in R, first start the REPL by running \"R\" 538 | in the terminal, then run: 539 | 540 | install.packages(c(\"dplyr\", \"tidyr\", \"tsibble\", \"ggplot2\", \"fabletools\", \"lubridate\")) 541 | 542 | After the command finishes, you can exit the REPL by hitting C-d 543 | twice. When prompted to save workspace image, say no." 544 | (-let* ((graphics-file-name (make-temp-file "swb-ggplot-" nil ".png")) 545 | (code-file-name (make-temp-file "swb-ggplot-" nil ".R")) 546 | (data (-remove-item 'hline data)) 547 | ((header . items) data) 548 | (index (car (--first (string-match-p "date" (plist-get (cdr it) :type)) metadata))) 549 | (key-cols (-map 'car (--filter 550 | (and (string-match-p "int\\|bool\\|bit" (plist-get (cdr it) :type)) 551 | (string-match-p "id$" (car it))) 552 | metadata))) 553 | (ts-cols (-map 'car 554 | (--filter (string-match-p 555 | "decimal\\|float\\|double" 556 | (plist-get (cdr it) :type)) 557 | metadata))) 558 | (items (apply '-zip items)) 559 | (columns (--map-indexed 560 | (let ((type (plist-get (cdr (nth it-index metadata)) :type))) 561 | (format "%s = %sc(%s)%s" 562 | (car it) 563 | (if (string-match-p "date" type) 564 | "as.Date(" 565 | "") 566 | (mapconcat 567 | (lambda (x) 568 | (if (equal x "NULL") 569 | "NA" 570 | (cond 571 | ((string-match-p 572 | (regexp-opt '("date" "string" "varchar")) 573 | type) 574 | (format "%S" x)) 575 | (t x)))) 576 | (cdr it) ", ") 577 | (if (string-match-p "date" type) 578 | ")" 579 | ""))) 580 | (-zip header items))) 581 | (data-str (progn 582 | (message "Using %s as index and %s as keys. Observations are: %s" 583 | index 584 | (s-join ", " key-cols) 585 | (s-join ", " ts-cols)) 586 | (format 587 | "data <- tibble(%s) %%>%% select(%s) %%>%% pivot_longer(-c(%s)) %%>%% as_tsibble(index = \"%s\", key = c(%s))" 588 | (s-join ", " columns) 589 | (s-join ", " (append (list index) key-cols ts-cols)) 590 | (s-join ", " (append (list index) key-cols)) 591 | index 592 | (s-join ", " (--map (format "\"%s\"" it) (append key-cols (list "name"))))))) 593 | (rescale 594 | (-when-let (base-series 595 | (cond 596 | ((eq (plist-get annotations :normalize-scale) t) 597 | (car ts-cols)) 598 | ((stringp (plist-get annotations :normalize-scale)) 599 | (plist-get annotations :normalize-scale)))) 600 | (format 601 | "max_scale <- filter(data, name == \"%s\") %%>%% pull(value) %%>%% max(na.rm = T) 602 | data <- group_by(data, name) %%>%% mutate(value = value * max_scale / max(value, na.rm = T)) %%>%% ungroup" 603 | base-series))) 604 | (fill 605 | (-when-let (fill-value 606 | (cond 607 | ((not (plist-member annotations :fill)) 0) 608 | ((eq (plist-get annotations :fill) t) 0) 609 | ((numberp (plist-get annotations :fill)) 610 | (plist-get annotations :fill)))) 611 | (format 612 | "data <- fill_gaps(data, value = %s, .full = TRUE) 613 | data[is.na(data$value),]$value <- %s" 614 | fill-value 615 | fill-value)))) 616 | 617 | (unwind-protect 618 | (progn 619 | (f-write-text 620 | ;; ## plot <- ggplot(data) + geom_line(aes(x = %s, y = value, color = name)) 621 | (format " 622 | library(dplyr) 623 | library(tidyr) 624 | library(tsibble) 625 | library(ggplot2) 626 | library(fabletools) 627 | library(lubridate) 628 | 629 | index <- \"%s\" 630 | %s 631 | dates <- pull(data, {{index}}) 632 | if (all(dates == floor_date(dates, 'month'))) { 633 | data <- mutate(data, {{index}} := yearmonth(.data[[index]])) 634 | } 635 | 636 | %s 637 | %s 638 | 639 | plot <- autoplot(data, vars(value)) 640 | if (n_keys(data) > 10) { 641 | plot <- plot + theme(legend.position = \"none\") 642 | } 643 | ggsave(\"%s\", plot = plot, width = 10, height = 8, dpi = 300) 644 | " 645 | index 646 | data-str 647 | (or fill "") 648 | (or rescale "") 649 | graphics-file-name) 650 | 'utf-8 651 | code-file-name) 652 | (call-process "Rscript" nil nil nil code-file-name)) 653 | ;;(delete-file code-file-name) 654 | nil 655 | ) 656 | graphics-file-name)) 657 | 658 | (defun swb--result-callback (connection query &optional point source-buffer params) 659 | "Return a result callback. 660 | 661 | This callback should be called in the result buffer after it has 662 | received the result set and after this was properly formatted. 663 | 664 | CONNECTION is the connection of the server where the result was 665 | obtained from. 666 | 667 | QUERY is the query which produced this result. 668 | 669 | WARNING: calling this function does nothing except return another 670 | function." 671 | (lambda (status) 672 | (swb-result-mode) 673 | (setq-local swb-connection connection) 674 | (setq-local swb-query query) 675 | (swb--remove-active-query connection query) 676 | (goto-char (point-min)) 677 | (when (and status 678 | (< 0 (buffer-size (current-buffer)))) 679 | (let ((window (display-buffer (current-buffer))) 680 | (result-buffer (current-buffer))) 681 | (with-selected-window window 682 | ;; decide here if we want to inline the result or let it be 683 | ;; in a separate window 684 | (let* ((num-cols (length (swb--result-get-column-names))) 685 | (rows (save-excursion 686 | (org-table-goto-column 1) 687 | (swb--get-column-data))) 688 | (inlinep (and (= num-cols 1) 689 | (< (length rows) 8)))) 690 | (cond 691 | ((and source-buffer 692 | point 693 | (plist-get params :inline-table)) 694 | (with-current-buffer source-buffer 695 | (save-excursion 696 | (goto-char point) 697 | (-let (((_ . end) (swb-get-query-bounds-at-point))) 698 | (swb-clear-inline-result) 699 | (goto-char end) 700 | (forward-char) 701 | (insert (with-current-buffer result-buffer 702 | (org-font-lock-ensure) 703 | (let ((inhibit-read-only t) 704 | (pos (point-min)) 705 | next) 706 | (while (and (setq 707 | next 708 | (next-single-char-property-change pos 'face)) 709 | (< next (buffer-size))) 710 | (when-let ((new-prop (get-text-property pos 'face))) 711 | (put-text-property 712 | pos next 'font-lock-face new-prop)) 713 | (setq pos next)) 714 | (remove-text-properties 715 | (point-min) (point-max) 716 | '(face))) 717 | (buffer-string)))))) 718 | (kill-buffer-and-window)) 719 | ((and source-buffer 720 | point 721 | inlinep) 722 | (with-current-buffer source-buffer 723 | (save-excursion 724 | (goto-char point) 725 | (-let (((_ . end) (swb-get-query-bounds-at-point))) 726 | (swb-clear-inline-result) 727 | (goto-char end) 728 | (insert (format " -- => %s;" 729 | (let ((data (-map 's-trim (-flatten rows)))) 730 | (if (= (length rows) 1) 731 | (car data) 732 | (s-join ", " data)))))))) 733 | (kill-buffer-and-window)) 734 | ((and source-buffer 735 | point 736 | (plist-get params :inline-graph)) 737 | (delete-window) 738 | (with-current-buffer source-buffer 739 | (save-excursion 740 | (goto-char point) 741 | (-let* (((beg . end) (swb-get-query-bounds-at-point)) 742 | (annotations 743 | (save-excursion 744 | (goto-char beg) 745 | (catch 'done 746 | (while (< (point) end) 747 | (if (not (looking-at "^-- +:")) 748 | (forward-line 1) 749 | (goto-char (1- (match-end 0))) 750 | (let (items) 751 | (while (< (point) (line-end-position)) 752 | (push 753 | (read (current-buffer)) 754 | items) 755 | (skip-syntax-forward " ")) 756 | (throw 'done (nreverse items)))))))) 757 | (graph-file (with-current-buffer result-buffer 758 | (swb--result-as-graph 759 | (org-table-to-lisp) 760 | swb-metadata 761 | annotations))) 762 | (i (with-selected-window (get-buffer-window source-buffer) 763 | `(image :type imagemagick 764 | :file ,graph-file 765 | :margin 10 766 | :width ,(- (window-pixel-width) 20) 767 | :max-height ,(round (* (window-pixel-height) 0.8)))))) 768 | (swb-clear-inline-result) 769 | (goto-char end) 770 | (forward-line 1) 771 | (unless (looking-at-p "$") 772 | (insert "\n")) 773 | (insert-image i ";") 774 | (kill-buffer result-buffer))))) 775 | (t (set-window-point window (point-min)) 776 | (forward-line 3) 777 | (swb-result-forward-cell 1) 778 | ;; make sure there is no gap... this moves the point to the 779 | ;; 4th visible line of the window 780 | (recenter 4))))))))) 781 | 782 | (defun swb-clear-inline-result () 783 | (interactive) 784 | (-let (((_ . end) (swb-get-query-bounds-at-point))) 785 | ;; inline single-line result 786 | (save-excursion 787 | (goto-char end) 788 | (when (looking-at " -- => \\(.*\\);") 789 | (delete-region (point) (match-end 0))) 790 | ;; inline table result 791 | (goto-char end) 792 | (forward-char) 793 | (let ((element (org-element-at-point))) 794 | (when (eq (org-element-type element) 'table) 795 | (delete-region (org-element-property :begin element) 796 | (org-element-property :contents-end element)))) 797 | ;; graph result 798 | (goto-char end) 799 | (forward-line 1) 800 | (when (eq (car (get-text-property (point) 'display)) 'image) 801 | (delete-char 1))))) 802 | 803 | (defun swb-query-display-result (query buffer &optional point source-buffer params) 804 | "Display result of QUERY in BUFFER. 805 | 806 | POINT is current point in the workbench buffer. 807 | 808 | SOURCE-BUFFER is the workbench buffer (with queries). 809 | 810 | PARAMS is an additional plist with arbitrary key-value data 811 | interpreted by the result callback." 812 | (interactive) 813 | (swb-query-format-result 814 | swb-connection query buffer 815 | (swb--result-callback swb-connection query point source-buffer params))) 816 | 817 | ;; TODO: add something to send multiple queries (region/buffer). If a 818 | ;; region is active, send the region instead of the query. 819 | ;; TODO: figure out how to show progress bar (i.e. which query is being executed ATM) 820 | ;; TODO: warn before sending unsafe queries 821 | ;; TODO: add a version which replaces the SELECT clause with count(*) 822 | ;; so you can see only the number of results 823 | (defun swb-send-current-query (&optional arg) 824 | "Send the query under the cursor to the connection of current buffer. 825 | 826 | If the current part of a buffer has org-like syntax, try to run 827 | `org-ctrl-c-ctrl-c' first. This allows you to use `org-mode' 828 | checklists or source blocks within swb buffers. 829 | 830 | If raw ARG \\[universal-argument] is passed, display the result 831 | in a separate buffer. 832 | 833 | With ARG numeric prefix 0 (zero), show the result in-line in the 834 | source buffer. 835 | 836 | With ARG numeric prefix 1, generate a time-series graph of the 837 | result set. See `swb--result-as-graph' for details on how the 838 | graph is constructed and the prerequisites. This feature 839 | requires working R software installation. 840 | 841 | With ARG numeric prefix 2, send the current query to an R 842 | process, query for a variable name and store the result there. 843 | This assumes database driver packages for R for the current 844 | engine are installed." 845 | (interactive "P") 846 | (swb-maybe-connect) 847 | (condition-case err 848 | (with-syntax-table swb-org-syntax-table 849 | (org-ctrl-c-ctrl-c)) 850 | (error (let* ((raw (and (listp arg) (car arg))) 851 | (arg-num (prefix-numeric-value arg)) 852 | (buffer (if raw 853 | (generate-new-buffer "*result*") 854 | (swb--get-result-buffer))) 855 | (inline-table (= arg-num 0)) 856 | (inline-graph (and arg (= arg-num 1))) 857 | (query (swb-get-query-at-point))) 858 | (if (= arg-num 2) 859 | (let ((current-prefix-arg nil)) 860 | (call-interactively 'swb-R-send-current-query)) 861 | (swb-query-display-result 862 | query buffer (point) (current-buffer) 863 | (list :inline-table inline-table 864 | :inline-graph inline-graph))))))) 865 | 866 | (defun swb-R-send-connection (var) 867 | "Create an R database connection object for the current buffer." 868 | (interactive "sTarget variable: \n") 869 | (swb-maybe-connect) 870 | (let ((connection swb-connection) 871 | (ess-dialect "R")) 872 | (with-temp-buffer 873 | (insert (swb-R-get-connection connection var)) 874 | (ess-eval-region (point-min) (point-max) t)))) 875 | 876 | ;; TODO: add annotation parsing :as_tsibble and automatically 877 | ;; determine the index and interval column (extract this logic from 878 | ;; the graph code) 879 | (defun swb-R-send-current-query (var &optional arg) 880 | "Send current query to an R process." 881 | (interactive "sTarget variable: \nP") 882 | (swb-maybe-connect) 883 | (save-selected-window 884 | (let ((query (swb-get-query-at-point)) 885 | (connection swb-connection) 886 | (source-buffer (current-buffer)) 887 | (dialect ess-dialect) 888 | (local-process-name ess-local-process-name)) 889 | (with-temp-buffer 890 | (ess-r-mode) 891 | (insert 892 | (format " 893 | %s 894 | %s <- dbGetQuery(swb__con__, %S) %%>%% as_tibble 895 | dbDisconnect(swb__con__) 896 | " 897 | (substring-no-properties (swb-R-get-connection connection)) 898 | (substring-no-properties var) 899 | (substring-no-properties query))) 900 | (setq-local ess-dialect dialect) 901 | (setq-local ess-local-process-name local-process-name) 902 | (ess-eval-region (point-min) (point-max) t) 903 | (let ((dialect ess-dialect) 904 | (local-process-name ess-local-process-name)) 905 | (with-current-buffer source-buffer 906 | (setq-local ess-dialect dialect) 907 | (setq-local ess-local-process-name local-process-name)))))) 908 | (when arg 909 | (pop-to-buffer (ess-get-process-buffer)))) 910 | 911 | (defun swb--read-table () 912 | "Completing read for a table." 913 | (swb-maybe-connect) 914 | (let* ((tables (swb-get-tables swb-connection)) 915 | (default (or (--when-let (symbol-at-point) 916 | (let ((name (symbol-name it))) 917 | (when (member name tables) name))) 918 | (car tables)))) 919 | (completing-read "Table: " tables nil t nil nil default))) 920 | 921 | ;; TODO: open to new window when called with C-u 922 | ;; TODO: make this into a generic method 923 | ;; TODO: add an option to load additional pages of data 924 | ;; TODO: add an option to "hyperlink" to another table using the id at 925 | ;; point. For example, with a point at a column foreing_key of table 926 | ;; tags, we should run "select * from tags where foreing_key = 927 | ;; ". We should also ask for additional where 928 | ;; constraints if called with C-u? We should also support the 929 | ;; convention that foreign_table_id links to the column id in 930 | ;; foreign_table if it is not marked as foreign in the table. 931 | (defun swb-show-data-in-table (table) 932 | "Show data in TABLE. 933 | 934 | Limits to `swb-show-data-row-page-size' lines of output." 935 | (interactive (list (if (eq major-mode 'swb-result-mode) 936 | (plist-get (cdar swb-metadata) :original-table) 937 | (swb--read-table)))) 938 | (let ((query (format "SELECT * FROM `%s` LIMIT %d;" table swb-show-data-row-page-size)) 939 | (buffer (get-buffer-create (format "*data-%s*" table))) 940 | (connection swb-connection)) 941 | (swb-query-format-result 942 | connection query buffer 943 | (lambda (status) 944 | ;; Note: we don't need to keep a closure here because the outer 945 | ;; lambda already makes a closure. However, the function is 946 | ;; most often called directly to produce the callback closure 947 | ;; and not *from* another closure. Therefore, the code looks a 948 | ;; bit redundant here, but simplifies the call in most other 949 | ;; places. 950 | (funcall (swb--result-callback connection query) status) 951 | (setq-local swb-count 952 | (string-to-number 953 | (swb-query-fetch-one 954 | connection 955 | (format "SELECT COUNT(*) FROM `%s`;" table)))))))) 956 | 957 | (defun swb-show-number-of-rows-in-table (table) 958 | "Echo number of rows in TABLE." 959 | (interactive (list (swb--read-table))) 960 | (let ((n (swb-query-fetch-one 961 | swb-connection 962 | (format "SELECT COUNT(*) FROM `%s`;" table)))) 963 | (message "SWB: %s rows in %s" 964 | (propertize (swb-format-number n) 'face 'font-lock-constant-face) 965 | (propertize table 'face 'font-lock-comment-face)))) 966 | 967 | ;; TODO: add a version to get `show create table' 968 | ;; TODO: show index from shows more detailed information about 969 | ;; keys, maybe we could merge this and the `describe table' outputs 970 | ;; into one? 971 | ;; TODO: add "table editor", ideally from the describe window we 972 | ;; should be able to add columns and it should give us preview of 973 | ;; "alter table" code which we could then submit (and it would refresh 974 | ;; the description) 975 | (defun swb-describe-table (table) 976 | "Describe TABLE schema." 977 | (interactive (list (swb--read-table))) 978 | (swb-query-display-result 979 | (swb-get-table-info-query swb-connection table) 980 | (get-buffer-create (format "*schema-%s*" table)))) 981 | 982 | (defun swb-store-connection-to-file () 983 | "Store connection details as file-local variables." 984 | (interactive) 985 | (save-excursion 986 | (when (swb-iconnection-child-p swb-connection) 987 | (add-file-local-variable 'swb-host (swb-get-host swb-connection)) 988 | (add-file-local-variable 'swb-port (number-to-string (swb-get-port swb-connection))) 989 | (add-file-local-variable 'swb-user (swb-get-user swb-connection)) 990 | (add-file-local-variable 'swb-database (swb-get-database swb-connection)) 991 | (add-file-local-variable 'swb-engine (oref swb-connection engine)) 992 | (when (bound-and-true-p swb-crypt-key) 993 | ;; in case we have a crypt key we can also store the password 994 | (setq-local epg-context (epg-make-context nil t t)) 995 | (let ((encrypted-password 996 | (epg-encrypt-string 997 | epg-context (oref swb-connection password) 998 | (epg-list-keys epg-context swb-crypt-key)))) 999 | (add-file-local-variable 'swb-password (base64-encode-string encrypted-password :no-line-break))))))) 1000 | 1001 | (defun swb-use-database (database) 1002 | "Change the active DATABASE of current connection. 1003 | 1004 | If no connection is established, try to connect first." 1005 | (interactive (list (if swb-connection 1006 | (completing-read 1007 | "Database: " 1008 | (swb-get-databases swb-connection) 1009 | nil 1010 | nil 1011 | nil 1012 | nil 1013 | (and (symbol-at-point) 1014 | (symbol-name (symbol-at-point)))) 1015 | nil))) 1016 | (if database 1017 | (swb-connection-use-database swb-connection database) 1018 | (swb-maybe-connect))) 1019 | 1020 | ;; TODO: add function to explain current query 1021 | ;; TODO: add function to list all tables/objects in the database 1022 | ;; TODO: add something to navigate queries (beg/end-of-defun style) 1023 | (defvar swb-mode-map 1024 | (let ((map (make-sparse-keymap))) 1025 | (set-keymap-parent map sql-mode-map) 1026 | (define-key map (kbd "C-c C-d") 'swb-show-data-in-table) 1027 | (define-key map (kbd "C-c C-t") 'swb-describe-table) 1028 | (define-key map (kbd "C-c C-c") 'swb-send-current-query) 1029 | (define-key map (kbd "C-c C-f") 'swb-clear-inline-result) 1030 | (define-key map (kbd "C-c C-r") 'swb-reconnect) 1031 | (define-key map (kbd "C-c C-x C-r") 'swb-R-send-current-query) 1032 | (define-key map (kbd "C-c C-s") 'swb-store-connection-to-file) 1033 | (define-key map (kbd "C-c C-n") 'swb-show-number-of-rows-in-table) 1034 | (define-key map (kbd "C-c C-e") 'swb-use-database) 1035 | (define-key map (kbd "C-c C-k") 'swb-copy-query-at-point) 1036 | (define-key map (kbd "C-c C-,") 'org-insert-structure-template) 1037 | ;; bind some commands from org-mode 1038 | (define-key map (kbd "C-c S") 'org-table-sort-lines) 1039 | map) 1040 | "Keymap for swb mode.") 1041 | 1042 | (defun swb--src-font-lock-fontify-block (lang element) 1043 | "Fontify code block. 1044 | This function is called by emacs automatic fontification, as long 1045 | as `org-src-fontify-natively' is non-nil." 1046 | (let* ((lang-mode (org-src--get-lang-mode lang)) 1047 | (start (org-element-property :begin element)) 1048 | (end (org-element-property :end element)) 1049 | (contents-end (or (org-element-property :contents-end element) end))) 1050 | (when (fboundp lang-mode) 1051 | (let ((string (buffer-substring-no-properties start end)) 1052 | (modified (buffer-modified-p)) 1053 | (org-buffer (current-buffer))) 1054 | (remove-text-properties start end '(face)) 1055 | (with-current-buffer 1056 | (get-buffer-create 1057 | (format " *org-src-fontification:%s*" lang-mode)) 1058 | (let ((inhibit-modification-hooks nil)) 1059 | (erase-buffer) 1060 | ;; Add string and a final space to ensure property change. 1061 | (insert string " ")) 1062 | (unless (eq major-mode lang-mode) (funcall lang-mode)) 1063 | (org-font-lock-ensure) 1064 | (let ((pos (point-min)) next) 1065 | (while (setq next (next-property-change pos)) 1066 | ;; Handle additional properties from font-lock, so as to 1067 | ;; preserve, e.g., composition. 1068 | (dolist (prop (cons 'face font-lock-extra-managed-props)) 1069 | (let ((new-prop (get-text-property pos prop))) 1070 | (put-text-property 1071 | (+ start (1- pos)) (1- (+ start next)) prop new-prop 1072 | org-buffer))) 1073 | (setq pos next)) 1074 | (setq pos (point-min)) 1075 | (with-current-buffer org-buffer 1076 | (goto-char start) 1077 | (while (and (setq 1078 | next 1079 | (next-single-char-property-change 1080 | pos 'font-lock-face nil end)) 1081 | next 1082 | (< next end)) 1083 | (when (get-text-property pos 'font-lock-face) 1084 | (remove-text-properties pos next '(face))) 1085 | (setq pos next))))) 1086 | (font-lock--remove-face-from-text-property 1087 | start contents-end 'face 'org-block) 1088 | (font-lock-append-text-property start contents-end 'face 'org-block) 1089 | (add-text-properties 1090 | start end 1091 | '(font-lock-fontified t fontified t font-lock-multiline t)) 1092 | (set-buffer-modified-p modified))))) 1093 | 1094 | (defun swb-fontify-org-code (limit) 1095 | (catch 'done 1096 | (let (element context) 1097 | (while (and (< (point) limit) 1098 | (setq element (org-element-at-point))) 1099 | (setq context 1100 | (org-element--parse-objects 1101 | (org-element-property :begin element) 1102 | (org-element-property :end element) 1103 | nil 1104 | (org-element-restriction (org-element-type element)))) 1105 | (when (org-element-map (cons element context) 1106 | '(fixed-width target plain-list table src-block bold italic) 1107 | (lambda (element) 1108 | (when (or (not (memq (org-element-type element) 1109 | '(bold italic))) 1110 | (nth 4 (syntax-ppss 1111 | (org-element-property :begin element)))) 1112 | (swb--src-font-lock-fontify-block 1113 | "org" 1114 | element)) 1115 | (> (org-element-property :end element) limit)) 1116 | nil t) 1117 | (throw 'done nil)) 1118 | (goto-char (org-element-property :end element)))))) 1119 | 1120 | ;; TODO: add command to switch to a different database on the same host 1121 | (define-derived-mode swb-mode sql-mode "SWB" 1122 | "Mode for editing SQL queries." 1123 | :after-hook (font-lock-add-keywords nil '((swb-fontify-org-code))) 1124 | (use-local-map swb-mode-map) 1125 | (push (list "Named refs" "^#\\+name: +\\(.*\\)$" 1) imenu-generic-expression) 1126 | (setq header-line-format swb-header-line-format) 1127 | (when (featurep 'flycheck) 1128 | (flycheck-add-mode 'sql-sqlint 'swb-mode)) 1129 | (set (make-local-variable 'swb-result-buffer) (swb--get-result-buffer)) 1130 | (set (make-local-variable 'swb-org-syntax-table) 1131 | (with-temp-buffer (org-mode) (syntax-table)))) 1132 | 1133 | ;;;###autoload (add-to-list 'auto-mode-alist '("\\.swb\\'" . swb-mode)) 1134 | 1135 | 1136 | ;;; Result mode 1137 | 1138 | (defun swb-format-number (n &optional delim) 1139 | "Format a number by adding thousand delimiters." 1140 | (setq delim (or delim " ")) 1141 | (let ((n (cond 1142 | ((and (stringp n) 1143 | (integerp (string-to-number n))) 1144 | (string-to-number n)) 1145 | ((integerp n) n) 1146 | (t (error "Not an integer number."))))) 1147 | (mapconcat 1148 | 'identity 1149 | (--map (apply 'string it) 1150 | (-map 'reverse 1151 | (nreverse 1152 | (-partition-all 1153 | 3 1154 | (nreverse 1155 | (string-to-list 1156 | (number-to-string n))))))) 1157 | delim))) 1158 | 1159 | ;; TODO: shrink headers on wide columns (for example a column full of 1160 | ;; zeroes with long name takes up too much space) and put the current 1161 | ;; column name in the modeline. 1162 | (defun swb--make-header-overlay (window ov-start) 1163 | "Put a header line at the top of the result buffer. 1164 | 1165 | WINDOW is the window, OV-START is the first visible point in 1166 | WINDOW." 1167 | (ov-clear 'swb-floating-header) 1168 | (when (> ov-start (point-min)) 1169 | (let ((ov (make-overlay 0 1)) 1170 | (str (buffer-substring-no-properties 1171 | (point-min) 1172 | (save-excursion 1173 | (goto-char (point-min)) 1174 | (forward-line 3) 1175 | (forward-char 1) 1176 | (point))))) 1177 | (overlay-put ov 'swb-floating-header t) 1178 | (overlay-put ov 'display str) 1179 | (move-overlay ov ov-start (1+ ov-start))))) 1180 | 1181 | (defun swb--get-column-bounds () 1182 | "Return points in table which span the current column as a rectangle." 1183 | (save-excursion 1184 | (let ((col (org-table-current-column)) 1185 | beg end) 1186 | (goto-char (org-table-begin)) 1187 | (unless (re-search-forward "^[ \t]*|[^-]" nil t) 1188 | (user-error "No table data")) 1189 | (org-table-goto-column col) 1190 | (setq beg (point)) 1191 | (goto-char (org-table-end)) 1192 | (unless (re-search-backward "^[ \t]*|[^-]" nil t) 1193 | (user-error "No table data")) 1194 | (org-table-goto-column col) 1195 | (setq end (point)) 1196 | (cons beg end)))) 1197 | 1198 | ;; copied from org-table-copy-region 1199 | (defun swb--org-table-copy-region (beg end) 1200 | "Extract rectangular region in table. 1201 | 1202 | Return the region as a list of lists of fields." 1203 | (interactive 1204 | (list 1205 | (if (org-region-active-p) (region-beginning) (point)) 1206 | (if (org-region-active-p) (region-end) (point)) 1207 | current-prefix-arg)) 1208 | (goto-char (min beg end)) 1209 | (org-table-check-inside-data-field) 1210 | (let ((beg (line-beginning-position)) 1211 | (c01 (org-table-current-column)) 1212 | region) 1213 | (goto-char (max beg end)) 1214 | (org-table-check-inside-data-field nil t) 1215 | (let* ((end (copy-marker (line-end-position))) 1216 | (c02 (org-table-current-column)) 1217 | (column-start (min c01 c02)) 1218 | (column-end (max c01 c02)) 1219 | (column-number (1+ (- column-end column-start))) 1220 | (rpl nil)) 1221 | (goto-char beg) 1222 | (while (< (point) end) 1223 | (unless (org-at-table-hline-p) 1224 | ;; Collect every cell between COLUMN-START and COLUMN-END. 1225 | (let (cols) 1226 | (dotimes (c column-number) 1227 | (push (org-table-get-field (+ c column-start) rpl) cols)) 1228 | (push (nreverse cols) region))) 1229 | (forward-line)) 1230 | (set-marker end nil)) 1231 | (nreverse region))) 1232 | 1233 | ;; TODO: pridat podporu na zohladnenie regionu 1234 | ;; TODO: why does this return a list of singletons? Why not just a 1235 | ;; list. 1236 | ;; TODO: do we want multi-column support? 1237 | (defun swb--get-column-data () 1238 | "Get data of current column." 1239 | (-let* (((beg . end) (swb--get-column-bounds)) 1240 | (col-data (swb--org-table-copy-region 1241 | (save-excursion 1242 | (goto-char beg) 1243 | (swb-result-down-cell 2) 1244 | (point)) 1245 | end))) 1246 | col-data)) 1247 | 1248 | ;; TODO: pridat podporu na zohladnenie regionu 1249 | (defun swb-result-copy-column-csv () 1250 | "Put the values of the column into `kill-ring' as comma-separated string." 1251 | (interactive) 1252 | (save-excursion 1253 | (let ((col-data (swb--get-column-data))) 1254 | (kill-new (mapconcat 's-trim (-flatten col-data) ", ")) 1255 | (message "Copied %d rows." (length col-data))))) 1256 | 1257 | (defun swb-result--copy-interactive () 1258 | (list 1259 | (save-excursion 1260 | (when (use-region-p) 1261 | (goto-char (region-beginning))) 1262 | (line-beginning-position)) 1263 | (save-excursion 1264 | (when (use-region-p) 1265 | (goto-char (region-end))) 1266 | (line-end-position)))) 1267 | 1268 | (defun swb-result--copy-get-data (beg end) 1269 | (save-excursion 1270 | (save-restriction 1271 | (widen) 1272 | (narrow-to-region beg end) 1273 | (let* ((data (org-table-to-lisp)) 1274 | (types (--map (plist-get (cdr it) :type) swb-metadata)) 1275 | (names (-map 'car swb-metadata)) 1276 | (typed-data 1277 | (-map 1278 | (lambda (row) 1279 | (-map 1280 | (-lambda ((type name item)) 1281 | ;; TODO: this is very crude 1282 | (list 1283 | :type type 1284 | :name name 1285 | :item (if (string-match-p 1286 | (regexp-opt 1287 | (list "STRING" 1288 | "DATE" 1289 | "DATETIME" 1290 | "BLOB" 1291 | "VARCHAR")) 1292 | type) 1293 | (format "'%s'" item) 1294 | item))) 1295 | (-zip types names row))) 1296 | data))) 1297 | typed-data)))) 1298 | 1299 | (defun swb-result-copy-row-sql (beg end) 1300 | "Copy current row as SQL values clause." 1301 | (interactive (swb-result--copy-interactive)) 1302 | (let ((data (swb-result--copy-get-data beg end))) 1303 | (kill-new (mapconcat 1304 | (lambda (row) 1305 | (format "(%s)" (mapconcat (lambda (x) (plist-get x :item)) row ", "))) 1306 | data 1307 | ", ")) 1308 | (message "Copied %d rows to kill-ring" (length data)))) 1309 | 1310 | (defun swb-result-copy-row-tibble (beg end) 1311 | "Copy current row as R tibble." 1312 | (interactive (swb-result--copy-interactive)) 1313 | (let* ((data (swb-result--copy-get-data beg end)) 1314 | (names (--map (plist-get it :name) (car data))) 1315 | (columns (apply 'cl-mapcar 'list (-map (lambda (row) (--map (plist-get it :item) row)) data)))) 1316 | (kill-new (concat 1317 | "tibble(" 1318 | (mapconcat 1319 | (-lambda ((name . column)) 1320 | (format "%s = c(%s)" name (mapconcat 'identity column ", "))) 1321 | (cl-mapcar 'cons names columns) 1322 | ", ") 1323 | ")")) 1324 | (message "Copied %d rows to kill-ring" (length data)))) 1325 | 1326 | (defun swb-result-copy-row-csv (beg end) 1327 | "Copy current row as CSV." 1328 | (interactive (swb-result--copy-interactive)) 1329 | (let* ((data (swb-result--copy-get-data beg end)) 1330 | (header (format "%s" (mapconcat 1331 | (lambda (x) (format "\"%s\"" (plist-get x :name))) 1332 | (car data) 1333 | ",")))) 1334 | (kill-new (concat 1335 | header 1336 | "\n" 1337 | (mapconcat 1338 | (lambda (row) 1339 | (format "%s" (mapconcat (lambda (x) (plist-get x :item)) row ","))) 1340 | data 1341 | "\n"))) 1342 | (message "Copied %d rows to kill-ring" (length data)))) 1343 | 1344 | (defun swb-result-copy-row-php-assoc (beg end) 1345 | "Copy current row as PHP associative array." 1346 | (interactive (swb-result--copy-interactive)) 1347 | (let ((data (swb-result--copy-get-data beg end))) 1348 | (kill-new 1349 | (format 1350 | "[ 1351 | %s 1352 | ]" 1353 | (mapconcat 1354 | (lambda (row) 1355 | (format "[ 1356 | %s 1357 | ]" (mapconcat (lambda (x) 1358 | (format 1359 | "'%s' => %s" 1360 | (plist-get x :name) 1361 | (plist-get x :item))) row ", 1362 | "))) 1363 | data 1364 | ", 1365 | "))) 1366 | (message "Copied %d rows to kill-ring" (length data)))) 1367 | 1368 | (defun swb--result-get-column-names (&optional n) 1369 | "Return all the columns in the result. 1370 | 1371 | If optional argument N is set get the name of nth column." 1372 | (save-excursion 1373 | (goto-char (point-min)) 1374 | (forward-line 1) 1375 | (let* ((header (buffer-substring-no-properties (line-beginning-position) (line-end-position))) 1376 | (columns (-map 's-trim (split-string header "|" t)))) 1377 | (if n (nth n columns) columns)))) 1378 | 1379 | (defun swb-result-narrow-by-primary-key (filters) 1380 | "Run a new query in the current table with additional filter based on primary keys." 1381 | (interactive (list 1382 | (let ((keys (swb--get-primary-keys))) 1383 | (--map 1384 | (cons 1385 | it 1386 | (read-from-minibuffer 1387 | (format "%s = ? " it))) 1388 | keys)))) 1389 | (let ((table (plist-get (cdar swb-metadata) :original-table)) 1390 | (conditions (->> filters 1391 | (--remove (string-empty-p (cdr it))) 1392 | (--map (format "%s = %s" (car it) (cdr it))) 1393 | (s-join " AND ")))) 1394 | (swb-query-display-result 1395 | (format "select * from %s where %s" table conditions) 1396 | (current-buffer)))) 1397 | 1398 | (defun swb-result-forward-cell (&optional arg) 1399 | "Go forward ARG cells." 1400 | (interactive "p") 1401 | (setq arg (or arg 1)) 1402 | (org-table-goto-column (+ arg (org-table-current-column))) 1403 | (skip-syntax-forward " ") 1404 | (when (looking-at-p "^|") 1405 | (forward-char 1)) 1406 | (skip-syntax-forward " ")) 1407 | 1408 | (defun swb-result-backward-cell (&optional arg) 1409 | "Go forward ARG cells." 1410 | (interactive "p") 1411 | (org-table-goto-column (- (org-table-current-column) arg)) 1412 | (skip-syntax-forward " ")) 1413 | 1414 | (defun swb-result-up-cell (&optional arg) 1415 | "Go up ARG cells." 1416 | (interactive "p") 1417 | (let ((cc (org-table-current-column))) 1418 | (forward-line (- arg)) 1419 | (org-table-goto-column cc) 1420 | (skip-syntax-forward " "))) 1421 | 1422 | (defun swb-result-down-cell (&optional arg) 1423 | "Go down ARG cells." 1424 | (interactive "p") 1425 | (cond 1426 | ((<= (line-number-at-pos) 3) 1427 | (let ((cc (current-column))) 1428 | (goto-char (point-min)) 1429 | (forward-line 3) 1430 | (forward-char cc) 1431 | (re-search-backward "|") 1432 | (forward-char 1)) 1433 | (skip-syntax-forward " ")) 1434 | ((not (save-excursion 1435 | (beginning-of-line 2) 1436 | (or (not (org-at-table-p)) 1437 | (org-at-table-hline-p)))) 1438 | (let ((cc (org-table-current-column))) 1439 | (beginning-of-line 2) 1440 | (org-table-goto-column cc) 1441 | (skip-syntax-forward " "))))) 1442 | 1443 | (defun swb-result-down-page () 1444 | "Scroll down half a page of results." 1445 | (interactive) 1446 | (let ((cc (org-table-current-column))) 1447 | (scroll-up) 1448 | (org-table-goto-column cc))) 1449 | 1450 | (defun swb-result-up-page () 1451 | "Scroll down half a page of results." 1452 | (interactive) 1453 | (let ((cc (org-table-current-column))) 1454 | (scroll-down) 1455 | (org-table-goto-column cc))) 1456 | 1457 | (defun swb-beginning-of-buffer () 1458 | "Go to the first line of the result set." 1459 | (interactive) 1460 | (let ((cc (org-table-current-column))) 1461 | (goto-char (point-min)) 1462 | (forward-line 3) 1463 | (org-table-goto-column cc))) 1464 | 1465 | (defun swb-end-of-buffer () 1466 | "Go to the last line of the result set." 1467 | (interactive) 1468 | (let ((cc (org-table-current-column))) 1469 | (goto-char (point-max)) 1470 | (forward-line -2) 1471 | (org-table-goto-column cc))) 1472 | 1473 | (defun swb-beginning-of-line () 1474 | "Go to the first column of current row." 1475 | (interactive) 1476 | (org-table-goto-column 1) 1477 | (skip-syntax-forward " ")) 1478 | 1479 | (defun swb-end-of-line () 1480 | "Go to the last column of current row." 1481 | (interactive) 1482 | (org-table-goto-column (length (swb--result-get-column-names))) 1483 | (skip-syntax-forward " ")) 1484 | 1485 | (defun swb-result-jump-to-column (column-name) 1486 | "Jump to column named COLUMN-NAME." 1487 | (interactive (list (completing-read "Column: " 1488 | (swb--result-get-column-names) 1489 | nil t))) 1490 | (let ((column-number (1+ (--find-index (equal column-name it) (swb--result-get-column-names))))) 1491 | (org-table-goto-column column-number))) 1492 | 1493 | ;; TODO: we should be able to edit the query which produced this 1494 | ;; result and re-run it, possibly in different window 1495 | (defun swb-revert () 1496 | "Revert the current result buffer. 1497 | 1498 | This means rerunning the query which produced it." 1499 | (interactive) 1500 | (swb-query-display-result swb-query (current-buffer))) 1501 | 1502 | ;; TODO: sort ma blby regexp na datum, berie len timestamp ... a napr ignoruje hodiny 1503 | (defun swb-sort-rows () 1504 | "Sort rows of the result table." 1505 | (interactive) 1506 | (unwind-protect 1507 | (progn 1508 | (read-only-mode -1) 1509 | (call-interactively 'org-table-sort-lines)) 1510 | (read-only-mode 1))) 1511 | 1512 | ;; TODO: this is just copy-pasted `org-table-sum'. Fix the bloody 1513 | ;; duplicity!. 1514 | (defun swb-org-table-avg (&optional beg end nlast no-kill) 1515 | "See `org-table-sum'." 1516 | (interactive) 1517 | (save-excursion 1518 | (let (col (org-timecnt 0) diff h m s org-table-clip) 1519 | (cond 1520 | ((and beg end)) ; beg and end given explicitly 1521 | ((org-region-active-p) 1522 | (setq beg (region-beginning) end (region-end))) 1523 | (t 1524 | (setq col (org-table-current-column)) 1525 | (goto-char (org-table-begin)) 1526 | (unless (re-search-forward "^[ \t]*|[^-]" nil t) 1527 | (user-error "No table data")) 1528 | (org-table-goto-column col) 1529 | (setq beg (point)) 1530 | (goto-char (org-table-end)) 1531 | (unless (re-search-backward "^[ \t]*|[^-]" nil t) 1532 | (user-error "No table data")) 1533 | (org-table-goto-column col) 1534 | (setq end (point)))) 1535 | (let* ((items (apply 'append (swb--org-table-copy-region beg end))) 1536 | (items1 (cond ((not nlast) items) 1537 | ((>= nlast (length items)) items) 1538 | (t (setq items (reverse items)) 1539 | (setcdr (nthcdr (1- nlast) items) nil) 1540 | (nreverse items)))) 1541 | (numbers (delq nil (mapcar 'org-table-get-number-for-summing 1542 | items1))) 1543 | (res (/ (float (apply '+ numbers)) (length numbers))) 1544 | (sres (if (= org-timecnt 0) 1545 | (format "%.3f" res) 1546 | (setq diff (* 3600 res) 1547 | h (floor (/ diff 3600)) diff (mod diff 3600) 1548 | m (floor (/ diff 60)) diff (mod diff 60) 1549 | s diff) 1550 | (format "%.0f:%02.0f:%02.0f" h m s)))) 1551 | (unless no-kill (kill-new sres)) 1552 | (if (org-called-interactively-p 'interactive) 1553 | (message "%s" 1554 | (substitute-command-keys 1555 | (format "Average of %d items: %-20s (\\[yank] will insert result into buffer)" 1556 | (length numbers) sres)))) 1557 | sres)))) 1558 | 1559 | ;; TODO: this is just copy-pasted `org-table-sum'. 1560 | (defun swb-org-table-sum (&optional beg end nlast no-kill) 1561 | "Sum numbers in region of current table column. 1562 | The result will be displayed in the echo area, and will be available 1563 | as kill to be inserted with \\[yank]. 1564 | 1565 | If there is an active region, it is interpreted as a rectangle and all 1566 | numbers in that rectangle will be summed. If there is no active 1567 | region and point is located in a table column, sum all numbers in that 1568 | column. 1569 | 1570 | If at least one number looks like a time HH:MM or HH:MM:SS, all other 1571 | numbers are assumed to be times as well (in decimal hours) and the 1572 | numbers are added as such. 1573 | 1574 | If NLAST is a number, only the NLAST fields will actually be summed." 1575 | (interactive) 1576 | (save-excursion 1577 | (let (col (org-timecnt 0) diff h m s org-table-clip) 1578 | (cond 1579 | ((and beg end)) ; beg and end given explicitly 1580 | ((org-region-active-p) 1581 | (setq beg (region-beginning) end (region-end))) 1582 | (t 1583 | (setq col (org-table-current-column)) 1584 | (goto-char (org-table-begin)) 1585 | (unless (re-search-forward "^[ \t]*|[^-]" nil t) 1586 | (user-error "No table data")) 1587 | (org-table-goto-column col) 1588 | (setq beg (point)) 1589 | (goto-char (org-table-end)) 1590 | (unless (re-search-backward "^[ \t]*|[^-]" nil t) 1591 | (user-error "No table data")) 1592 | (org-table-goto-column col) 1593 | (setq end (point)))) 1594 | (let* ((items (apply 'append (swb--org-table-copy-region beg end))) 1595 | (items1 (cond ((not nlast) items) 1596 | ((>= nlast (length items)) items) 1597 | (t (setq items (reverse items)) 1598 | (setcdr (nthcdr (1- nlast) items) nil) 1599 | (nreverse items)))) 1600 | (numbers (delq nil (mapcar 'org-table-get-number-for-summing 1601 | items1))) 1602 | (res (apply '+ numbers)) 1603 | (sres (if (= org-timecnt 0) 1604 | (number-to-string res) 1605 | (setq diff (* 3600 res) 1606 | h (floor (/ diff 3600)) diff (mod diff 3600) 1607 | m (floor (/ diff 60)) diff (mod diff 60) 1608 | s diff) 1609 | (format "%.0f:%02.0f:%02.0f" h m s)))) 1610 | (unless no-kill (kill-new sres)) 1611 | (when (called-interactively-p 'interactive) 1612 | (message "%s" (substitute-command-keys 1613 | (format "Sum of %d items: %-20s \ 1614 | \(\\[yank] will insert result into buffer)" (length numbers) sres)))) 1615 | sres)))) 1616 | 1617 | ;; TODO: read the actual foreign key metadata from table structure 1618 | (defun swb-result-follow-foreign-key () 1619 | "Follow the foreign key under point. 1620 | 1621 | If the foreign key is not declared we try to guess the base table 1622 | name from the column name by dropping the _id suffix." 1623 | (interactive) 1624 | (let* ((col-name (swb-get-metadata :name (org-table-current-column)))) 1625 | (when (string-suffix-p "_id" col-name) 1626 | (let ((base-table (replace-regexp-in-string "_id\\'" "" col-name)) 1627 | (val (s-trim (save-excursion (org-table-get-field))))) 1628 | (swb-query-display-result 1629 | (format "SELECT * FROM %s WHERE id = %s" base-table val) 1630 | (current-buffer)))))) 1631 | 1632 | ;; TODO: pridat podporu na editovanie riadkov priamo v result sete 1633 | ;; TODO: add helpers to add rows to the table (M-RET) 1634 | ;; TODO: add font-locking 1635 | ;; - query the server for types of columns 1636 | ;; - distinguish dates, numbers, strings, blobs (we should also shorten these somehow!), nulls 1637 | ;; - primary keys in bold 1638 | (defvar swb-result-mode-map 1639 | (let ((map (make-sparse-keymap))) 1640 | (set-keymap-parent map org-mode-map) 1641 | (define-key map (kbd "C-c C-d") 'swb-show-data-in-table) 1642 | (define-key map [remap beginning-of-buffer] 'swb-beginning-of-buffer) 1643 | (define-key map [remap beginning-of-line] 'swb-beginning-of-line) 1644 | (define-key map [remap end-of-buffer] 'swb-end-of-buffer) 1645 | (define-key map [remap end-of-line] 'swb-end-of-line) 1646 | (define-key map "+" 'swb-org-table-sum) 1647 | (define-key map "%" 'swb-org-table-avg) 1648 | (define-key map "f" 'swb-result-forward-cell) 1649 | (define-key map "b" 'swb-result-backward-cell) 1650 | (define-key map "p" 'swb-result-up-cell) 1651 | (define-key map "n" 'swb-result-down-cell) 1652 | (define-key map "g" 'swb-revert) 1653 | (define-key map "j" 'swb-result-jump-to-column) 1654 | (define-key map "s" 'swb-sort-rows) 1655 | ;; TODO: add various export options: line/selection/table/column 1656 | ;; as sql, csv, xml (??) 1657 | ;; TODO: add function to copy the content of current cell 1658 | ;; TODO: put this under a nested map so we can have multiple 1659 | ;; export types 1660 | (define-key map "c" 1661 | (defhydra swb-copy-column (:color blue :hint nil) 1662 | " 1663 | Copy the current column as: 1664 | 1665 | _c_sv 1666 | " 1667 | ("c" swb-result-copy-column-csv))) 1668 | (define-key map "r" 1669 | (defhydra swb-copy-row (:color blue :hint nil) 1670 | " 1671 | Copy the current row as: 1672 | 1673 | SQL (_r_) 1674 | _t_ibble 1675 | _p_hp 1676 | _c_sv 1677 | " 1678 | ("r" swb-result-copy-row-sql) 1679 | ("t" swb-result-copy-row-tibble) 1680 | ("p" swb-result-copy-row-php-assoc) 1681 | ("c" swb-result-copy-row-csv))) 1682 | (define-key map "e" 'swb-result-show-cell) 1683 | (define-key map (kbd "C-c C-c") 'swb-result-submit) 1684 | (define-key map "q" 'quit-window) 1685 | (define-key map (kbd "") 'swb-result-follow-foreign-key) 1686 | (define-key map (kbd "") 'swb-result-forward-cell) 1687 | (define-key map (kbd "") 'swb-result-backward-cell) 1688 | (define-key map (kbd "") 'swb-result-up-cell) 1689 | (define-key map (kbd "") 'swb-result-down-cell) 1690 | (define-key map (kbd "") 'swb-result-up-page) 1691 | (define-key map (kbd "") 'swb-result-down-page) 1692 | (--each (-map 'number-to-string (number-sequence 0 9)) 1693 | (define-key map it 'digit-argument)) 1694 | map) 1695 | "Keymap for swb result mode.") 1696 | 1697 | ;; TODO: make column optional and grab it from current buffer? 1698 | (defun swb-get-metadata (property column) 1699 | "Get metadata PROPERTY for COLUMN. 1700 | 1701 | Column starts at 1." 1702 | (if (eq property :name) 1703 | (car (nth (1- column) swb-metadata)) 1704 | (plist-get (cdr (nth (1- column) swb-metadata)) property))) 1705 | 1706 | (defun swb-result-fontify-cell () 1707 | "Fontify cell." 1708 | (backward-char 1) 1709 | ;; TODO: put "column" property on the text? 1710 | (let ((cc (org-table-current-column)) 1711 | (case-fold-search t)) 1712 | (when (< 0 cc) 1713 | (-when-let* ((current-type (swb-get-metadata :type cc)) 1714 | ;; TODO: precompute this 1715 | (face (cond 1716 | ((string-match-p "long\\|tiny\\|int" current-type) 1717 | font-lock-builtin-face) 1718 | ((string-match-p "bit" current-type) 1719 | font-lock-variable-name-face) 1720 | ((string-match-p "double\\|decimal" current-type) 1721 | font-lock-keyword-face) 1722 | ((string-match-p "string\\|varchar" current-type) 1723 | font-lock-string-face) 1724 | ((string-match-p "date" current-type) 1725 | font-lock-function-name-face)))) 1726 | (if (> (line-number-at-pos) 3) 1727 | face 1728 | 'org-table))))) 1729 | 1730 | (defun swb-result-fontify-json (limit) 1731 | "Fontify cells which appear to hold JSON content with `json-mode'." 1732 | (while (re-search-forward (rx "|" (1+ " ") (or "{" "[{") 34) limit t) 1733 | (let ((type (swb-get-metadata :type (org-table-current-column))) 1734 | (case-fold-search t)) 1735 | (let ((beg (save-excursion (org-table-beginning-of-field 1) (point))) 1736 | (end (save-excursion (org-table-end-of-field 1) (point)))) 1737 | (when (string-match-p (regexp-opt (list "STRING" "BLOB" "NVARCHAR")) type) 1738 | (org-src-font-lock-fontify-block 'json beg end) 1739 | (font-lock--remove-face-from-text-property 1740 | beg end 'face 'org-block (current-buffer))))))) 1741 | 1742 | (defvar-local swb-result-cell-position nil 1743 | "Position in the result buffer corresponding to the cell being edited.") 1744 | 1745 | (defvar-local swb-result-pending-updates nil 1746 | "List of pending updates for this result buffer.") 1747 | 1748 | ;; TODO: this is not safe if we do not pull all the columns as it 1749 | ;; might only include one of the composite keys 1750 | (defun swb--get-primary-keys-indices () 1751 | "Get the indices of primary keys of the current result set. 1752 | 1753 | Note that these might not represent the full key of the table." 1754 | (-find-indices (-lambda ((_ &keys :flags flags)) 1755 | (and flags (string-match-p "PRI_KEY" flags))) 1756 | swb-metadata)) 1757 | 1758 | (defun swb--get-primary-keys () 1759 | "Get the names of primary keys of the current result set. 1760 | 1761 | Note that these might not represent the full key of the table." 1762 | (-select-by-indices (swb--get-primary-keys-indices) (swb--result-get-column-names))) 1763 | 1764 | (defun swb-cell-edit-submit-result () 1765 | (interactive) 1766 | (let ((target-point swb-result-cell-position) 1767 | (replacement-value-raw (buffer-string)) 1768 | (replacement-value-table (json-read-from-string (buffer-string)))) 1769 | (with-current-buffer swb-result-buffer 1770 | (save-excursion 1771 | (goto-char target-point) 1772 | (let ((inhibit-read-only t)) 1773 | (org-table-get-field nil (format " %s " replacement-value-table)) 1774 | (org-table-align))) 1775 | (goto-char (set-window-point (get-buffer-window (current-buffer)) target-point)) 1776 | (let ((primary-keys (swb--get-primary-keys-indices)) 1777 | (row (car 1778 | (save-excursion 1779 | (save-restriction 1780 | (narrow-to-region (line-beginning-position) (line-end-position)) 1781 | ;; TODO: this has to be replaced by something 1782 | ;; that is aware of the underlying types. We 1783 | ;; should probably add some better abstraction 1784 | ;; for working with the result tables. 1785 | (org-table-to-lisp)))))) 1786 | (push (list :keys (--zip-with (list :name it :value other) 1787 | (swb--get-primary-keys) 1788 | (-select-by-indices primary-keys row)) 1789 | :name (swb--result-get-column-names (1- (org-table-current-column))) 1790 | :value replacement-value-raw) 1791 | swb-result-pending-updates))) 1792 | (remove-hook 'kill-buffer-hook 'swb-cell-edit-cancel 'local) 1793 | (kill-buffer-and-window))) 1794 | 1795 | (defun swb-cell-edit-cancel () 1796 | (interactive)) 1797 | 1798 | (defvar swb-cell-edit-mode-map 1799 | (let ((map (make-sparse-keymap))) 1800 | (set-keymap-parent map json-mode-map) 1801 | (define-key map (kbd "C-c C-s") 'swb-cell-edit-submit-result) 1802 | (define-key map (kbd "C-x C-s") 'swb-cell-edit-submit-result) 1803 | (define-key map (kbd "C-c C-c") 'swb-cell-edit-submit-result) 1804 | (define-key map (kbd "C-c C-k") 'swb-cell-edit-cancel) 1805 | map)) 1806 | 1807 | (define-derived-mode swb-cell-edit-mode json-mode "Swb cell edit" 1808 | "Mode for displaying and editing result cells.") 1809 | 1810 | (defun swb-result-show-cell () 1811 | "Open the cell in a separate window for editation. 1812 | 1813 | The buffer is opened in `swb-cell-edit-mode'. 1814 | 1815 | No edits or changes to the content of this buffer are reflected 1816 | back in the database or the result view. This command merely 1817 | presents a convenient way to work with the value of the current 1818 | cell in a separate buffer." 1819 | (interactive) 1820 | (let ((content (s-trim (save-excursion (org-table-get-field)))) 1821 | (type (swb-get-metadata :type (org-table-current-column))) 1822 | (result-buffer (current-buffer)) 1823 | (result-point (point))) 1824 | (pop-to-buffer 1825 | (with-current-buffer (get-buffer-create "*swb-result-edit-cell*") 1826 | (erase-buffer) 1827 | (insert 1828 | (cond 1829 | ((string-match-p (rx (or "STRING" "DATE")) type) 1830 | (format "\"%s\"" content)) 1831 | (t content))) 1832 | (swb-cell-edit-mode) 1833 | (json-mode-beautify) 1834 | (setq-local swb-result-buffer result-buffer) 1835 | (setq-local swb-result-cell-position result-point) 1836 | (add-hook 'kill-buffer-hook 'swb-cell-edit-cancel nil 'local) 1837 | (current-buffer))))) 1838 | 1839 | (defun swb--result-generate-update-for-row (table key data) 1840 | "Generate update query in TABLE for row matching KEY to DATA." 1841 | (let ((key-string 1842 | (mapconcat 1843 | (-lambda ((&plist :name name 1844 | :value value)) 1845 | (format "`%s` = %s" name value)) 1846 | key 1847 | " AND ")) 1848 | (data-string 1849 | (mapconcat 1850 | (-lambda ((&plist :name name 1851 | :value value)) 1852 | (format "`%s` = %s" name value)) 1853 | data 1854 | ", "))) 1855 | (format "UPDATE `%s` SET %s WHERE %s" table data-string key-string))) 1856 | 1857 | (defun swb-result-update-table () 1858 | "Generate update queries for all the pending changes in the current buffer." 1859 | (let* ((update-data 1860 | (-map (-lambda ((key . data)) 1861 | (cons key (-map 'cadr (-group-by (-lambda ((&plist :name name)) name) 1862 | (-map 'cddr data))))) 1863 | (-group-by (-lambda ((&plist :keys keys)) keys) swb-result-pending-updates))) 1864 | (table (plist-get (cdar swb-metadata) :original-table)) 1865 | (queries (-map (-lambda ((key . data)) 1866 | (swb--result-generate-update-for-row table key data)) 1867 | update-data))) 1868 | queries)) 1869 | 1870 | (defun swb-result-submit () 1871 | "Execute all pending updates in the current result buffer." 1872 | (interactive) 1873 | (let ((queries (swb-result-update-table)) 1874 | (connection swb-connection)) 1875 | (-each queries 1876 | (lambda (query) 1877 | (when (y-or-n-p (format "Execute query: %s" query)) 1878 | (swb-query-format-result 1879 | connection query (generate-new-buffer " *swb-temp*") 1880 | (lambda (status) 1881 | (swb--remove-active-query connection query) 1882 | (kill-buffer)))))) 1883 | (setq-local swb-result-pending-updates nil))) 1884 | 1885 | (defun swb-result-eldoc-function () 1886 | (format "Current column: %s" 1887 | (swb--result-get-column-names 1888 | (1- (org-table-current-column))))) 1889 | 1890 | ;; TODO: implement "query ring" so we can back and forth from the 1891 | ;; result buffer itself. 1892 | (define-derived-mode swb-result-mode org-mode "Swb result" 1893 | "Mode for displaying results of sql queries." 1894 | (read-only-mode 1) 1895 | (set (make-local-variable 'org-mode-hook) nil) 1896 | (set (make-local-variable 'eldoc-documentation-function) 1897 | 'swb-result-eldoc-function) 1898 | (setq mode-line-format '((10 (:eval (format "(%d,%d)" 1899 | (- (line-number-at-pos) 3) 1900 | (org-table-current-column)))) 1901 | "%b" 1902 | (:eval (when (use-region-p) 1903 | (format " (%s rows, Sum: %s, Avg: %s)" 1904 | (1+ (abs (- (org-table-current-line) 1905 | (save-excursion 1906 | (goto-char (mark)) 1907 | (org-table-current-line))))) 1908 | (swb-org-table-sum nil nil nil 'no-kill) 1909 | (swb-org-table-avg nil nil nil 'no-kill) 1910 | ))) 1911 | (:eval (when swb-count 1912 | (format " (%s rows of %s total)" 1913 | (swb-format-number (min swb-count swb-show-data-row-page-size)) 1914 | (swb-format-number swb-count)))))) 1915 | (use-local-map swb-result-mode-map) 1916 | (font-lock-add-keywords 1917 | nil 1918 | '((" \\(.+?\\) |" 1919 | (1 (swb-result-fontify-cell) t)) 1920 | ("|\\( *?NULL *\\)" 1921 | (1 '(:background "#e6a8df" :foreground "black") t)) 1922 | (swb-result-fontify-json)) 1923 | :append) 1924 | (add-hook 'window-scroll-functions 'swb--make-header-overlay nil t) 1925 | (visual-line-mode -1) 1926 | (shut-up (toggle-truncate-lines 1))) 1927 | 1928 | (provide 'sql-workbench) 1929 | ;;; sql-workbench.el ends here 1930 | --------------------------------------------------------------------------------