From: Andreas Gerler Date: Tue, 9 May 2023 15:02:58 +0000 (+0200) Subject: update ejc-sql X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=64faba3d3ef5f7bdd889e1c0ff207f07bd4e842c;p=emacsconfig.git update ejc-sql Signed-off-by: Andreas Gerler --- diff --git a/elpa/ejc-sql-20220414.1329/ejc-autocomplete.el b/elpa/ejc-sql-20220414.1329/ejc-autocomplete.el deleted file mode 100644 index 208c0da1..00000000 --- a/elpa/ejc-sql-20220414.1329/ejc-autocomplete.el +++ /dev/null @@ -1,129 +0,0 @@ -;;; ejc-autocomplete.el -- SQL completitions at point by auto-complete (the part of ejc-sql). - -;;; Copyright © 2013-2020 - Kostafey - -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software Foundation, -;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ - -;;; Code: - -(require 'auto-complete) -(require 'ejc-completion-common) -(require 'ejc-flx) - -(defvar ac-source-ejc-owners - '((candidates . ejc-owners-candidates) - (symbol . "o") - (requires . 1) - (cache . t))) - -(defvar ac-source-ejc-tables - '((candidates . ejc-tables-candidates) - (symbol . "t") - (requires . 1) - (cache . t))) - -(defvar ac-source-ejc-views - '((candidates . ejc-views-candidates) - (symbol . "v") - (requires . 1) - (cache . t))) - -(defvar ac-source-ejc-packages - '((candidates . ejc-packages-candidates) - (symbol . "p") - (requires . 1) - (cache . t))) - -(defvar ac-source-ejc-tables-point - '((candidates . ejc-tables-candidates) - (symbol . "t") - (prefix . ejc-return-point) - (requires . 0) - (cache . t))) - -(defvar ac-source-ejc-colomns - '((candidates . ejc-colomns-candidates) - (symbol . "c") - (requires . 1) - (cache . t))) - -(defvar ac-source-ejc-colomns-point - '((candidates . ejc-colomns-candidates) - (symbol . "c") - (prefix . ejc-return-point) - (requires . 0) - (cache . t))) - -(defvar ac-source-ejc-ansi-sql - '((candidates . ejc-get-ansi-sql-words) - (symbol . "s") - (document . ac-ejc-documentation) - (requires . 1) - (cache . t))) - -(defvar ac-source-ejc-keywords - '((candidates . ejc-get-keywords) - (symbol . "s") - (document . ac-ejc-documentation) - (requires . 1) - (cache . t))) - -;;;###autoload -(defun ejc-ac-setup () - "Add the completion sources to the front of `ac-sources'. -This affects only the current buffer. - -Check against following cases: -prefix-2.prefix-1.# -prefix-1.# -something#" - (interactive) - (add-to-list 'ac-sources 'ac-source-ejc-ansi-sql) - (add-to-list 'ac-sources 'ac-source-ejc-keywords) - (add-to-list 'ac-sources 'ac-source-ejc-owners) - (add-to-list 'ac-sources 'ac-source-ejc-tables) - (add-to-list 'ac-sources 'ac-source-ejc-views) - (add-to-list 'ac-sources 'ac-source-ejc-packages) - (add-to-list 'ac-sources 'ac-source-ejc-tables-point) - (add-to-list 'ac-sources 'ac-source-ejc-colomns) - (add-to-list 'ac-sources 'ac-source-ejc-colomns-point)) - -(defun ejc-ac-hook () - (if ejc-use-flx - (if (require 'flx-ido nil 'noerror) - (setq-local ac-match-function 'ejc-flx-match-internal) - (error (concat "Please install flx.el and flx-ido.el " - "if you use fuzzy completion")))) - (delq 'ac-source-dictionary ac-sources) - (delq 'ac-source-abbrev ac-sources) - (delq 'ac-source-words-in-same-mode-buffers ac-sources)) - -(add-hook 'ejc-sql-minor-mode-hook 'ejc-ac-hook) - -(when (require 'yasnippet nil 'noerror) - (setq yas-snippet-dirs - (nconc yas-snippet-dirs - (list (expand-file-name "snippets" - (file-name-directory - (locate-library "ejc-sql")))))) - (defun ejc-yas-downcase-key (args) - (if ejc-sql-mode - (cl-callf downcase (nth 1 args))) - args) - (advice-add 'yas--fetch :filter-args #'ejc-yas-downcase-key)) - -(provide 'ejc-autocomplete) - -;;; ejc-autocomplete.el ends here diff --git a/elpa/ejc-sql-20220414.1329/ejc-company.el b/elpa/ejc-sql-20220414.1329/ejc-company.el deleted file mode 100644 index 527379a6..00000000 --- a/elpa/ejc-sql-20220414.1329/ejc-company.el +++ /dev/null @@ -1,91 +0,0 @@ -;;; ejc-company.el -- SQL completitions at point by company-mode (the part of ejc-sql). - -;;; Copyright © 2020 - Kostafey - -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software Foundation, -;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ - -;;; Commentary: - -;; `ejc-company' is a `company' completion backend for `ejc-sql'. -;; To use it, add `ejc-company-backend' to `company-backends': - -;; (requre 'ejc-company) -;; (push 'ejc-company-backend company-backends) - -;;; Code: - -(require 'cl-lib) -(require 'dash) -(require 'company) -(require 'ejc-completion-common) - -(defun ejc-company-make-candidate (candidate) - (let ((text (car candidate)) - (meta (cadr candidate))) - (propertize text 'meta meta))) - -(defun ejc-company-add-meta (meta candidates) - (-map (lambda (k) (list k meta)) - candidates)) - -(defun ejc-company-candidates (prefix) - (let* ((prefix-1 (ejc-get-prefix-word)) - (prefix-2 (save-excursion - (search-backward "." nil t) - (ejc-get-prefix-word))) - (res)) - (dolist (item - (cl-remove-if-not - (lambda (c) (string-prefix-p prefix (car c) t)) - (append - (ejc-append-without-duplicates - (ejc-company-add-meta - "ansi sql" (ejc-get-ansi-sql-words)) - (ejc-company-add-meta - "keyword" (ejc-get-keywords)) - 'car :right) - (ejc-company-add-meta - "owner" (ejc-owners-candidates)) - (ejc-company-add-meta - "table" (ejc-tables-candidates)) - (ejc-company-add-meta - "view" (ejc-views-candidates)) - (if (not prefix-1) - (ejc-company-add-meta - "package" (ejc-packages-candidates))) - (ejc-company-add-meta - "column" (ejc-colomns-candidates))))) - (push (ejc-company-make-candidate item) res)) - res)) - -(defun ejc-company-annotation (candidate) - (format " %s" (get-text-property 0 'meta candidate))) - -(defun ejc-company-doc-buffer (candidate) - (company-doc-buffer (ac-ejc-documentation candidate))) - -(defun ejc-company-backend (command &optional arg &rest ignored) - (interactive (list 'interactive)) - (cl-case command - (interactive (company-begin-backend 'ejc-company-backend)) - (prefix (and (bound-and-true-p ejc-sql-mode) - (company-grab-symbol))) - (candidates (ejc-company-candidates arg)) - (doc-buffer (ejc-company-doc-buffer arg)) - (annotation (ejc-company-annotation arg)))) - -(provide 'ejc-company) - -;;; ejc-company.el ends here diff --git a/elpa/ejc-sql-20220414.1329/ejc-completion-common.el b/elpa/ejc-sql-20220414.1329/ejc-completion-common.el deleted file mode 100644 index 96a25cc3..00000000 --- a/elpa/ejc-sql-20220414.1329/ejc-completion-common.el +++ /dev/null @@ -1,165 +0,0 @@ -;;; ejc-completion-common.el -- SQL completitions common functionality (the part of ejc-sql). - -;;; Copyright © 2020 - Kostafey - -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software Foundation, -;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ - -;;; Code: - -(require 'ejc-lib) -(require 'ejc-format) -(require 'ejc-interaction) -(require 'ejc-doc) - -(defcustom ejc-candidates-uppercase t - "Use uppercase candidates or downcase. -Uppercase by default, set to nil to use downcase candidates." - :type 'boolean - :safe #'booleanp - :group 'ejc-sql) - -(defvar ejc-ansi-sql-words - '("select" "where" "and" "or" "from" "insert" "update" "delete" "join" - "order by" "distinct" "create" "alter" "drop" "like" - "grant" "revoke" "deny" "commit" "rollback" "savepoint")) - -(defvar ejc-auxulary-sql-words - '("show" "errors" "desc" "count" "type" "table" "function" "procedure" - "begin" "end" "for" "return")) - -(defcustom ejc-complete-on-dot nil - "When t automatically start completion after inserting a dot for -`company-mode' despite `company-minimum-prefix-length' is bigger than 0." - :type 'boolean - :safe #'booleanp - :group 'ejc-sql) - -(defun ejc-return-point () - "Return point position if point (cursor) is located next to dot char (.#)" - (let ((curr-char (buffer-substring - (save-excursion - (left-char 1) - (point)) - (point)))) - (if (equal curr-char ".") - (point) - nil))) - -(defun ejc-get-prefix-word () - "Return the word preceding dot before the typing." - (save-excursion - (let ((space-dist (or (save-excursion - (re-search-backward "[ \n\t\r(]+" nil t)) - 0)) - (dot (search-backward "." nil t)) - (space (re-search-backward "[ \n\t\r(.]+" nil t))) - (if (and dot - space - (> dot space) - (<= space-dist space)) ; is a dot completition - (buffer-substring (1+ space) dot) - nil)))) - -(defun ejc-get-ansi-sql-words () - "Get ANSI SQL keywords." - (unless (or (ejc-return-point) (ejc-get-prefix-word)) - (if ejc-candidates-uppercase - (append (mapcar 'upcase ejc-ansi-sql-words) - (mapcar 'upcase ejc-auxulary-sql-words)) - (append ejc-ansi-sql-words - ejc-auxulary-sql-words)))) - -(defun ejc-get-keywords () - "Get DB-specific keywords." - (if (ejc-buffer-connected-p) - (unless (or (ejc-return-point) (ejc-get-prefix-word)) - (if ejc-candidates-uppercase - (mapcar 'upcase (ejc-get-keywords-inner ejc-db nil)) - (mapcar 'lowercase (ejc-get-keywords-inner ejc-db nil)))))) - -(cl-defun ejc-complete-auto-complete (buffer-name point) - "Called by Clojure side when db structure cache creation process completes. -When the user typed some chars, the request for autocompletion is passed to -Clojure side. If Clojure side has the database structure cache, autocompletion -variants returned immediately. If not, the database structure cache creation -process starts. It's async, so the process of Emacs is not blocked and the -user can move point (cursor), edit SQL and so on. After Clojure side cache -creation process finishes, it calls this `ejc-complete-auto-complete' -function. If the user waits for autocompletion and doesn't move point -(cursor) during this process, he will get autocompletion variants." - (switch-to-buffer buffer-name) - (if (equal point (point)) - (cond ((bound-and-true-p auto-complete-mode) (auto-complete)) - ((bound-and-true-p company-mode) (company-complete)))) - nil) - -(defmacro ejc-candidates (cand-fn) - `(if (ejc-buffer-connected-p) - (let* ((prefix-1 (ejc-get-prefix-word)) - (prefix-2 (save-excursion - (search-backward "." nil t) - (ejc-get-prefix-word))) - (result (funcall ,cand-fn - :db ejc-db - :sql (apply - 'buffer-substring - (ejc-get-sql-boundaries-at-point)) - :prefix-1 prefix-1 - :prefix-2 prefix-2 - :buffer-name (buffer-name) - :point (point))) - (pending (car result)) - (candidates-cache (cdr result))) - (if (ejc-not-nil-str pending) - (progn - (message "Receiving database structure...") - (list)) - candidates-cache)))) - -;;;###autoload -(defun ejc-owners-candidates () - (ejc-candidates 'ejc-get-owners-candidates)) - -;;;###autoload -(defun ejc-tables-candidates () - (ejc-candidates 'ejc-get-tables-candidates)) - -;;;###autoload -(defun ejc-views-candidates () - (ejc-candidates 'ejc-get-views-candidates)) - -;;;###autoload -(defun ejc-packages-candidates () - (ejc-candidates 'ejc-get-packages-candidates)) - -;;;###autoload -(defun ejc-colomns-candidates () - (ejc-candidates 'ejc-get-colomns-candidates)) - -(defun ac-ejc-documentation (symbol-name) - "Return a documentation string for SYMBOL-NAME." - (if (not ejc-doc-created-p) - (ejc-create-doc)) - (gethash (intern (downcase symbol-name)) ejc-sql-doc)) - -(defun ejc-dot-pressed () - (interactive) - (insert ".") - (if (and ejc-complete-on-dot (bound-and-true-p company-mode)) - (call-interactively 'company-complete))) - -(provide 'ejc-completion-common) - -;;; ejc-completion-common.el ends here diff --git a/elpa/ejc-sql-20220414.1329/ejc-direx.el b/elpa/ejc-sql-20220414.1329/ejc-direx.el deleted file mode 100644 index dec1488c..00000000 --- a/elpa/ejc-sql-20220414.1329/ejc-direx.el +++ /dev/null @@ -1,197 +0,0 @@ -;;; ejc-direx.el - -;;; Copyright © 2017 - Kostafey - -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software Foundation, -;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ - -;;; Code: - - -(require 'dash) -(require 'direx) -(require 'ejc-interaction) - -(defgroup ejc-direx nil - "Database structure visualisation tree." - :group 'ejc - :prefix "ejc-direx") - - -;;; Core - -(defclass ejc-direx:object (direx:tree) ((cache :initarg :cache))) -(defclass ejc-direx:database (ejc-direx:object direx:node) - ((buffer :initarg :buffer) - (file-name :initarg :file-name - :accessor direx:file-full-name))) -(defclass ejc-direx:schema (ejc-direx:object direx:node) ()) -(defclass ejc-direx:table (ejc-direx:object direx:node) ()) -(defclass ejc-direx:colomn (ejc-direx:object direx:leaf) ()) - -(defvar ejc-direx:type-class-map - '(("database" . ejc-direx:database) - ("schema" . ejc-direx:schema) - ("table" . ejc-direx:table) - ("column" . ejc-direx:colomn))) - -(defun ejc-direx:node-from-cache (cache) - (let* ((type (plist-get (car cache) :type)) - (class (or (assoc-default type ejc-direx:type-class-map) - 'ejc-direx:colomn))) - (make-instance class - :cache cache - :name (plist-get (car cache) :name)))) - -(defun ejc-direx:-filter-cache (items) - "Filter out cache items according to configuration." - (delq nil items)) - -(defmethod direx:node-children ((node ejc-direx:object)) - (mapcar 'ejc-direx:node-from-cache - (ejc-direx:-filter-cache (cdr (oref node :cache))))) - - -;;; Face -(defface ejc-direx:database - '((t :inherit font-lock-keyword-face)) - "Face for database name in direx tree" - :group 'ejc-direx) - -(defface ejc-direx:schema - '((t :inherit font-lock-type-face)) - "Face for schema name in direx tree" - :group 'ejc-direx) - -(defface ejc-direx:table - '((t :inherit font-lock-function-name-face)) - "Face for table name in direx tree" - :group 'ejc-direx) - -(defface ejc-direx:colomn - '((t :inherit font-lock-variable-name-face)) - "Face for column name in direx tree" - :group 'ejc-direx) - - -;;; View - -(defclass ejc-direx:item (direx:item) ()) - -(defmethod direx:make-item ((tree ejc-direx:object) parent) - (make-instance 'ejc-direx:item :tree tree :parent parent)) - -(defmethod direx:make-item ((tree ejc-direx:colomn) parent) - (let ((item (call-next-method))) - (oset item :face 'ejc-direx:colomn) - item)) - -(defmethod direx:make-item ((tree ejc-direx:table) parent) - (let ((item (call-next-method))) - (oset item :face 'ejc-direx:table) - item)) - -(defmethod direx:make-item ((tree ejc-direx:schema) parent) - (let ((item (call-next-method))) - (oset item :face 'ejc-direx:schema) - item)) - -(defmethod direx:make-item ((tree ejc-direx:database) parent) - (let ((item (call-next-method))) - (oset item :face 'ejc-direx:database) - item)) - -(defun direx-ejc:-goto-item (item) - (destructuring-bind (&key line_nr column &allow-other-keys) - (car (oref (direx:item-tree item) :cache)) - (ejc:goto--line-column line_nr column))) - -(defmethod direx:generic-find-item ((item ejc-direx:item) - not-this-window) - (let* ((root (direx:item-root item)) - (filename (direx:file-full-name (direx:item-tree root)))) - (if not-this-window - (find-file-other-window filename) - (find-file filename)) - (direx-ejc:-goto-item item))) - -(defmethod direx:generic-display-item ((item ejc-direx:item)) - (let* ((root (direx:item-root item)) - (filename (direx:file-full-name (direx:item-tree root)))) - (with-selected-window (display-buffer (find-file-noselect filename)) - (direx-ejc:-goto-item item)))) - -(defvar ejc-direx:item-refresh--recurring nil) - -(defun ejc-direx:get-structure () - "Provide data - database structure for direx tree." - (cl-labels ((column-item (column) - (list :type "column" :name column)) - (table-item (table) - (let ((columns - (ejc-get-cached-colomns-list ejc-db table t))) - (cons (list :type "table" :name table) - (-map 'list - (-map #'column-item columns))))) - (schema-item (schema) - (let ((tables (ejc-get-cached-tables-list - ejc-db schema t))) - (cons (list :type "schema" :name schema) - (-map #'table-item tables))))) - ;; Assume schema == owner (difference depends on exact database type). - (if-let ((schemas (ejc-get-cached-owners-list ejc-db t))) - (-map #'schema-item schemas) - (-map #'table-item (ejc-get-cached-tables-list ejc-db nil t))))) - -(defmethod direx:item-refresh ((item ejc-direx:item) &key recursive) - "Currently it always recursively refreshes whole tree." - (if ejc-direx:item-refresh--recurring - (call-next-method) - (let* ((ejc-direx:item-refresh--recurring t) - (root (direx:item-root item)) - (module (direx:item-tree root))) - (if (with-current-buffer (oref module :buffer) - (unless (eq (cdr (oref module :cache)) (ejc-direx:get-structure)) - (oset module :cache (cons nil (ejc-direx:get-structure))))) - (call-next-method root :recursive t) - (message "No need to refresh"))))) - - -;;; Command - -(defun ejc-direx:make-buffer () - (let ((current-ejc-db ejc-db) - (buf (direx:ensure-buffer-for-root - (make-instance 'ejc-direx:database - :name (format "%s" (ejc-get-db-name ejc-db)) - :buffer (current-buffer) - :file-name (buffer-file-name) - :cache (cons nil (ejc-direx:get-structure)))))) - (with-current-buffer buf - (setq-local ejc-db current-ejc-db)) - buf)) - -;;;###autoload -(defun ejc-direx:pop-to-buffer () - (interactive) - (pop-to-buffer (ejc-direx:make-buffer))) - -;;;###autoload -(defun ejc-direx:switch-to-buffer () - (interactive) - (switch-to-buffer (ejc-direx:make-buffer))) - -(provide 'ejc-direx) - -;;; ejc-direx.el ends here diff --git a/elpa/ejc-sql-20220414.1329/ejc-doc.el b/elpa/ejc-sql-20220414.1329/ejc-doc.el deleted file mode 100644 index 84f696ca..00000000 --- a/elpa/ejc-sql-20220414.1329/ejc-doc.el +++ /dev/null @@ -1,91 +0,0 @@ -;;; ejc-doc.el -- SQL quick hints documentation (the part of ejc-sql). - -;;; Copyright © 2018-2019 - Kostafey - -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software Foundation, -;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ - -;;; Code: - -(require 'dash) - -(defconst ejc-sql-doc (make-hash-table :test 'eq)) - -(defun ejc-fill-doc (hash-const &rest args) - (-reduce (lambda (key val) - (puthash key val hash-const)) - args)) - -(defvar ejc-doc-created-p nil) - -(defun ejc-create-doc () - (ejc-fill-doc - ejc-sql-doc - 'select - "The SQL SELECT statement returns a result -set of records from one or more tables. - -SELECT - [DISTINCT | DISTINCTROW | ALL] - select_expression,... - FROM table_references - [WHERE where_definition] - [GROUP BY {unsigned_integer | col_name | formula}] - [HAVING where_definition] - [ORDER BY {unsigned_integer | col_name | formula} [ASC | DESC], ...]" - - 'insert - "An SQL INSERT statement adds one or more records -to any single table in a relational database. - -INSERT INTO table (column1 [, column2, column3 ... ]) -VALUES (value1 [, value2, value3 ... ])" - - 'update - "An SQL UPDATE statement changes the data of one -or more records in a table. Either all the rows can -be updated, or a subset may be chosen using a condition. - -UPDATE table_name SET column_name = value [, column_name = value ...] -[WHERE condition]" - - 'delete - "The SQL DELETE statement removes one or more records from a table. - -DELETE FROM table_name [WHERE condition]" - - 'alter - "The ALTER TABLE command modifies column definitions and table constraints -'on the fly'. This means existing definitions are extended, changed or -deleted or existing data is casted to a different type or existing data is -evaluated against the new definitions. - --- change column definitions -ALTER TABLE { ADD | ALTER } [ COLUMN ] - ; -ALTER TABLE { DROP } [ COLUMN ] - ; - --- change table constraints -ALTER TABLE { ADD | ALTER } CONSTRAINT - ; -ALTER TABLE { DROP } CONSTRAINT - ;" - 'distinct - "Return different values") - (setq ejc-doc-created-p t)) - -(provide 'ejc-doc) - -;;; ejc-doc.el ends here diff --git a/elpa/ejc-sql-20220414.1329/ejc-eldoc.el b/elpa/ejc-sql-20220414.1329/ejc-eldoc.el deleted file mode 100644 index 3057ca8b..00000000 --- a/elpa/ejc-sql-20220414.1329/ejc-eldoc.el +++ /dev/null @@ -1,143 +0,0 @@ -;;; ejc-eldoc.el -- ejc-sql eldoc support (the part of ejc-sql). - -;;; Copyright (C) 2019 - Kostafey - -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software Foundation, -;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ - -;;; Code: - -(require 'dash) -(require 'eldoc) -(require 'ejc-format) - -(defun ejc-replace-property-mark (text fmt face) - (while (string-match fmt text) - (let ((beg (match-beginning 0)) - (end (match-end 0))) - (setq text (concat (substring text 0 beg) - (substring text (1+ beg)))) - (add-face-text-property beg (1- end) face t text))) - text) - -(defun ejc-propertize (text) - (-> text - (ejc-replace-property-mark "\\@\\(\\w+_?\\)+" - 'font-lock-function-name-face) - (ejc-replace-property-mark "\\%\\(\\w+_?\\)+" - 'font-lock-keyword-face) - (ejc-replace-property-mark "\\#\\(\\w+_?\\)+" - 'eldoc-highlight-function-argument))) - -(defconst ejc-sql-expressions - (list - "SELECT" - "%SELECT #field... %FROM table [%WHERE predicate]" - "FROM" - "%SELECT field... %FROM #table [%WHERE predicate]" - "WHERE" - "%WHERE #predicate [%OR predicate] [%AND predicate]")) - -(defun ejc-get-procedure-before-point () - "Return stored procedure name before the point." - (interactive) - (save-excursion - (goto-char (nth 1 (syntax-ppss))) - (thing-at-point 'symbol))) - -(defun ejc-get-package-before-point () - "Return package name of stored procedure before the point." - (interactive) - (save-excursion - (goto-char (nth 1 (syntax-ppss))) - (beginning-of-thing 'symbol) - (when (equal (string (char-before)) ".") - (left-char) - (thing-at-point 'symbol)))) - -(defun ejc-get-parameter-index () - "Return parameter number around the point." - (interactive) - (let ((index 0) - (ch (string (preceding-char)))) - (save-excursion - (while (nth 2 (syntax-ppss)) - (let ((pss (nth 2 (syntax-ppss)))) - (when (member ch (list " " "\t" "\n" ",")) - (setq index (1+ index)) - (setq ch nil)) - (goto-char pss) - (setq index (1+ index))))) - (max (1- index) 0))) - -(defun ejc-get-word-before-point () - "Return SQL word before the point." - (interactive) - (save-excursion - (if (not (member (string (preceding-char)) (list " " "\t" "\n"))) - (forward-same-syntax -1)) - (goto-char (nth 2 (syntax-ppss))) - (thing-at-point 'symbol))) - -(defun ejc-eldoc-function () - "Returns a doc string appropriate for the current context, or nil." - (if-let ((stored-procedure (if (ejc-buffer-connected-p) - (condition-case nil - (ejc-get-procedure-before-point) - (error nil))))) - (let ((type (ejc-get-entity-type ejc-db stored-procedure)) - (package (ejc-get-package-before-point))) - (if (or (eq type :procedure) - (eq type :function)) - (let ((params (car (ejc-get-parameters ejc-db - package - stored-procedure - t))) - (p-index (ejc-get-parameter-index))) - (ejc-propertize - (format "@%s: (%s)" - stored-procedure - (string-join - (-map - (lambda (p) (if (eql (cdr p) p-index) - (ejc-split-and-join - (lambda (s) (concat "#" s )) - " ") - (car p))) - (-zip params - (number-sequence 0 (1- (length params))))) - ", ")))))) - (if-let ((sql-word (condition-case nil - (ejc-get-word-before-point) - (error nil)))) - (if-let ((sql-expression (lax-plist-get - ejc-sql-expressions - sql-word))) - (ejc-propertize sql-expression))))) - -;;;###autoload -(defun ejc-eldoc-setup () - "Set up eldoc function and enable eldoc-mode." - (interactive) - (cond - ((boundp 'eldoc-documentation-strategy) - (setq-local eldoc-documentation-strategy #'ejc-eldoc-function)) - ((boundp 'eldoc-documentation-functions) - (add-hook 'eldoc-documentation-functions #'ejc-eldoc-function nil t)) - (t (setq-local eldoc-documentation-function #'ejc-eldoc-function))) - (eldoc-mode +1)) - -(provide 'ejc-eldoc) - -;;; ejc-eldoc.el ends here diff --git a/elpa/ejc-sql-20220414.1329/ejc-flx.el b/elpa/ejc-sql-20220414.1329/ejc-flx.el deleted file mode 100644 index 2bb98a38..00000000 --- a/elpa/ejc-sql-20220414.1329/ejc-flx.el +++ /dev/null @@ -1,103 +0,0 @@ -;;; ejc-flx.el -- Customization flx for ejc (the part of ejc-sql). - -;;; Copyright © 2018 - Kostafey - -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software Foundation, -;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ - -;;; Code: - -(defcustom ejc-use-flx nil - "Non-nil enables `flx' fuzzy matching engine autocompletion." - :group 'ejc-sql - :type 'boolean) - -(defcustom ejc-flx-threshold 2 - "The minimum number of typed chars required to use `flx' for autocompletion. -When 1, enables `flx' usage from the first typed char." - :group 'ejc-sql - :type 'integer) - -(defface ejc-flx-highlight-face - '((t :inherit popup-isearch-match)) - "Face used by flx for highlighting flx match characters in `ejc-sql' buffers." - :group 'ejc-sql) - -(defun ejc-flx-propertize (obj score &optional add-score) - "Return propertized copy of obj according to score. - -SCORE of nil means to clear the properties." - (let ((block-started (cadr score)) - (last-char nil) - (str (if (consp obj) - (substring-no-properties (car obj)) - (substring-no-properties obj)))) - - (when score - (dolist (char (cdr score)) - (when (and last-char - (not (= (1+ last-char) char))) - (put-text-property block-started (1+ last-char) 'face 'ejc-flx-highlight-face str) - (setq block-started char)) - (setq last-char char)) - (put-text-property block-started (1+ last-char) 'face 'ejc-flx-highlight-face str) - (when add-score - (setq str (format "%s [%s]" str (car score))))) - (if (consp obj) - (cons str (cdr obj)) - str))) - -(defun ejc-flx-decorate (things &optional clear) - "Add ido text properties to THINGS. -If CLEAR is specified, clear them instead." - (if flx-ido-use-faces - (let ((decorate-count (min ido-max-prospects - (length things)))) - (nconc - (cl-loop for thing in things - for i from 0 below decorate-count - collect (if clear - (ejc-flx-propertize thing nil) - (ejc-flx-propertize (car thing) (cdr thing)))) - (if clear - (nthcdr decorate-count things) - (mapcar 'car (nthcdr decorate-count things))))) - (if clear - things - (mapcar 'car things)))) - -(defun ejc-flx-match-internal (query items) - "Match QUERY against ITEMS using flx scores. - -If filtered item count is still greater than `flx-ido-threshold', then use flex." - (if (< (length query) ejc-flx-threshold) - (all-completions query items) - (let ((flex-result (flx-flex-match query items))) - (if (< (length flex-result) flx-ido-threshold) - (let* ((matches (cl-loop for item in flex-result - for string = (ido-name item) - for score = (flx-score string query flx-file-cache) - if score - collect (cons item score) - into matches - finally return matches))) - (ejc-flx-decorate (delete-consecutive-dups - (sort matches - (lambda (x y) (> (cadr x) (cadr y)))) - t))) - flex-result)))) - -(provide 'ejc-flx) - -;;; ejc-flx.el ends here diff --git a/elpa/ejc-sql-20220414.1329/ejc-format.el b/elpa/ejc-sql-20220414.1329/ejc-format.el deleted file mode 100644 index a0957ace..00000000 --- a/elpa/ejc-sql-20220414.1329/ejc-format.el +++ /dev/null @@ -1,302 +0,0 @@ -;;; ejc-format.el -- SQL formatting library (the part of ejc-sql). - -;;; Copyright © 2012-2019 - Kostafey - -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software Foundation, -;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ - -;;; Code: - -(require 'cua-base) -(require 'ejc-lib) -(require 'subr-x) -(require 'ejc-result-buffer) - -(defvar ejc-sql-separator "/" - "The char with purpose to separate the SQL statement both other.") - -(defun ejc-sql-separator-re () - (format "^\\s-*%s\\s-*" (or (alist-get :separator ejc-db) - ejc-sql-separator))) - -(defun ejc-get-border-top () - "Get top position of batch statement(s) seperator `ejc-sql-separator'. -Upper position of this batch statement(s)." - (save-excursion - (if (re-search-backward (ejc-sql-separator-re) nil t nil) - (re-search-forward (ejc-sql-separator-re) nil t nil) - (beginning-of-buffer)) - (point))) - -(defun ejc-get-border-bottom () - "Get bottom position of batch statements seperator `ejc-sql-separator' -Bottom position of this batch statement(s)." - (save-excursion - (if (re-search-forward (ejc-sql-separator-re) nil t nil) - (re-search-backward (ejc-sql-separator-re) nil t nil) - (end-of-buffer)) - (if (equal (string (preceding-char)) "\n") - (backward-char 1)) - (let ((sep-len (length ejc-sql-separator))) - (if (equal (buffer-substring (max (point-min) (- (point) sep-len)) - (point)) - ejc-sql-separator) - (backward-char sep-len))) - (point))) - -(defun ejc-get-org-begin () - "Obtain position for begin of code snippet in `org-mode' buffers." - (save-excursion - (if (and (derived-mode-p 'org-mode) - (re-search-backward "^\\s-*#\\+begin_[(src)(example)].*" - nil t nil)) - (line-end-position) - (point-min)))) - -(defun ejc-get-org-end () - "Obtain position for end of code snippet in `org-mode' buffers." - (save-excursion - (if (and (derived-mode-p 'org-mode) - (re-search-forward "^\\s-*#\\+end_[(src)(example)]" - nil t nil)) - (line-beginning-position) - (point-max)))) - -(cl-defun ejc-get-sql-boundaries-at-point (&optional beg end) - "Returns list of the boundaries of the current SQL expression. -The current SQL expression is the expression under the point. -The boundaries are marked by `ejc-sql-separator's. If the top or -bottom boundary is absent - it returns beginning or end of the -buffer. Set BEG and END parameters to add manual boundaries restrictions." - (let* ((beg (max (or beg (point-min)) - (ejc-get-border-top) - (ejc-get-org-begin))) - (end (min (or end (point-max)) - (ejc-get-border-bottom) - (ejc-get-org-end)))) - (list beg end))) - -(defmacro ejc--in-sql-boundaries (beg end &rest body) - "Inject `beg' and `end' local variables to the `body' scope. -`beg' and `end' are the boundaries of the current sql expression." - `(let* ((boundaries (if (and (boundp ',beg) (boundp ',end)) - (ejc-get-sql-boundaries-at-point ,beg ,end) - (ejc-get-sql-boundaries-at-point))) - (,beg (car boundaries)) - (,end (car (cdr boundaries)))) - ,@body)) - -(defun ejc-mark-this-sql () - "Select (mark) SQL around the point." - (interactive) - (ejc--in-sql-boundaries beg end - (when mark-active - (setq mark-active nil)) - (goto-char beg) - (cua-set-mark) - (goto-char end))) - -(defun ejc-next-sql (&optional mark) - "Goto next SQL statement." - (interactive) - (if (equal (buffer-name) ejc-results-buffer-name) - (ejc-show-next-result) - (ejc--in-sql-boundaries - beg end - (if (and mark (not mark-active)) - (cua-set-mark)) - (goto-char end) - (right-char 1)))) - -(defun ejc-previous-sql (&optional mark) - "Goto previous SQL statement." - (interactive) - (if (equal (buffer-name) ejc-results-buffer-name) - (ejc-show-prev-result) - (ejc--in-sql-boundaries - beg end - (if (and mark (not mark-active)) - (cua-set-mark)) - (goto-char beg) - (left-char 1)))) - -(defun ejc-apply-in-sql-boundaries (func) - (ejc--in-sql-boundaries beg end - (apply func (list beg end)))) - -(cl-defun ejc-get-sql-at-point (&key beg end) - "Return SQL around the point." - (ejc--in-sql-boundaries - beg end - (let ((sql (ejc-strip-text-properties - (buffer-substring beg end)))) - sql))) - -(defun ejc-flash-region (start end &optional timeout) - "Temporarily highlight region from START to END." - (let ((overlay (make-overlay start end))) - (overlay-put overlay 'face 'secondary-selection) - (run-with-timer (or timeout 0.2) nil 'delete-overlay overlay))) - -(cl-defun ejc-flash-this-sql (&key beg end) - "Select (mark) SQL around the point." - (interactive) - (ejc--in-sql-boundaries - beg end - (ejc-flash-region beg end))) - -(defmacro ejc-ensure-sql-mode (&rest body) - `(if (not (equal major-mode 'sql-mode)) - (error "SQL formatting is suitable in sql-mode only.") - (progn ,@body))) - -(defun ejc-format-sql (beg end) - (interactive "r") - (ejc-ensure-sql-mode - (save-excursion - (mapc (lambda (from-to) - (ejc-apply-in-sql-boundaries - (lambda (beg end) - (replace-regexp (car from-to) (cadr from-to) nil beg end)))) - '(("\n" " ") - ("," ", ") - (" +" " ") - ("," ",\n ") - ("select" "select \n ") - (" from " "\nfrom \n ") - (" where " "\nwhere \n ") - (" and " "\n and ") - (" or " "\n or ") - (" order by " "\norder by \n") - (" inner join " "\ninner join ") - (" left join " "\nleft join ") - (" on " "\n on ") - (" group by " "\ngroup by ")))))) - -(defun ejc-format-sql-at-point (arg) - "Format SQL bounded by the `ejc-sql-separator' or/and buffer -boundaries." - (interactive "P") - (save-excursion - (ejc--in-sql-boundaries - beg end - (if arg - (ejc-format-sql beg end) - (let ((result (ejc-format-by-hibernate - (buffer-substring beg end)))) - (delete-region beg end) - (insert result))) - (when (equal (char-before beg) - (string-to-char ejc-sql-separator)) - (goto-char beg) - (insert "\n"))) - (ejc-flash-this-sql))) - -(defun ejc-format-sql-region (beg end) - "Pretty-print SQL bounded by the selection area." - (interactive "r") - (let ((result (ejc-format-by-hibernate (buffer-substring beg end)))) - (delete-region beg end) - (insert result))) - -(defun ejc-insert-file-header () - (interactive) - (insert (concat "-- -*- mode: sql; -*-\n" - "-- Local Variables:\n" - "-- eval: (ejc-sql-mode)\n" - "-- End:\n"))) - -(defvar ejc-clear-sql-regexp - (concat "^\\s-*\\t*\"" - "\\|\\\\n\"\s-*\\+$" - "\\|\\\\n\";$")) - -(defun ejc-strinp-sql-at-point () - (interactive) - (ejc--in-sql-boundaries - beg end - (save-excursion - (replace-regexp ejc-clear-sql-regexp "" nil beg end) - (whitespace-cleanup-region beg end)))) - -(defun ejc-longest-line-length (beg-line end-line) - (save-excursion - (let ((curr-line beg-line) - (max-length 0) - (new-length 0)) - (while (<= curr-line end-line) - (goto-line curr-line) - (setq new-length (save-excursion - (end-of-line) - (current-column))) - (if (> new-length max-length) - (setq max-length new-length)) - (setq curr-line (1+ curr-line))) - max-length))) - -(defun ejc-is-separator-string (pos) - (equal (string-trim (buffer-substring - pos - (save-excursion - (end-of-line) - (point)))) - ejc-sql-separator)) - -(defun ejc-dress-sql-at-point () - (interactive) - (ejc-strinp-sql-at-point) - (save-excursion - (ejc--in-sql-boundaries - beg end - (let* ((beg-line (progn (goto-char beg) - (right-char) - (line-number-at-pos))) - (end-line (progn (goto-char end) - (if (ejc-is-separator-string end) - (left-char 1)) - (line-number-at-pos))) - (length-line (ejc-longest-line-length beg-line end-line)) - (curr-line beg-line)) - (while (<= curr-line end-line) - (goto-line curr-line) - (beginning-of-line) - (insert "\"") - (end-of-line) - (dotimes (counter (+ 2 (- length-line (current-column)))) - (insert " ")) - (if (equal curr-line end-line) - (insert "\\n\";") - (insert "\\n\" +")) - (setq curr-line (1+ curr-line))))))) - -(defun ejc-get-word-at-point (pos) - "Return SQL word around the point." - (interactive "d") - (let* ((char (char-after pos)) - (str (char-to-string char))) - (save-excursion - (let* ((end (if (member str '(" " ")" "<" ">" "=")) - (point) - (progn - (forward-sexp 1) - (point)))) - (beg (progn - (forward-sexp -1) - (point))) - (sql-word (buffer-substring beg end))) - sql-word)))) - -(provide 'ejc-format) - -;;; ejc-format.el ends here diff --git a/elpa/ejc-sql-20220414.1329/ejc-interaction.el b/elpa/ejc-sql-20220414.1329/ejc-interaction.el deleted file mode 100644 index f6f0be5e..00000000 --- a/elpa/ejc-sql-20220414.1329/ejc-interaction.el +++ /dev/null @@ -1,342 +0,0 @@ -;;; ejc-interaction.el -- ejc-sql interact with Clojure. -*- lexical-binding: t -*- - -;;; Copyright © 2013-2020 - Kostafey - -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software Foundation, -;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ - -;;; Code: - -(require 'dash) -(require 'ejc-lib) -(require 'ejc-format) -(require 'clomacs) - -(clomacs-create-httpd-start ejc-httpd-start - :lib-name "ejc-sql") - -(clomacs-create-httpd-stop ejc-httpd-stop - :lib-name "ejc-sql") - -(clomacs-defun ejc-sql-set-db - set-db - :lib-name "ejc-sql" - :namespace ejc-sql.connect - :doc "Define ejc-sql.connect/db var." - :httpd-starter 'ejc-httpd-start) - -(clomacs-defun ejc-add-classpath - add-classpath - :lib-name "ejc-sql" - :namespace ejc-sql.classpath) - -(clomacs-defun ejc-require - clojure.core/require - :lib-name "ejc-sql") - -(clomacs-defun ejc-import - clojure.core/import - :lib-name "ejc-sql") - -(clomacs-defun ejc-class-for-name - Class/forName - :lib-name "ejc-sql") - -(clomacs-defun ejc-get-dependeces-files-list - get-dependeces-files-list - :lib-name "ejc-sql" - :namespace ejc-sql.deps-resolver - :return-type :list) - -(clomacs-defun ejc-resolve-dependencies - resolve-dependencies - :lib-name "ejc-sql" - :namespace cemerick.pomegranate.aether) - -(defun ejc-connect-to-db (conn-struct) - (let* ((jars-to-load - (if-let (dependencies (alist-get :dependencies conn-struct)) - ;; Resolve dependencies and prepare jars paths list to load. - (ejc-get-dependeces-files-list dependencies) - (let* ((classpath (alist-get :classpath conn-struct)) - (dependency-jars (-map - (lambda (jar-path) - (ejc-get-dependeces-files-list - (ejc-path-to-lein-artifact jar-path))) - classpath))) - ;; Join jar files paths from `:classpath' vector of - ;; `ejc-create-connection' and dependencies for this jars. - (delq nil - (delete-dups - (append - (-flatten dependency-jars) - (append classpath nil)))))))) - (-map 'ejc-add-classpath jars-to-load)) - (when-let ((classname (alist-get :classname conn-struct))) - (ejc-class-for-name classname) - (ejc-import (read classname))) - (ejc-sql-set-db conn-struct)) - -(clomacs-defun ejc--eval-sql-and-log-print - eval-sql-and-log-print - :lib-name "ejc-sql" - :namespace ejc-sql.connect - :return-type :string - :doc "Core function to evaluate SQL queries. - Prepare SQL string, evaluate SQL script and write them to log file") - -(clomacs-defun ejc--is-query-running-p - is-query-running? - :lib-name "ejc-sql" - :namespace ejc-sql.connect - :return-type :boolean) - -(clomacs-defun ejc--cancel-query - cancel-query - :lib-name "ejc-sql" - :namespace ejc-sql.connect - :doc "Cancel current query." - :interactive t - :return-type :list) - -(clomacs-defun ejc--describe-table - describe-table - :lib-name "ejc-sql" - :namespace ejc-sql.structure) - -(clomacs-defun ejc-get-entity-type - get-entity-type-fmt - :lib-name "ejc-sql" - :namespace ejc-sql.structure - :return-type :eval) - -(clomacs-defun ejc-get-parameters - get-parameters - :lib-name "ejc-sql" - :namespace ejc-sql.structure - :return-type :list) - -(clomacs-defun ejc-get-entity-description - get-entity-description - :lib-name "ejc-sql" - :namespace ejc-sql.structure) - -(clomacs-defun ejc--get-result-file-path - get-result-file-path - :lib-name "ejc-sql" - :namespace ejc-sql.output) - -(clomacs-defun ejc-print - clojure.core/print - :lib-name "ejc-sql" - :return-type :string - :return-value :stdout) - -(clomacs-defun ejc-write-result-file - write-result-file - :namespace ejc-sql.output - :lib-name "ejc-sql" - :return-type :string) - -(clomacs-defun ejc-clear-result-file - clear-result-file - :namespace ejc-sql.output - :lib-name "ejc-sql" - :return-type :string) - -(clomacs-defun ejc-get-log-file-path - print-log-file-path - :lib-name "ejc-sql" - :namespace ejc-sql.output - :return-value :stdout) - -(clomacs-defun ejc-format-by-hibernate - format-sql-print - :lib-name "ejc-sql" - :namespace ejc-sql.output - :return-value :stdout) - -(clomacs-defun ejc-set-fetch-size - set-fetch-size - :lib-name "ejc-sql" - :namespace ejc-sql.output - :doc (concat "Set limit for number of records to output. " - "When nil no limit.")) - -(clomacs-defun ejc-set-show-too-many-rows-message - set-show-too-many-rows-message - :lib-name "ejc-sql" - :namespace ejc-sql.output - :doc (concat "Show 'Too many rows...' message in case" - "of ResultSet is bigger than `fetch-size'.")) - -(clomacs-defun ejc-set-max-rows - set-max-rows - :lib-name "ejc-sql" - :namespace ejc-sql.output - :doc (concat "Set limit for number of records to contain " - "in ResultSet. When nil no limit.")) - -(clomacs-defun ejc-set-column-width-limit - set-column-width-limit - :lib-name "ejc-sql" - :namespace ejc-sql.output - :doc (concat "Set limit for number of chars per column to " - "output to output. When nil no limit.")) - -(clomacs-defun ejc-set-use-unicode - set-use-unicode - :lib-name "ejc-sql" - :namespace ejc-sql.output - :doc "Set using unicode for grid borders.") - -(clomacs-defun ejc-get-stucture - get-stucture - :lib-name "ejc-sql" - :namespace ejc-sql.structure - :return-type :list) - -(clomacs-defun ejc-get-owners-candidates - get-owners-candidates - :lib-name "ejc-sql" - :namespace ejc-sql.structure - :return-type :list) - -(clomacs-defun ejc-get-tables-candidates - get-tables-candidates - :lib-name "ejc-sql" - :namespace ejc-sql.structure - :return-type :list) - -(clomacs-defun ejc-get-views-candidates - get-views-candidates - :lib-name "ejc-sql" - :namespace ejc-sql.structure - :return-type :list) - -(clomacs-defun ejc-get-packages-candidates - get-packages-candidates - :lib-name "ejc-sql" - :namespace ejc-sql.structure - :return-type :list) - -(clomacs-defun ejc-get-colomns-candidates - get-colomns-candidates - :lib-name "ejc-sql" - :namespace ejc-sql.structure - :return-type :list) - -(clomacs-defun ejc-get-cached-owners-list - get-owners - :lib-name "ejc-sql" - :namespace ejc-sql.structure - :return-type :list) - -(clomacs-defun ejc-get-cached-tables-list - get-tables - :lib-name "ejc-sql" - :namespace ejc-sql.structure - :return-type :list - :doc "Return cached tables list. - Requires `ejc-db' buffer local variable as parameter.") - -(clomacs-defun ejc-get-cached-colomns-list - get-colomns - :lib-name "ejc-sql" - :namespace ejc-sql.structure - :return-type :list) - -(clomacs-defun ejc-get-keywords-inner - get-keywords - :lib-name "ejc-sql" - :namespace ejc-sql.structure - :return-type :list) - -(clomacs-defun ejc-invalidate-cache-inner - invalidate-cache - :lib-name "ejc-sql" - :namespace ejc-sql.cache - :doc (concat "Clean your current connection cache " - "(database owners and tables list).")) - -(clomacs-defun ejc-validate-connection - validate-connection - :lib-name "ejc-sql" - :namespace ejc-sql.connect - :return-type :eval) - -(defun ejc-invalidate-cache () - "Clean current connection cache (database owners and tables list)." - (interactive) - (ejc-invalidate-cache-inner ejc-db)) - -(clomacs-defun ejc-output-cache - output-cache - :lib-name "ejc-sql" - :namespace ejc-sql.cache - :return-type :eval) - -(defun ejc-print-cache () - "Print current database connection cache when run from connected SQL buffer. -Print all connections cache otherwise." - (interactive) - (pprint (ejc-output-cache ejc-db))) - -(clomacs-defun ejc-select-db-meta-script - select-db-meta-script - :lib-name "ejc-sql" - :namespace ejc-sql.structure) - -(clomacs-defun ejc-get-db-name - get-db-name - :lib-name "ejc-sql" - :namespace ejc-sql.structure) - -(clomacs-defun ejc-get-this-owner - get-this-owner - :lib-name "ejc-sql" - :namespace ejc-sql.structure) - -(defun ejc-unset-mode-name () - (if (derived-mode-p 'org-mode) - (setq mode-name "Org") - (if (derived-mode-p 'sql-mode) - (setq mode-name "SQL")))) - -(defun ejc-quit-connection () - "Stop nREPL process, mark ejc-sql-mode buffers disconnected." - (interactive) - (when (y-or-n-p "Are you sure you want to close all jdbc connections?") - (ejc-httpd-stop) - (cider--close-connection (clomacs-get-connection "ejc-sql")) - ;; Update modeline of ejc-sql-mode buffers - mark as disconnected. - (let ((buffers (buffer-list))) - (while buffers - (with-current-buffer (car buffers) - (when (member 'ejc-sql-mode minor-mode-list) - (ejc-unset-mode-name) - (spinner-stop))) - (setq buffers (cdr buffers))))) - (unless (cider-connected-p) - (cider-close-ancillary-buffers))) - -(defalias 'ejc-close-connection 'ejc-quit-connection) - -(defun ejc-buffer-connected-p () - "Check if current buffer is connected to database." - (and (clomacs-get-connection "ejc-sql") (boundp 'ejc-db) ejc-db)) - -(provide 'ejc-interaction) - -;;; ejc-interaction.el ends here diff --git a/elpa/ejc-sql-20220414.1329/ejc-lib.el b/elpa/ejc-sql-20220414.1329/ejc-lib.el deleted file mode 100644 index 3f0425e7..00000000 --- a/elpa/ejc-sql-20220414.1329/ejc-lib.el +++ /dev/null @@ -1,171 +0,0 @@ -;;; ejc-lib.el -- ejc-sql shared objects (the part of ejc-sql). - -;;; Copyright © 2013-2020 - Kostafey - -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software Foundation, -;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ - -;;; Code: - -(require 's) -(require 'dash) - -(defvar-local ejc-connection-name nil - "Buffer-local connection name created with `ejc-create-connection'.") - -(defvar-local ejc-connection-struct nil - "Buffer-local connection structure.") - -(defun ejc-lein-artifact-to-path (artifact) - "Get ~/.m2 jar file path of artifact." - (if (not (vectorp artifact)) - (error - "Expect leiningen artifact, e.g. [com.h2database/h2 \"1.4.199\"].")) - (let* ((group (car (split-string - (ejc-strip-text-properties (symbol-name (elt artifact 0))) - "/"))) - (name (or (cadr (split-string - (ejc-strip-text-properties - (symbol-name (elt artifact 0))) "/")) - group)) - (version (elt artifact 1))) - (format "~/.m2/repository/%s/%s/%s/%s-%s.jar" - (mapconcat 'identity (split-string group "\\.") "/") - name - version - name - version))) - -(defun ejc-path-to-lein-artifact (path) - "Get leiningen artifact from ~/.m2 jar file path." - (if (not (stringp path)) - (error - "Expect jar file path.")) - (let* ((path (s-replace "\\" "/" path)) - (path (nth 1 (s-split ".m2/repository/" path))) - (path-elements (s-split "/" path)) - (version (nth (- (length path-elements) 2) path-elements)) - (name (nth (- (length path-elements) 3) path-elements)) - (group (s-join "." (-> path-elements -butlast -butlast -butlast)))) - (read - (format "[[%s/%s \"%s\"]]" - group - name - version)))) - -(defun ejc-string-endswith-p (s ending) - "Return non-nil if string S ends with ENDING." - (let ((elength (length ending))) - (string= (substring s (- 0 elength)) ending))) - -(defun ejc-find-file-in-load-path (search-file-name &optional fail-on-error) - "Return the full path to `file-name'. -`file-name' is searching in the emacs `load-path'." - (let ((result nil)) - (dolist (path load-path) - (let ((search-file-path (expand-file-name search-file-name path))) - (if (file-exists-p search-file-path) - (setq result search-file-path)))) - (if (and fail-on-error (not result)) - (error (concat "Can't find file " search-file-name)) - result))) - -(defun ejc-strip-text-properties (txt) - (set-text-properties 0 (length txt) nil txt) - txt) - -(defvar ejc-product-assoc - '((sqlserver . ms) - (oracle:sid . oracle))) - -(defun ejc-get-product-name (db) - "Get database type from db connection info." - (let ((product-name (or (alist-get :subprotocol db) - (alist-get :dbtype db)))) - (or (cdr (assoc-string product-name ejc-product-assoc)) - (car (assoc-string product-name sql-product-alist)) - 'ansi))) - -(defun ejc-ensure-file-directory-exists (file-path) - (let ((dir (file-name-directory file-path))) - (if (not (file-accessible-directory-p dir)) - (make-directory dir)))) - -(defun ejc-save-to-file (file-path data) - "Save Elisp variable DATA to FILE-PATH." - (ejc-ensure-file-directory-exists file-path) - (with-temp-file file-path - (prin1 data (current-buffer)))) - -(cl-defun ejc-load-from-file (file-path &key default check) - "Read Elisp variable from FILE-PATH." - (ejc-ensure-file-directory-exists file-path) - (condition-case nil - (with-temp-buffer - (insert-file-contents file-path) - (let ((value (read (current-buffer)))) - (if (and check (funcall check value)) - value - (error "File contents don't match function check.")))) - (error (ejc-save-to-file file-path default) - default))) - -(defun ejc-plist-p (lst) - "Check if LST is a plist." - (condition-case nil - (progn - (lax-plist-get lst nil) - t) - (error nil))) - -(defun ejc-flatten-index (imenu-index) - "Flatten imenu index into a plain list. -IMENU-INDEX - imenu index tree." - (-mapcat - (lambda (x) - (if (imenu--subalist-p x) - (mapcar (lambda (y) (cons (car y) (cdr y))) - (ejc-flatten-index (cdr x))) - (list x))) - imenu-index)) - -(defun ejc-split-and-join (fn split &optional join) - "Split string by SPLIT, apply FN to each substring, than join by JOIN." - (let ((join (or join split))) - (string-join - (-map fn (split-string (car p) split)) - join))) - -(defun ejc-not-nil-str (s) - (not (equal s "nil"))) - -(defun ejc-append-without-duplicates (list-left list-right comparator lead) - "Unite LIST-LEFT and LIST-RIGHT without duplicates items. -Check items equality by COMPARATOR function. -In case if some item presents in both lists (in terms of COMPARATOR -equality) get the item from LIST-LEFT if LEAD param is `:left'or -get it from LIST-RIGHT if LEAD param is `:right'." - (let* ((a (if (eq lead :left) list-left list-right)) - (b (if (eq lead :left) list-right list-left)) - (a-results (-map comparator a))) - (append a - (-filter - (lambda (b-item) - (not (-contains-p a-results - (funcall comparator b-item)))) - b)))) - -(provide 'ejc-lib) - -;;; ejc-lib.el ends here diff --git a/elpa/ejc-sql-20220414.1329/ejc-result-buffer.el b/elpa/ejc-sql-20220414.1329/ejc-result-buffer.el deleted file mode 100644 index acfd696e..00000000 --- a/elpa/ejc-sql-20220414.1329/ejc-result-buffer.el +++ /dev/null @@ -1,202 +0,0 @@ -;;; ejc-result-buffer.el - -;;; Copyright © 2019-2020 - Kostafey - -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software Foundation, -;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ - -;;; Code: - -(require 'ejc-lib) -(require 'ejc-result-mode) - -(defvar ejc-results-buffer nil - "The results buffer.") - -(defvar ejc-results-buffer-name "*ejc-sql-output*" - "The results buffer name.") - -(defvar ejc-result-file-template "ejc-sql-result-%d.txt" - "SQL evaluation results file name template.") - -(defvar ejc-result-file-path nil - "The current result file path. Refreshed by any finished SQL evaluation.") - -(defcustom ejc-results-path temporary-file-directory - "SQL evaluation result files location." - :group 'ejc-sql - :type 'string) - -(defcustom ejc-ring-length 10 - "The number of SQL evaluation results to keep." - :group 'ejc-sql - :type 'integer) - -(defvar ejc-ring-position 0 - "Current SQL evaluation result position in ring.") - -(defvar ejc-modes-ring (list) - "List of SQL evaluation result modes.") - -(defcustom ejc-modes-ring-file (expand-file-name - "ejc-modes-ring.el" - ejc-results-path) - "Previous SQL evaluation result modes file location." - :group 'ejc-sql - :type 'string) - -(defun ejc-update-modes-ring (mode) - "Update SQL evaluation result modes list, persist it in `ejc-modes-ring-file'." - (setf (alist-get ejc-ring-position ejc-modes-ring) mode) - (ejc-save-to-file ejc-modes-ring-file ejc-modes-ring)) - -(defun ejc-load-modes-ring () - "Load SQL evaluation result modes list `ejc-modes-ring' var." - (setq ejc-modes-ring - (ejc-load-from-file ejc-modes-ring-file :default (list)))) - -(defun ejc-get-result-file-path () - "Get current SQL evaluation result file path." - (expand-file-name (format ejc-result-file-template ejc-ring-position) - ejc-results-path)) - -(defun ejc-inc-ring-position () - (setq ejc-ring-position (1+ ejc-ring-position) - ejc-ring-position (if (>= ejc-ring-position ejc-ring-length) - 0 - ejc-ring-position))) - -(defun ejc-dec-ring-position () - (setq ejc-ring-position (1- ejc-ring-position) - ejc-ring-position (if (< ejc-ring-position 0) - (1- ejc-ring-length) - ejc-ring-position))) - -(defun ejc-iterate-ring (inc-or-dec &optional should-exist) - (funcall inc-or-dec) - (if should-exist - (let ((idx 0)) - (while (and (not (file-exists-p (ejc-get-result-file-path))) - (if (< idx ejc-ring-length) - t - (progn - (setq ejc-ring-position 0) - nil))) - (setq idx (1+ idx)) - (funcall inc-or-dec)))) - (setq ejc-result-file-path (ejc-get-result-file-path))) - -(defun ejc-next-result-file-path (&optional should-exist) - (ejc-iterate-ring 'ejc-inc-ring-position should-exist)) - -(defun ejc-prev-result-file-path (&optional should-exist) - (ejc-iterate-ring 'ejc-dec-ring-position should-exist)) - -(defun ejc-get-output-buffer () - "Get or create buffer for output SQL evaluation results. -It can be result sets, record affected messages, SQL definition of entities -or error messages." - (when (not (and ejc-results-buffer - (buffer-live-p ejc-results-buffer))) - (setq ejc-results-buffer (get-buffer-create - ejc-results-buffer-name)) - (with-current-buffer ejc-results-buffer - (ejc-result-mode))) - (with-current-buffer ejc-results-buffer - ;; Clear undo history - (setq buffer-undo-list nil)) - ejc-results-buffer) - -(defun ejc-output-mode-specific-customization () - (cl-case ejc-result-table-impl - (orgtbl-mode (when (org-table-p) (org-table-align))) - (ejc-result-mode (read-only-mode 1)))) - -;;;###autoload -(cl-defun ejc-show-last-result (&key result - mode - connection-name - db - goto-symbol) - "Popup buffer with last SQL execution result output." - (interactive) - (let ((output-buffer (ejc-get-output-buffer))) - (with-current-buffer output-buffer - (read-only-mode -1) - (erase-buffer) - (when mode - (ejc-update-modes-ring mode) - (funcall mode)) - (ejc-add-connection connection-name db) - (if result - ;; SQL evaluation result passed directly to fn - (insert result) - ;; SQL evaluation result rendered to file - (insert-file-contents (ejc-get-result-file-path))) - (ejc-output-mode-specific-customization) - (beginning-of-buffer) - (let* ((window (or (get-buffer-window output-buffer t) - (progn - (display-buffer output-buffer) - (get-buffer-window output-buffer t)))) - (frame (window-frame window))) - (if (not (eq frame (selected-frame))) - (make-frame-visible frame)) - (if goto-symbol - ;; Reversed, since if the result buffer is a package, it can - ;; contain 2 concatenated parts: header and implementation. - ;; Assume user wants to locate a point (cursor) in - ;; procedure implementation. - (if-let* ((items-list (reverse (delq imenu--rescan-item - (ejc-flatten-index - (condition-case nil - (imenu--make-index-alist) - (error nil)))))) - ;; Find symbol position (typically to locate the - ;; beginning of procedure implementation in the package). - (pos (alist-get goto-symbol items-list nil nil 'equal))) - (set-window-point window pos))))))) - -(cl-defun ejc-show-ring-result (prev-or-next) - (let ((output-buffer (ejc-get-output-buffer))) - (set-buffer output-buffer) - (read-only-mode -1) - (erase-buffer) - (ejc-add-connection ejc-connection-name ejc-db) - (let ((file-path (funcall prev-or-next t)) - (mode (alist-get ejc-ring-position (or ejc-modes-ring - (ejc-load-modes-ring))))) - (if mode - (funcall mode)) - (insert-file-contents file-path) - (ejc-output-mode-specific-customization) - (beginning-of-buffer) - (display-buffer output-buffer) - (message file-path)))) - -;;;###autoload -(cl-defun ejc-show-prev-result () - "Change `ejc-results-buffer' contents: show previous SQL evaluation result." - (interactive) - (ejc-show-ring-result 'ejc-prev-result-file-path)) - -;;;###autoload -(cl-defun ejc-show-next-result () - "Change `ejc-results-buffer' contents: show next SQL evaluation result." - (interactive) - (ejc-show-ring-result 'ejc-next-result-file-path)) - -(provide 'ejc-result-buffer) - -;;; ejc-result-buffer.el ends here diff --git a/elpa/ejc-sql-20220414.1329/ejc-result-mode.el b/elpa/ejc-sql-20220414.1329/ejc-result-mode.el deleted file mode 100644 index 3f849c7f..00000000 --- a/elpa/ejc-sql-20220414.1329/ejc-result-mode.el +++ /dev/null @@ -1,51 +0,0 @@ -;;; ejc-result-mode.el - -;;; Copyright © 2017-2020 - Kostafey - -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software Foundation, -;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ - -;;; Code: - -(defface ejc-result-table-borders-face '((t :inherit font-lock-comment-face - :italic nil)) - "Face used to font-lock table borders." - :group 'ejc-sql-faces) - -(defconst ejc-result-font-lock-keywords - '(("|" . 'ejc-result-table-borders-face) - ("-" . 'ejc-result-table-borders-face) - ("+" . 'ejc-result-table-borders-face) - ("│" . 'ejc-result-table-borders-face) - ("─" . 'ejc-result-table-borders-face) - ("┼" . 'ejc-result-table-borders-face))) - -(defvar ejc-result-mode-hook nil - "Functions to be called when `ejc-result-mode' is entered.") - -(defun ejc-result-mode () - (interactive) - (kill-all-local-variables) - (setq truncate-lines t) - (setq major-mode 'ejc-result-mode - mode-name "SQL-Result") - (cl-case ejc-result-table-impl - (orgtbl-mode (orgtbl-mode 1)) - (ejc-result-mode (setq view-read-only t))) - (setq font-lock-defaults '(ejc-result-font-lock-keywords)) - (run-hooks 'ejc-result-mode-hook)) - -(provide 'ejc-result-mode) - -;;; ejc-result-mode.el ends here diff --git a/elpa/ejc-sql-20220414.1329/ejc-sql-autoloads.el b/elpa/ejc-sql-20220414.1329/ejc-sql-autoloads.el deleted file mode 100644 index 3f13aa29..00000000 --- a/elpa/ejc-sql-20220414.1329/ejc-sql-autoloads.el +++ /dev/null @@ -1,236 +0,0 @@ -;;; ejc-sql-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "ejc-autocomplete" "ejc-autocomplete.el" (0 -;;;;;; 0 0 0)) -;;; Generated autoloads from ejc-autocomplete.el - -(autoload 'ejc-ac-setup "ejc-autocomplete" "\ -Add the completion sources to the front of `ac-sources'. -This affects only the current buffer. - -Check against following cases: -prefix-2.prefix-1.# -prefix-1.# -something#" t nil) - -(register-definition-prefixes "ejc-autocomplete" '("ac-source-ejc-" "ejc-ac-hook")) - -;;;*** - -;;;### (autoloads nil "ejc-company" "ejc-company.el" (0 0 0 0)) -;;; Generated autoloads from ejc-company.el - -(register-definition-prefixes "ejc-company" '("ejc-company-")) - -;;;*** - -;;;### (autoloads nil "ejc-completion-common" "ejc-completion-common.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from ejc-completion-common.el - -(autoload 'ejc-owners-candidates "ejc-completion-common" nil nil nil) - -(autoload 'ejc-tables-candidates "ejc-completion-common" nil nil nil) - -(autoload 'ejc-views-candidates "ejc-completion-common" nil nil nil) - -(autoload 'ejc-packages-candidates "ejc-completion-common" nil nil nil) - -(autoload 'ejc-colomns-candidates "ejc-completion-common" nil nil nil) - -(register-definition-prefixes "ejc-completion-common" '("ac-ejc-documentation" "ejc-")) - -;;;*** - -;;;### (autoloads nil "ejc-direx" "ejc-direx.el" (0 0 0 0)) -;;; Generated autoloads from ejc-direx.el - -(autoload 'ejc-direx:pop-to-buffer "ejc-direx" nil t nil) - -(autoload 'ejc-direx:switch-to-buffer "ejc-direx" nil t nil) - -(register-definition-prefixes "ejc-direx" '("direx" "ejc-direx:")) - -;;;*** - -;;;### (autoloads nil "ejc-doc" "ejc-doc.el" (0 0 0 0)) -;;; Generated autoloads from ejc-doc.el - -(register-definition-prefixes "ejc-doc" '("ejc-")) - -;;;*** - -;;;### (autoloads nil "ejc-eldoc" "ejc-eldoc.el" (0 0 0 0)) -;;; Generated autoloads from ejc-eldoc.el - -(autoload 'ejc-eldoc-setup "ejc-eldoc" "\ -Set up eldoc function and enable eldoc-mode." t nil) - -(register-definition-prefixes "ejc-eldoc" '("ejc-")) - -;;;*** - -;;;### (autoloads nil "ejc-flx" "ejc-flx.el" (0 0 0 0)) -;;; Generated autoloads from ejc-flx.el - -(register-definition-prefixes "ejc-flx" '("ejc-")) - -;;;*** - -;;;### (autoloads nil "ejc-format" "ejc-format.el" (0 0 0 0)) -;;; Generated autoloads from ejc-format.el - -(register-definition-prefixes "ejc-format" '("ejc-")) - -;;;*** - -;;;### (autoloads nil "ejc-interaction" "ejc-interaction.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from ejc-interaction.el - -(register-definition-prefixes "ejc-interaction" '("ejc-")) - -;;;*** - -;;;### (autoloads nil "ejc-lib" "ejc-lib.el" (0 0 0 0)) -;;; Generated autoloads from ejc-lib.el - -(register-definition-prefixes "ejc-lib" '("ejc-")) - -;;;*** - -;;;### (autoloads nil "ejc-result-buffer" "ejc-result-buffer.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from ejc-result-buffer.el - -(autoload 'ejc-show-last-result "ejc-result-buffer" "\ -Popup buffer with last SQL execution result output. - -\(fn &key RESULT MODE CONNECTION-NAME DB GOTO-SYMBOL)" t nil) - -(autoload 'ejc-show-prev-result "ejc-result-buffer" "\ -Change `ejc-results-buffer' contents: show previous SQL evaluation result." t nil) - -(autoload 'ejc-show-next-result "ejc-result-buffer" "\ -Change `ejc-results-buffer' contents: show next SQL evaluation result." t nil) - -(register-definition-prefixes "ejc-result-buffer" '("ejc-")) - -;;;*** - -;;;### (autoloads nil "ejc-result-mode" "ejc-result-mode.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from ejc-result-mode.el - -(register-definition-prefixes "ejc-result-mode" '("ejc-result-")) - -;;;*** - -;;;### (autoloads nil "ejc-sql" "ejc-sql.el" (0 0 0 0)) -;;; Generated autoloads from ejc-sql.el - -(autoload 'ejc-sql-mode "ejc-sql" "\ -Toggle ejc-sql mode. - -This is a minor mode. If called interactively, toggle the -`ejc-Sql mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `ejc-sql-mode'. - -The mode's hook is called both when the mode is enabled and when -it is disabled. - -\(fn &optional ARG)" t nil) - -(autoload 'ejc-create-menu "ejc-sql" nil nil nil) - -(autoload 'ejc-insert-connection-data "ejc-sql" "\ -Insert configured connection data to keep it between Emacs restarts. -Assume to be evaluated somewhere in .emacs or any file, loaded as Emacs -configuration. - -\(fn CONNECTION-NAME)" t nil) - -(autoload 'ejc-connect-interactive "ejc-sql" "\ -Create new connection interactively and connect to it. - -\(fn CONNECTION-NAME)" t nil) - -(autoload 'ejc-connect "ejc-sql" "\ -Connect to selected db. - -\(fn CONNECTION-NAME)" t nil) - -(autoload 'ejc-connect-existing-repl "ejc-sql" "\ -Connect to existing ejc-sql nREPL running process. -You can `cd` to your ejc-sql project folder (typically -'~/.emacs.d/elpa/ejc-sql-') and launch nREPL via `lein repl`. -Then run in Emacs `ejc-connect-existing-repl', type HOST and PORT -from your `lein run` console output. Finally, use `ejc-connect' from -any SQL buffer to connect to exact database, as always. " t nil) - -(autoload 'ejc-eval-user-sql-region "ejc-sql" "\ -Evaluate SQL bounded by the selection area. - -\(fn BEG END)" t nil) - -(autoload 'ejc-eval-user-sql-at-point "ejc-sql" "\ -Evaluate SQL bounded by the `ejc-sql-separator' or/and buffer -boundaries. - -\(fn &key SYNC BEG END (DISPLAY-RESULT t))" t nil) - -(autoload 'ejc-show-tables-list "ejc-sql" "\ -Output tables list." t nil) - -(autoload 'ejc-show-views-list "ejc-sql" "\ -Output views list." t nil) - -(autoload 'ejc-show-user-types-list "ejc-sql" "\ -Output user types list. - -\(fn &optional OWNER)" t nil) - -(autoload 'ejc-show-constraints-list "ejc-sql" "\ -Output constraints list. - -\(fn &optional OWNER TABLE)" t nil) - -(autoload 'ejc-show-procedures-list "ejc-sql" "\ -Output procedures list." t nil) - -(autoload 'ejc-get-temp-editor-buffer "ejc-sql" "\ - - -\(fn &optional NUM)" t nil) - -(autoload 'ejc-version "ejc-sql" "\ -Get the ejc-sql version as string." t nil) - -(register-definition-prefixes "ejc-sql" '("ejc-")) - -;;;*** - -;;;### (autoloads nil nil ("ejc-sql-pkg.el") (0 0 0 0)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; ejc-sql-autoloads.el ends here diff --git a/elpa/ejc-sql-20220414.1329/ejc-sql-pkg.el b/elpa/ejc-sql-20220414.1329/ejc-sql-pkg.el deleted file mode 100644 index 2d093006..00000000 --- a/elpa/ejc-sql-20220414.1329/ejc-sql-pkg.el +++ /dev/null @@ -1,16 +0,0 @@ -(define-package "ejc-sql" "20220414.1329" "Emacs SQL client uses Clojure JDBC." - '((emacs "26.3") - (clomacs "0.0.5") - (dash "2.16.0") - (spinner "1.7.3") - (direx "1.0.0")) - :commit "5c6341c751da9c7dbed43eafc8e99f456c1de0d2" :authors - '(("Kostafey" . "kostafey@gmail.com")) - :maintainer - '("Kostafey" . "kostafey@gmail.com") - :keywords - '("sql" "jdbc") - :url "https://github.com/kostafey/ejc-sql") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/ejc-sql-20220414.1329/ejc-sql.el b/elpa/ejc-sql-20220414.1329/ejc-sql.el deleted file mode 100644 index cc61da06..00000000 --- a/elpa/ejc-sql-20220414.1329/ejc-sql.el +++ /dev/null @@ -1,883 +0,0 @@ -;;; ejc-sql.el --- Emacs SQL client uses Clojure JDBC. -*- lexical-binding: t -*- - -;;; Copyright © 2012-2020 - Kostafey - -;; Author: Kostafey -;; URL: https://github.com/kostafey/ejc-sql -;; Keywords: sql, jdbc -;; Version: 0.4.1 -;; Package-Requires: ((emacs "26.3")(clomacs "0.0.5")(dash "2.16.0")(spinner "1.7.3")(direx "1.0.0")) - -;; This file is not part of GNU Emacs. - -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software Foundation, -;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ - -;;; Commentary: - -;; ejc-sql turns Emacs into simple SQL client, it uses JDBC connection to -;; databases via clojure/java.jdbc lib. - -;; See README.md for detailed description. - -;;; Code: - -(require 'sql) -(require 'dash) -(require 'cl-lib) -(require 'org-table) -(require 'ejc-lib) -(require 'ejc-direx) -(require 'ejc-eldoc) -(require 'ejc-format) -(require 'ejc-interaction) -(require 'ejc-result-mode) -(require 'ejc-result-buffer) -(require 'ejc-completion-common) - -(defvar-local ejc-db nil - "JDBC connection info for current SQL buffer.") - -(defvar ejc-connections nil - "List of existing configured jdbc connections") - -(defvar ejc-current-buffer-query nil - "Current SQL edit buffer lanched query.") - -(defcustom ejc-temp-editor-buffer-name "ejc-sql-editor" - "Template name for buffers used to ad-hoc edit SQL scripts." - :group 'ejc-sql - :type 'string) - -(defcustom ejc-temp-editor-file-path (expand-file-name "~/tmp/ejc-sql/") - "Directory to save temp ad-hoc SQL edit buffers contents." - :group 'ejc-sql - :type 'string) - -(defcustom ejc-keymap-prefix (kbd "C-c e") - "ejc-sql keymap prefix." - :group 'ejc-sql - :type 'string) - -(defcustom ejc-date-output-format "%d.%m.%Y %H:%M:%S" - "ejc-sql date output format." - :group 'ejc-sql - :type 'string) - -(defcustom ejc-connection-validate-timeout 5 - "The time in seconds to wait for the database connection validation." - :group 'ejc-sql - :type 'integer) - -(defcustom ejc-result-table-impl 'orgtbl-mode - "Set mode for result-set table. Possible values are one of: -'orgtbl-mode -'ejc-result-mode." - :group 'ejc-sql - :type 'symbol) - -(defcustom ejc-org-mode-babel-wrapper t - "Add wrapper around org-mode default `org-babel-execute:sql'." - :type 'boolean - :safe #'booleanp - :group 'ejc-sql) - -(defcustom ejc-org-mode-show-results t - "When t show SQL query results of `org-mode' code snippet in the same buffer. -An expected behaviour for `org-mode' users. Disable popup window with SQL -results. When nil, otherwise, provide `ejc-sql' users expected behaviour." - :group 'ejc-sql - :type 'boolean) - -(defcustom ejc-jdbc-drivers - '("sqlite" [org.xerial/sqlite-jdbc "3.23.1"] - "h2" [com.h2database/h2 "1.4.199"] - "mysql" [mysql/mysql-connector-java "5.1.44"] - "postgresql" [postgresql/postgresql "9.3-1102.jdbc41"] - "sqlserver" [com.microsoft.sqlserver/mssql-jdbc "6.2.2.jre8"] - "oracle" [com.oracle.jdbc/ojdbc8 "12.2.0.1"]) - "Artifacts used as JDBC drivers for each database type in Leiningen format." - :group 'ejc-sql - :type '(plist :key-type string :value-type (vector symbol string))) - -(defcustom ejc-completion-system 'ido - "The completion system used by `ejc-connect'." - :group 'ejc-sql - :type '(radio - (const :tag "Ido" ido) - (const :tag "Standard" standard) - (function :tag "Custom function"))) - -(defvar-local ejc-replace-double-quotes nil - "When t replace double quotes with single ones in SQL before evaluation.") - -(defvar ejc-sql-mode-keymap (make-keymap) "ejc-sql-mode keymap.") -(define-key ejc-sql-mode-keymap (kbd "C-c C-c") 'ejc-eval-user-sql-at-point) -(define-key ejc-sql-mode-keymap (kbd "C-c C-r") 'ejc-eval-user-sql-region) -(define-key ejc-sql-mode-keymap (kbd "C-h t") 'ejc-describe-table) -(define-key ejc-sql-mode-keymap (kbd "C-h d") 'ejc-describe-entity) -(define-key ejc-sql-mode-keymap (kbd "C-M-S-b") (lambda () (interactive) (ejc-previous-sql t))) -(define-key ejc-sql-mode-keymap (kbd "C-M-S-f") (lambda () (interactive) (ejc-next-sql t))) -(define-key ejc-sql-mode-keymap (kbd "C-M-b") 'ejc-previous-sql) -(define-key ejc-sql-mode-keymap (kbd "C-M-f") 'ejc-next-sql) -(define-key ejc-sql-mode-keymap (kbd "C-g") 'ejc-cancel-query) -(define-key ejc-sql-mode-keymap (kbd "M-.") 'ejc-describe-entity) -(define-key ejc-sql-mode-keymap (kbd "M-,") 'ejc-show-prev-result) -(define-key ejc-sql-mode-keymap (kbd ".") 'ejc-dot-pressed) - -(defvar ejc-command-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "c") #'ejc-connect) - (define-key map (kbd "i") #'ejc-connect-interactive) - (define-key map (kbd "") #'ejc-show-last-result) - (define-key map (kbd "t") #'ejc-show-tables-list) - (define-key map (kbd "v") #'ejc-show-views-list) - (define-key map (kbd "p") #'ejc-show-procedures-list) - (define-key map (kbd "T") #'ejc-show-user-types-list) - (define-key map (kbd "s") #'ejc-strinp-sql-at-point) - (define-key map (kbd "S") #'ejc-dress-sql-at-point) - (define-key map (kbd "f") #'ejc-format-sql-at-point) - map) - "Keymap for ejc-sql commands after `ejc-keymap-prefix'.") -(fset 'ejc-command-map ejc-command-map) - -(define-key ejc-sql-mode-keymap ejc-keymap-prefix 'ejc-command-map) - -(defvar ejc-sql-minor-mode-exit-hook nil - "*Functions to be called when `ejc-sql-mode' is exited.") - -(defvar ejc-sql-minor-mode-hook nil - "*Functions to be called when `ejc-sql-mode' is entered.") - -(defvar ejc-sql-connected-hook nil - "Hook run when nREPL started and some buffer connected to DataBase.") - -(defvar ejc-sql-complete-query-hook nil - "Hook run when SQL query executed and the result is outputted.") - -(defvar ejc-sql-mode nil) - -(defvar ejc-conn-statistics (list) - "Keep connection usage statistics and offer most frequently used first - when `ejc-connect' is called.") - -(defcustom ejc-conn-statistics-file (expand-file-name - "~/.ejc-sql/connection-statistics.el") - "Connection usage statistics data file location." - :group 'ejc-sql - :type 'string) - -(defface ejc-separator-face - '((t :inherit font-lock-function-name-face)) - "Face used to highlight SQL statement separators." - :group 'ejc-sql) - -(defun ejc-refresh-font-lock () - (funcall (if ejc-sql-mode - 'font-lock-add-keywords - 'font-lock-remove-keywords) - nil `((,(ejc-sql-separator-re) . 'ejc-separator-face))) - (if (fboundp 'font-lock-flush) - (font-lock-flush) - (when font-lock-mode - (with-no-warnings (font-lock-fontify-buffer))))) - -;;;###autoload -(define-minor-mode ejc-sql-mode - "Toggle ejc-sql mode." - :lighter " ejc" - :keymap ejc-sql-mode-keymap - :group 'ejc - :global nil - (if ejc-sql-mode - (progn - (ejc-create-menu) - (ejc-refresh-font-lock) - (run-hooks 'ejc-sql-minor-mode-hook)) - (progn - (ejc-refresh-font-lock) - (run-hooks 'ejc-sql-minor-mode-exit-hook)))) - -;;;###autoload -(defun ejc-create-menu () - (define-key-after - ejc-sql-mode-keymap - [menu-bar ejc-menu] - (cons "ejc-sql" (make-sparse-keymap "ejc-sql mode")) - 'tools ) - (define-key - ejc-sql-mode-keymap - [menu-bar ejc-menu ev] - '("Eval SQL" . ejc-eval-user-sql-at-point)) - (define-key - ejc-sql-mode-keymap - [menu-bar ejc-menu fs] - '("Format SQL" . ejc-format-sql-at-point)) - (define-key - ejc-sql-mode-keymap - [menu-bar ejc-menu ms] - '("Mark SQL" . ejc-mark-this-sql)) - (define-key - ejc-sql-mode-keymap - [menu-bar ejc-menu tl] - '("Show tables list" . ejc-show-tables-list)) - (define-key - ejc-sql-mode-keymap - [menu-bar ejc-menu cl] - '("Show constraints list" . ejc-show-constraints-list)) - (define-key - ejc-sql-mode-keymap - [menu-bar ejc-menu pl] - '("Show procedures list" . ejc-show-procedures-list)) - (define-key - ejc-sql-mode-keymap - [menu-bar ejc-menu ss] - '("Strip SQL" . ejc-strinp-sql-at-point)) - (define-key - ejc-sql-mode-keymap - [menu-bar ejc-menu ds] - '("Dress SQL" . ejc-dress-sql-at-point)) - (define-key - ejc-sql-mode-keymap - [menu-bar ejc-menu ol] - '("Open log" . ejc-open-log)) - (define-key - ejc-sql-mode-keymap - [menu-bar ejc-menu sl] - '("Show last result" . ejc-show-last-result)) - (define-key - ejc-sql-mode-keymap - [menu-bar ejc-menu qc] - '("Quit connection" . ejc-quit-connection))) - -(cl-defun ejc-create-connection (connection-name - &key - ;; ---------- - ;; DriverManager (preferred): - dbtype - dbname - host - port - ;; others (may include :user and :password) - ;; ---------- - ;; Raw: - connection-uri - ;; others (may include :user and :password) - ;; ---------- - ;; DriverManager (alternative / legacy style): - subprotocol - subname - ;; ---------- - ;; Others: - user - password - dependencies - classpath - separator - sslmode - ;; ---------- - ;; Optional: - classname) - "Add new connection configuration named CONNECTION-NAME. -It adds new connection to `ejc-connections' list or replace existing with the -same CONNECTION-NAME. -For more details about parameters see `get-connection' function in jdbc.clj: -`https://github.com/clojure/java.jdbc/blob/master/src/main/clojure/clojure/java/jdbc.clj'" - (setq ejc-connections - (-remove (lambda (x) (equal (car x) connection-name)) - ejc-connections)) - (setq ejc-connections - (cons (cons - connection-name - (let ((new-connection nil)) - (-map (lambda (arg) - (if (cdr arg) - (setq new-connection - (cons arg new-connection)))) - (list - (cons :dbtype dbtype) - (cons :dbname dbname) - (cons :host host) - (cons :port port) - (cons :connection-uri connection-uri) - (cons :subprotocol subprotocol) - (cons :subname subname) - (cons :user user) - (cons :password password) - (cons :dependencies dependencies) - (cons :classpath - (when classpath - (if (vectorp classpath) - (apply 'vector - (-map 'file-truename classpath)) - (vector (file-truename classpath))))) - (cons :separator separator) - (cons :sslmode sslmode) - (cons :classname classname))) - new-connection)) - ejc-connections))) - -(cl-defun ejc-completing-read (prompt choices &key initial-input) - "Present a PROMPT with CHOICES and optional INITIAL-INPUT." - (cond - ((eq ejc-completion-system 'ido) - (ido-completing-read prompt choices nil nil initial-input)) - ((eq ejc-completion-system 'standard) - (completing-read prompt choices nil nil initial-input)) - (t (funcall ejc-completion-system prompt choices)))) - -(defun ejc-read-file-name (prompt) - "Read file name, prompting with PROMPT." - (cond - ((eq ejc-completion-system 'ido) - (ido-read-file-name prompt)) - (t - (read-file-name prompt)))) - -(defun ejc-find-connection (connection-name) - "Return pair with name CONNECTION-NAME and db connection structure from -`ejc-connections'." - (-find (lambda (x) (equal (car x) connection-name)) - ejc-connections)) - -(defun ejc-load-conn-statistics () - "Load connection usage statistics to `ejc-conn-statistics' var." - (setq ejc-conn-statistics - (ejc-load-from-file ejc-conn-statistics-file - :default (list) - :check 'ejc-plist-p))) - -(defun ejc-update-conn-statistics (connection-name) - "Update connection usage statistics, persist it in `ejc-conn-statistics-file'" - (setq ejc-conn-statistics - (lax-plist-put - ejc-conn-statistics - connection-name - (1+ (or (lax-plist-get ejc-conn-statistics connection-name) 0)))) - (ejc-save-to-file ejc-conn-statistics-file ejc-conn-statistics)) - -(defun ejc-set-mode-name (connection-name) - "Show CONNECTION-NAME as part of `mode-name' in `mode-line'." - (setq mode-name (format "%s->[%s]" - (car (split-string mode-name "->\\[.+\\]")) - connection-name))) - -(cl-defun ejc-add-connection (&optional connection-name db) - "Add ejc connection information to current buffer. -If the current mode is `sql-mode' prepare buffer to operate as `ejc-sql-mode'." - (when (derived-mode-p 'sql-mode) - (sql-set-product (if db - (ejc-get-product-name db) - "ansi")) - (ejc-sql-mode t)) - (setq-local ejc-connection-name connection-name) - (setq-local ejc-db db) - (ejc-set-mode-name connection-name)) - -(defun ejc-eval-org-snippet (&optional orig-fun body params) - "Used to eval SQL code in `org-mode' code snippets." - (if (or (not ejc-org-mode-babel-wrapper) - (and (cdr (assq :engine params)) - (not - (yes-or-no-p - (concat "ejc-sql is enabled, ignore source block connection" - " header arguments and use ejc-sql to execute it? "))))) - (funcall orig-fun body params) - (cl-multiple-value-bind (beg end) (save-mark-and-excursion - (org-babel-mark-block) - (list (point) (mark))) - (ejc-eval-user-sql-at-point - :beg beg - :end end - :sync ejc-org-mode-show-results - :display-result (not ejc-org-mode-show-results)) - (if ejc-org-mode-show-results - (with-temp-buffer - (insert-file-contents (ejc-get-result-file-path)) - (buffer-string)))))) - -(defun ejc-org-edit-special (orig-fun &rest args) - (if (and (equal "sql" (car (org-babel-get-src-block-info))) - (boundp 'ejc-db) ejc-db - (boundp 'ejc-connection-name) ejc-connection-name) - (let* ((db ejc-db) - (connection-name ejc-connection-name)) - (apply orig-fun args) - (ejc-add-connection connection-name db)) - (apply orig-fun args))) - -(defun ejc-read-connection-name () - "Read connection-name in minibuffer." - (ejc-completing-read - "DataBase connection name: " - (let ((conn-list (mapcar 'car ejc-connections)) - (conn-statistics (ejc-load-conn-statistics))) - (-sort (lambda (c1 c2) - (> (or (lax-plist-get conn-statistics c1) 0) - (or (lax-plist-get conn-statistics c2) 0))) - conn-list)))) - -;;;###autoload -(defun ejc-insert-connection-data (connection-name) - "Insert configured connection data to keep it between Emacs restarts. -Assume to be evaluated somewhere in .emacs or any file, loaded as Emacs -configuration." - (interactive - (list (or (and (boundp 'connection-name) connection-name) - (ejc-read-connection-name)))) - (let ((connection-params (cdr (ejc-find-connection connection-name)))) - (insert - (format "(ejc-create-connection\n \"%s\"%s)" - connection-name - (-reduce-from - (lambda (result x) - (concat result - (format "\n %s \"%s\"" - (symbol-name (car x)) - (cdr x)))) - "" - connection-params))))) - -(defalias 'ejc-save-connection-data 'ejc-insert-connection-data) - -(defun ejc-resolve-jdbc-driver (dbtype) - "Resolve and download artifacts (JDBC drivers) for DBTYPE. -Apropriate artifacts list located in `ejc-jdbc-drivers'." - (let* ((artifact (lax-plist-get ejc-jdbc-drivers dbtype)) - (jar-path (ejc-lein-artifact-to-path artifact))) - (if (not (and (file-exists-p jar-path) - (if (> (file-attribute-size (file-attributes jar-path)) - 0) - t - ;; If JDBC driver jar file is accidentally empty - it - ;; should be deleted and reinstalled. - (progn (delete-file jar-path) - nil)))) - (ejc-resolve-dependencies - :coordinates (vector artifact) - :repositories '(("central" . "https://repo1.maven.org/maven2/") - ("clojars" . "https://clojars.org/repo")))) - jar-path)) - -;;;###autoload -(defun ejc-connect-interactive (connection-name) - "Create new connection interactively and connect to it." - (interactive - (list - (or (and (boundp 'connection-name) connection-name) - (read-string "DataBase new connection name: ")))) - (let* ((db-types '(("MySQL" . "mysql") - ("Oracle" . "oracle") - ("MS SQL Server" . "sqlserver") - ("H2" . "h2") - ("SQLite" . "sqlite") - ("PostgreSQL" . "postgresql"))) - (dbtype (cdr (assoc-string - (ejc-completing-read - "Database type: " - (cl-sort (-map 'car db-types) - 'string-lessp :key 'downcase)) - db-types))) - (properties - (-concat - (pcase dbtype - ("sqlite" - `((:subprotocol . "sqlite") - (:subname . ""))) - ("h2" - `((:subprotocol . "h2") - (:subname . ""))) - ("mysql" - `((:dbtype . "mysql") - (:classname . "com.mysql.jdbc.Driver") - (:dbname . "") - (:host . "localhost") - (:port . "3306"))) - ("postgresql" - `((:dbtype . "postgresql") - (:dbname . "") - (:host . "localhost") - (:port . "5432"))) - ("sqlserver" - `((:dbtype . "sqlserver") - (:dbname . "") - (:host . "localhost") - (:port . "1433"))) - ("oracle" - `((:dbtype . "oracle") - (:dbname . "") - (:host . "localhost") - (:port . "1521")))) - '((:classpath . "") - (:user . "") - (:password . "")))) - (args - (-reduce-from - (lambda (memo p) - (-concat - memo - (list - (car p) - (cl-case (car p) - (:dbtype (cdr p)) - (:classpath (ejc-resolve-jdbc-driver dbtype)) - (:classname (cdr p)) - (:subprotocol (cdr p)) - (:subname (if (member dbtype '("h2" "sqlite")) - (let ((fpath - (file-truename - (ejc-read-file-name "DB file: ")))) - (if (equal "h2" dbtype) - (concat "file://" - (file-name-sans-extension - (file-name-sans-extension - fpath)) - ";AUTO_SERVER=TRUE") - fpath)) - (read-string "DataBase subname: " (cdr p)))) - (:dbname (read-string "DataBase name: " (cdr p))) - (:host (read-string "Host: " (cdr p))) - (:port (read-string "Port: " (cdr p))) - (:user (read-string "User: ")) - (:password (read-passwd "Password: ")))))) - (list connection-name) - properties))) - (apply 'ejc-create-connection args) - (ejc-connect connection-name))) - -;;;###autoload -(defun ejc-connect (connection-name) - "Connect to selected db." - (interactive (list - (or (and (boundp 'connection-name) connection-name) - (ejc-read-connection-name)))) - (if-let ((db (cdr (ejc-find-connection connection-name)))) - (progn - (ejc-update-conn-statistics connection-name) - (ejc-add-connection connection-name db) - (when (derived-mode-p 'org-mode) - (require 'ob-sql) - (advice-add 'org-babel-execute:sql :around 'ejc-eval-org-snippet) - (advice-add 'org-edit-special :around #'ejc-org-edit-special)) - (message "Connection started...") - (clomacs-with-nrepl "ejc-sql" - (lambda (db connection-name) - (ejc-connect-to-db db) - (let ((validation-result - (ejc-validate-connection - :db db - :timeout ejc-connection-validate-timeout))) - (when (alist-get :status validation-result) - (ejc-set-mode-name connection-name) - (run-hooks 'ejc-sql-connected-hook) - (message (let ((msg (alist-get :message validation-result))) - (if (equal "Connected." msg) - (format - "Connected -> %s." - (propertize connection-name - 'face 'font-lock-keyword-face)) - msg)))))) - :params (list db connection-name))) - (ejc-connect-interactive connection-name))) - -;;;###autoload -(defun ejc-connect-existing-repl () - "Connect to existing ejc-sql nREPL running process. -You can `cd` to your ejc-sql project folder (typically -'~/.emacs.d/elpa/ejc-sql-') and launch nREPL via `lein repl`. -Then run in Emacs `ejc-connect-existing-repl', type HOST and PORT -from your `lein run` console output. Finally, use `ejc-connect' from -any SQL buffer to connect to exact database, as always. " - (interactive) - (let* ((params (cider-select-endpoint)) - (host (car params)) - (port (cdr params)) - (current-repl-b-name (cider-connect (list :host host :port port))) - (ejc-repl-b-name (nrepl-repl-buffer-name - (list - :session-name "ejc-sql" - :repl-type "clj" - :host host - :port port)))) - (with-current-buffer current-repl-b-name - (rename-buffer ejc-repl-b-name)))) - -(defun ejc-check-connection () - (unless (ejc-buffer-connected-p) - (error "Run M-x ejc-connect first!"))) - -(defun ejc-get-sql-from-string (sql) - (let* ((sql (replace-regexp-in-string ejc-clear-sql-regexp "" sql)) - (sql (if ejc-replace-double-quotes - (replace-regexp-in-string "\"" "'" sql) - sql))) - sql)) - -(defun ejc-add-outside-borders-p () - (cl-case ejc-result-table-impl - (orgtbl-mode t) - (ejc-result-mode nil))) - -(defun ejc-message-query-done (start-time status) - (message - "%s SQL query at %s. Exec time %.03f" - (cl-case status - (:done (propertize "Done" 'face 'font-lock-keyword-face)) - (:error (propertize "Error" 'face 'error)) - (:terminated (propertize "Terminated" 'face 'font-lock-keyword-face))) - (format-time-string ejc-date-output-format - (current-time)) - (float-time (time-since start-time)))) - -(defun ejc-spinner-stop () - "Stop spinner indicating current running query." - (if ejc-current-buffer-query - (with-current-buffer ejc-current-buffer-query - (spinner-stop)))) - -(cl-defun ejc-complete-query (result-file-path - &key - start-time - status - display-result - mode - connection-name - db - goto-symbol) - "Called by Clojure side, when SQL evaluation thread completes." - (ejc-spinner-stop) - (if result-file-path - (setq ejc-result-file-path result-file-path)) - (if display-result - (ejc-show-last-result :mode mode - :connection-name connection-name - :db db - :goto-symbol goto-symbol)) - (if (and start-time status) - (ejc-message-query-done start-time status)) - (run-hooks 'ejc-sql-complete-query-hook) - nil) - -(cl-defun ejc-cancel-query (&key start-time) - "Terminate current (long) running query. Aimed to cancel SELECT queries. -Unsafe for INSERT/UPDATE/CREATE/ALTER queries." - (interactive) - (ejc-spinner-stop) - (if (and (clomacs-get-connection "ejc-sql") - (ejc--is-query-running-p)) - (let ((start-time (or start-time (ejc--cancel-query)))) - (ejc-message-query-done start-time :terminated)) - (keyboard-quit))) - -(defun ejc-get-prompt-symbol-under-point (msg) - "Read user typed string from minibuffer. -MSG is a first part of the prompt message. The second optional part in -brackets is a symbol under point (cursor). Return a list of two items: -(schema|owner db-entity)." - (let* ((prefix (if (not mark-active) - (ejc-get-prefix-word))) - (sql-symbol (if mark-active - (buffer-substring (mark) (point)) - (ejc-get-word-at-point (point)))) - (enable-recursive-minibuffers t) - (typed-string (read-string - (if sql-symbol - (format "%s (default %s): " - msg - (if prefix - (format "%s.%s" prefix sql-symbol) - sql-symbol)) - (format "%s: " msg))))) - (if (equal typed-string "") - (list prefix sql-symbol) - (let ((split-typed-string (split-string typed-string "\\."))) - (if (cadr split-typed-string) - split-typed-string - (list nil typed-string)))))) - -(defun ejc-describe-table (prefix table-name) - "Describe SQL table TABLE-NAME (default table name - word around the point)." - (interactive (ejc-get-prompt-symbol-under-point "Describe table")) - (ejc-check-connection) - (ejc--describe-table :db ejc-db - :connection-name ejc-connection-name - :table table-name - :owner prefix - :result-file (ejc-next-result-file-path) - :add-outside-borders (ejc-add-outside-borders-p))) - -(defun ejc-describe-entity (prefix entity-name) - "Describe SQL entity ENTITY-NAME - function, procedure, type or view - (default entity name - word around the point)." - (interactive (ejc-get-prompt-symbol-under-point "Describe entity")) - (ejc-check-connection) - (ejc-get-entity-description :db ejc-db - :connection-name ejc-connection-name - :prefix prefix - :entity-name entity-name - :result-file (ejc-next-result-file-path))) - -(cl-defun ejc-eval-user-sql (sql &key - db - rows-limit - fetch-size - column-width-limit - append - sync - display-result - result-file) - "User starts SQL evaluation process." - (message "Processing SQL query...") - (when sql - (spinner-start 'rotating-line) - (setq ejc-current-buffer-query (current-buffer)) - (let* ((prepared-sql (ejc-get-sql-from-string sql))) - (ejc--eval-sql-and-log-print - (or db ejc-db) - prepared-sql - :start-time (current-time) - :rows-limit rows-limit - :fetch-size fetch-size - :column-width-limit column-width-limit - :append append - :sync sync - :display-result display-result - :result-file (or result-file - (ejc-next-result-file-path)) - :add-outside-borders (ejc-add-outside-borders-p))))) - -;;;###autoload -(defun ejc-eval-user-sql-region (beg end) - "Evaluate SQL bounded by the selection area." - (interactive "r") - (ejc-check-connection) - (let ((sql (buffer-substring beg end))) - (ejc-eval-user-sql sql - :display-result t)) - (if (region-active-p) - (deactivate-mark))) - -;;;###autoload -(cl-defun ejc-eval-user-sql-at-point (&key - sync - beg - end - (display-result t)) - "Evaluate SQL bounded by the `ejc-sql-separator' or/and buffer -boundaries." - (interactive) - (ejc-check-connection) - (ejc-flash-this-sql :beg beg - :end end) - (ejc-eval-user-sql (ejc-get-sql-at-point :beg beg :end end) - :sync sync - :display-result display-result)) - -;;;###autoload -(defun ejc-show-tables-list () - "Output tables list." - (interactive) - (ejc-check-connection) - (ejc-eval-user-sql - (ejc-select-db-meta-script ejc-db :all-tables) - :rows-limit 0 - :fetch-size 0 - :column-width-limit 0 - :display-result t)) - -;;;###autoload -(defun ejc-show-views-list () - "Output views list." - (interactive) - (ejc-check-connection) - (ejc-eval-user-sql - (ejc-select-db-meta-script ejc-db :views) - :rows-limit 0 - :column-width-limit 0 - :display-result t)) - -;;;###autoload -(defun ejc-show-user-types-list (&optional owner) - "Output user types list." - (interactive) - (ejc-check-connection) - (ejc-eval-user-sql (ejc-select-db-meta-script ejc-db :types - :owner owner))) - -;;;###autoload -(defun ejc-show-constraints-list (&optional owner table) - "Output constraints list." - (interactive) - (ejc-check-connection) - (ejc-eval-user-sql (ejc-select-db-meta-script ejc-db :constraints - :owner owner - :table table))) - -;;;###autoload -(defun ejc-show-procedures-list () - "Output procedures list." - (interactive) - (ejc-check-connection) - (ejc-eval-user-sql - (ejc-select-db-meta-script ejc-db :procedures - :owner (ejc-get-this-owner ejc-db)) - :rows-limit 0 - :column-width-limit 0 - :display-result t)) - -;;;###autoload -(defun ejc-get-temp-editor-buffer (&optional num) - (interactive "P") - "Switch to buffer dedicated to ad-hoc edit and SQL scripts. -If the buffer is not exists - create it. -Buffer can be saved to file with `ejc-temp-editor-file' path." - (let* ((tmp-file-name (if num - (format "%s-%s" - ejc-temp-editor-buffer-name - (if (numberp num) - (int-to-string num) - num)) - ejc-temp-editor-buffer-name)) - (tmp-file-path (progn - (unless (file-exists-p ejc-temp-editor-file-path) - (make-directory ejc-temp-editor-file-path t)) - (expand-file-name (concat tmp-file-name ".sql") - ejc-temp-editor-file-path))) - (tmp-buffer-name (format "*%s*" tmp-file-name))) - (if (get-buffer tmp-buffer-name) - (switch-to-buffer tmp-buffer-name) - (progn - (find-file tmp-file-path) - (rename-buffer tmp-buffer-name) - (sql-mode) - (auto-fill-mode t) - (ejc-add-connection) - (get-buffer tmp-buffer-name))))) - -(defun ejc-open-log () - (interactive) - (find-file-read-only (ejc-get-log-file-path)) - (goto-char (point-max))) - -;;;###autoload -(defun ejc-version () - "Get the ejc-sql version as string." - (interactive) - (if (require 'pkg-info nil t) - (message "ejc-sql %s" (pkg-info-version-info 'ejc-sql)) - (error "Cannot determine version without package pkg-info"))) - -(provide 'ejc-sql) - -;;; ejc-sql.el ends here diff --git a/elpa/ejc-sql-20220414.1329/project.clj b/elpa/ejc-sql-20220414.1329/project.clj deleted file mode 100644 index f7f0d493..00000000 --- a/elpa/ejc-sql-20220414.1329/project.clj +++ /dev/null @@ -1,13 +0,0 @@ -(defproject ejc-sql "0.4.1-SNAPSHOT" - :description "Interact with database via java/clojure libs to run SQL scripts" - :url "https://github.com/kostafey/ejc-sql" - :license {:name "GPL 2.0+" - :url "http://www.gnu.org/licenses/old-licenses/gpl-2.0.html"} - :dependencies [[org.clojure/clojure "1.9.0"] - [org.clojure/java.jdbc "0.7.10"] - [org.hibernate/hibernate-core "5.4.1.Final"] - [com.cemerick/pomegranate "1.1.0"] - [leiningen-core "2.9.3"] - [org.apache.commons/commons-lang3 "3.5"] - [org.apache.httpcomponents/httpclient "4.5.5"] - [clomacs "0.0.4-SNAPSHOT"]]) diff --git a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/alter.yasnippet b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/alter.yasnippet deleted file mode 100644 index 77a047ed..00000000 --- a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/alter.yasnippet +++ /dev/null @@ -1,6 +0,0 @@ -# -*- mode: snippet -*- -# name: altertable -# key: altertable -# -- -ALTER TABLE ${1:table} - ADD ${2:column_name} ${3:column_definition} diff --git a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/begin.snippet b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/begin.snippet deleted file mode 100644 index 346dff8b..00000000 --- a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/begin.snippet +++ /dev/null @@ -1,7 +0,0 @@ -# -*- mode: snippet -*- -# name: begin -# key: begin -# -- -BEGIN - $0 -END; \ No newline at end of file diff --git a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/delete.yasnippet b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/delete.yasnippet deleted file mode 100644 index 27cc2af9..00000000 --- a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/delete.yasnippet +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: delete -# key: delete -# -- -DELETE FROM ${1:table_name} WHERE ${2:where_stmt} \ No newline at end of file diff --git a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/grant.yasnippet b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/grant.yasnippet deleted file mode 100644 index 42611f4c..00000000 --- a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/grant.yasnippet +++ /dev/null @@ -1,7 +0,0 @@ -# -*- mode: snippet -*- -# name: grant -# key: grant -# -- -GRANT ALL PRIVILEGES - ON ${1:object_type} - TO ${2:user}; \ No newline at end of file diff --git a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/inner.yasnippet b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/inner.yasnippet deleted file mode 100644 index 44e85d94..00000000 --- a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/inner.yasnippet +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: inner -# key: inner -# -- -INNER JOIN ${1:table_name} ON $2 \ No newline at end of file diff --git a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/insert.yasnippet b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/insert.yasnippet deleted file mode 100644 index b38c3ebb..00000000 --- a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/insert.yasnippet +++ /dev/null @@ -1,6 +0,0 @@ -# -*- mode: snippet -*- -# name: insert -# key: insert -# -- -INSERT INTO ${1:table_name} (${2:column1}, ${3:column2}) -VALUES ($0value1, value2) \ No newline at end of file diff --git a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/left.yasnippet b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/left.yasnippet deleted file mode 100644 index aa0d7277..00000000 --- a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/left.yasnippet +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: left -# key: left -# -- -LEFT JOIN ${1:table_name} ON $2 \ No newline at end of file diff --git a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/revoke.yasnippet b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/revoke.yasnippet deleted file mode 100644 index 2fa27e7e..00000000 --- a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/revoke.yasnippet +++ /dev/null @@ -1,7 +0,0 @@ -# -*- mode: snippet -*- -# name: revoke -# key: revoke -# -- -REVOKE ALL PRIVILEGES - ON ${1:object_type} - FROM ${2:user}; \ No newline at end of file diff --git a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/right.yasnippet b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/right.yasnippet deleted file mode 100644 index fef03b27..00000000 --- a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/right.yasnippet +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: right -# key: right -# -- -RIGHT JOIN ${1:table_name} ON $2 \ No newline at end of file diff --git a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/select.yasnippet b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/select.yasnippet deleted file mode 100644 index 4e5fe935..00000000 --- a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/select.yasnippet +++ /dev/null @@ -1,7 +0,0 @@ -# -*- mode: snippet -*- -# name: select -# key: select -# -- -SELECT `(if (eq sql-product 'sqlserver) "first 20 ")`* -FROM ${1:table_name} -WHERE `(if (eq sql-product 'oracle) "rownum < 20\n AND ")`${2:where_stmt} \ No newline at end of file diff --git a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/update.yasnippet b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/update.yasnippet deleted file mode 100644 index 5f15e73f..00000000 --- a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/update.yasnippet +++ /dev/null @@ -1,7 +0,0 @@ -# -*- mode: snippet -*- -# name: update -# key: update -# -- -UPDATE ${1:table_name} -SET ${2:column1} = ${3:value}, ${4:column2} = ${5:value} -WHERE ${6:some_column} = ${7:some_value} \ No newline at end of file diff --git a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/where.yasnippet b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/where.yasnippet deleted file mode 100644 index 13d87f2f..00000000 --- a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/where.yasnippet +++ /dev/null @@ -1,5 +0,0 @@ -# -*- mode: snippet -*- -# name: where -# key: where -# -- -WHERE `(if (eq sql-product 'oracle) "rownum < 20\n AND ")`${2:where_stmt} \ No newline at end of file diff --git a/elpa/ejc-sql-20220414.1329/src/ejc_sql/cache.clj b/elpa/ejc-sql-20220414.1329/src/ejc_sql/cache.clj deleted file mode 100644 index 89a86258..00000000 --- a/elpa/ejc-sql-20220414.1329/src/ejc_sql/cache.clj +++ /dev/null @@ -1,84 +0,0 @@ -;;; cache.clj -- Keep database stucture cache. - -;;; Copyright © 2019 - Kostafey - -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software Foundation, -;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ - -(ns ejc-sql.cache - (:use [clomacs])) - -(def cache - "Keep information about structure of databases used for autocomplete & eldoc. - This data contains (depends on database type): - ├── owners/schemas - | ├── tables - | | └── columns - | └── views - ├── packages - | └── stored procedures & functions - | └── parameters - └── keywords - It's global: same database structure information shared beetween - different buffers connected to the same database." - (atom {})) - -(def cache-creation-promises - "Signs of database structure cache created." - (atom {})) - -(defn get-cache - "Get actual cache." - [] - @cache) - -(defn deref-cache [db] - [db - (into - {} - (map - (fn [entity-k] - [entity-k - (let [item (get-in (get-cache) [db entity-k])] - (if (future? item) - (deref item) - (if (map? item) - (into - {} - (map - (fn [sub-entity-k] - [sub-entity-k - (let [sub-item (get-in (get-cache) - [db entity-k sub-entity-k])] - (if (future? sub-item) - (deref sub-item) - sub-item))]) - (keys item))) - item)))]) - (keys - ((get-cache) db))))]) - -(defn output-cache - "Output actual cache to printable format." - [db] - (clomacs/format-result - (if db - (second (deref-cache db)) - (into {} (map deref-cache (keys (get-cache))))))) - -(defn invalidate-cache - "Clean your current connection cache (database owners and tables list)." - [db] - (swap! cache assoc-in [db] nil) - (swap! cache-creation-promises assoc-in [db] nil)) diff --git a/elpa/ejc-sql-20220414.1329/src/ejc_sql/classpath.clj b/elpa/ejc-sql-20220414.1329/src/ejc_sql/classpath.clj deleted file mode 100644 index 311b7944..00000000 --- a/elpa/ejc-sql-20220414.1329/src/ejc_sql/classpath.clj +++ /dev/null @@ -1,66 +0,0 @@ -;; Version of `add-classpath` imlementation from Kaocha project. -;; https://github.com/lambdaisland/kaocha/blob/master/src/kaocha/classpath.clj - -(ns ejc-sql.classpath - "This is the add-classpath function from Pomegranate 1.0.0, extracted so we - don't need to pull in Aether." - (:refer-clojure :exclude [add-classpath]) - (:require [dynapath.util :as dp] - [clojure.java.io :as io])) - -(def new-jdk - (>= (BigDecimal. (System/getProperty "java.specification.version")) 1.9)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Pomegranate - -(defn ensure-compiler-loader - "Ensures the clojure.lang.Compiler/LOADER var is bound to a DynamicClassLoader, - so that we can add to Clojure's classpath dynamically." - [] - (when-not (bound? Compiler/LOADER) - (.bindRoot Compiler/LOADER (clojure.lang.DynamicClassLoader. (clojure.lang.RT/baseLoader))))) - -(defn- classloader-hierarchy - "Returns a seq of classloaders, with the tip of the hierarchy first. - Uses the current thread context ClassLoader as the tip ClassLoader - if one is not provided." - ([] - (if new-jdk - (ensure-compiler-loader) - (classloader-hierarchy (.. Thread currentThread getContextClassLoader))) - (classloader-hierarchy (deref clojure.lang.Compiler/LOADER))) - ([tip] - (->> tip - (iterate #(.getParent %)) - (take-while boolean)))) - -(defn- modifiable-classloader? - "Returns true iff the given ClassLoader is of a type that satisfies - the dynapath.dynamic-classpath/DynamicClasspath protocol, and it can - be modified." - [cl] - (dp/addable-classpath? cl)) - -(defn add-classpath - "A corollary to the (deprecated) `add-classpath` in clojure.core. This implementation - requires a java.io.File or String path to a jar file or directory, and will attempt - to add that path to the right classloader (with the search rooted at the current - thread's context classloader)." - ([jar-or-dir classloader] - (if-not (dp/add-classpath-url classloader (.toURL (.toURI (io/file jar-or-dir)))) - (throw (IllegalStateException. (str classloader " is not a modifiable classloader"))))) - ([jar-or-dir] - (let [classloaders (classloader-hierarchy)] - (if-let [cl (if new-jdk - (filter modifiable-classloader? classloaders) - (last (filter modifiable-classloader? classloaders)))] - ;; Add to all classloaders that allow it. Brute force but doesn't hurt. - (if new-jdk - (run! #(add-classpath jar-or-dir %) cl) - (add-classpath jar-or-dir cl)) - (throw (IllegalStateException. (str "Could not find a suitable classloader to modify from " - classloaders))))))) - -;; /Pomegranate -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/elpa/ejc-sql-20220414.1329/src/ejc_sql/connect.clj b/elpa/ejc-sql-20220414.1329/src/ejc_sql/connect.clj deleted file mode 100644 index 4ce4019d..00000000 --- a/elpa/ejc-sql-20220414.1329/src/ejc_sql/connect.clj +++ /dev/null @@ -1,335 +0,0 @@ -;;; connect.clj -- Core clojure functions for ejc-sql emacs extension. - -;;; Copyright © 2013-2019 - Kostafey - -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software Foundation, -;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ - -(ns ejc-sql.connect - (:use [clojure.java.io] - [ejc-sql.lib] - [ejc-sql.cache] - [clomacs]) - (:require [clojure.java.jdbc :as j] - [clojure.java.io :as io] - [clojure.string :as s] - [ejc-sql.output :as o]) - (:import [java.sql Connection - DriverManager - PreparedStatement - ResultSet - SQLException] - [java.io File])) - -(def db - "DataBase connection properties list from the last transaction. -For debug purpose." - (atom nil)) - -(def current-query - "Current running query data." - (atom {})) - -(defn set-db [ejc-db] - (reset! db ejc-db)) - -(defn handle-special-cases [db sql] - (case (:subprotocol db) - "oracle" (case (clojure.string/upper-case sql) - "SHOW ERRORS" (str "SELECT line, position, sequence, text - FROM all_errors - WHERE type = 'FUNCTION' - AND name = 'FILTERDICT' - AND attribute != 'WARNING' - AND owner = '" (:user db) "' - ORDER BY line, position, sequence") - sql) - sql)) - -(defn is-statement-not-closed? [] - (let [stmt (:stmt @current-query)] - (and (not (nil? stmt)) - (not (.isClosed stmt))))) - -(defn is-query-process-running? [] - (let [runner (:runner @current-query)] - (and - (not (nil? runner)) - (not (future-done? runner)) - (not (future-cancelled? runner))))) - -(defn is-query-running? [] - (or (is-statement-not-closed?) - (is-query-process-running?))) - -(defn cancel-query - "Terminate current (long) running query. Aimed to cancel SELECT queries. - Unsafe for INSERT/UPDATE/CREATE/ALTER queries." - [] - (future - (if (is-statement-not-closed?) - (let [conn (:conn @current-query)] - (try - (.rollback conn) - (finally - (.close conn))))) - (if (is-query-process-running?) - (future-cancel (:runner @current-query)))) - (:start-time @current-query)) - -(defn validate-connection [& {:keys [db timeout] - :or {db @ejc-sql.connect/db - timeout 5}}] - (letfn [(abstract-is-valid [msg] - (clomacs/format-result - {:status true - :message (str "Warning: can't validate connection. " - "Please, update your JDBC driver and " - "restart the REPL.\n" - msg)}))] - (try - (clomacs/format-result - {:status (.isValid (j/get-connection db) timeout) - :message "Connected."}) - (catch AbstractMethodError e - (abstract-is-valid (.getMessage e))) - (catch java.sql.SQLFeatureNotSupportedException e - (abstract-is-valid (.getMessage e)))))) - -(defn get-separator-re - "Handle cases where separator is a part of string in SQL query. -E.g. you can use default separator char `/` in this query: -SELECT * FROM urls WHERE path like '%http://localhost%'" - [separator] - (re-pattern - (format - "%s(? @o/max-rows 0) - @o/show-too-many-rows-message) - ;; Get one more row to recognize that - ;; the actual number of records from this - ;; query is bigger than `max-rows`. - (+ @o/max-rows 1) - @o/max-rows) - 0)})] - (swap! current-query assoc - :stmt stmt - :conn conn) - (j/query db stmt - {:as-arrays? true - :result-set-fn - (fn [rs] - (let [single-record? - (not (next (next rs)))] - (mapv - #(clob-to-string-row - % single-record?) - rs)))})))) - (let [result (first (j/execute! db (list sql))) - msg (if (> result 0) - (str "Records affected: " result) - "Executed")] - (if (ddl? sql) - (invalidate-cache db)) - (list :message msg))) - (catch SQLException e - (list :message - (o/unify-str "Error: " (.getMessage e)))))) - -(defn- eval-user-sql [db sql & {:keys [rows-limit - fetch-size - append - display-result - result-file]}] - "Receive raw SQL from the user, log it, divide by statements and eval them." - (let [sql (s/trim sql) - _ (do (o/log-sql (str sql "\n")) - (o/clear-result-file :result-file result-file)) - [sql - manual-separator] (if (s/starts-with? (s/lower-case sql) "delimiter") - ;; User defined statement separator manually - ;; before SQL expression. - ;; Remove `delimiter` command from SQL expression. - [(s/trim (s/replace-first sql delimiter-re "")) - (second (re-find delimiter-re sql))] - [sql nil]) - sql (handle-special-cases db sql) - statement-separator-re (get-separator-re (or manual-separator ";")) - results (doall - (for [sql-part (filter - ;; Remove parts contains comments only. - (fn [part] - (not (empty? - (s/trim - (s/replace part comments-re ""))))) - (if (or (not (:separator db)) manual-separator) - (s/split sql statement-separator-re) - [sql]))] - (let [[result-type result] (eval-sql-core :db db - :sql sql-part - :max-rows rows-limit - :fetch-size fetch-size)] - (if (= result-type :result-set) - (o/print-table result fetch-size) - (println result)) - [result-type result])))] - (complete - nil - :start-time (:start-time @current-query) - :status (if (or - (every? (fn [[result-type result]] - (= result-type :result-set)) - results) - (not (some (fn [[result-type result]] - (and - (not (= result-type :result-set)) - (s/starts-with? (s/lower-case result) - "error"))) - results))) - :done - (if (and - (= (count results) 1) - (some (fn [[result-type result]] - (.contains (s/lower-case result) - "closed connection")) - results)) - :terminated - :error)) - :display-result display-result - :result-file result-file))) - -(defn eval-sql-and-log-print - "Write SQL to log file, evaluate it and print result." - [db sql & {:keys [rows-limit - fetch-size - column-width-limit - append - start-time - sync - display-result - result-file - add-outside-borders] - :or {append false - sync false - display-result true - add-outside-borders true}}] - (letfn [(run-query [] - (try - (with-open [out (io/writer result-file)] - (binding [*out* out - o/*add-outside-borders* add-outside-borders - *max-column-width* (or column-width-limit - @o/column-width-limit)] - (eval-user-sql db sql - :rows-limit rows-limit - :fetch-size fetch-size - :append append - :display-result display-result - :result-file result-file))) - (catch Exception e - (complete - (str (.getMessage e) "\n" - (s/join "\n" (.getStackTrace e))) - :start-time (:start-time @current-query) - :status :error - :display-result true))))] - (if sync - (run-query) - (swap! current-query assoc - :runner (future (run-query)) - :start-time start-time)))) - -(defn query-meta - "Get metadata for `sql` result dataset." - [db sql] - (try - {:success true - :result (j/db-query-with-resultset - db - [(str "SELECT nodata.* " - "FROM (" sql ") nodata " - "WHERE 0 = 1")] - (fn [rs] - (let [rs-meta (.getMetaData rs) - col-count (.getColumnCount rs-meta)] - (mapv (fn [i] - {:name (.getColumnLabel rs-meta i) - :type (.getColumnTypeName rs-meta i)}) - (range 1 (+ 1 col-count))))))} - (catch SQLException e - {:success false - :result (str "Error: " (.getMessage e))}))) - -(defn table-meta - [db table-name] - (set-db db) - (query-meta db (str "SELECT * FROM " table-name))) diff --git a/elpa/ejc-sql-20220414.1329/src/ejc_sql/deps_resolver.clj b/elpa/ejc-sql-20220414.1329/src/ejc_sql/deps_resolver.clj deleted file mode 100644 index 2911400c..00000000 --- a/elpa/ejc-sql-20220414.1329/src/ejc_sql/deps_resolver.clj +++ /dev/null @@ -1,67 +0,0 @@ -;;; deps_resolver.clj -- Discover required jar artifacts. - -;;; Copyright © 2020 - Kostafey - -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software Foundation, -;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ - -(ns ejc-sql.deps-resolver - (:use - [leiningen.core.project :only [default-repositories]]) - (:require - [cemerick.pomegranate.aether :as aether])) - -(defn get-hierarchy [artifacts-list] - (aether/dependency-hierarchy - artifacts-list - (aether/resolve-dependencies - :coordinates artifacts-list - :repositories default-repositories))) - -(def artifacts (atom (list))) - -(defn art-wanderer [art] - (if (and - (coll? art) - (vector? art) - (not (coll? (nth art 0)))) - (swap! artifacts conj art) - (dorun (map art-wanderer art)))) - -(defn run-wanderer [art] - (reset! artifacts (list)) - (dorun (map art-wanderer art)) - @artifacts) - -(defn get-dependeces-list - "Get artifacts dependeces hierarchy as a flatten list." - [artifacts-list] - (-> artifacts-list get-hierarchy run-wanderer)) - -(defn get-dependeces-files-list - "Resolve dependeces and return a list of all requred jar files paths. - `artifacts-list` is a leningen dependeces vector. - E.g. '[[com.ibm.informix/jdbc \"4.50.3\"]]." - [artifacts-list] - (try - (map - (fn [dep-file] (.getPath dep-file)) - (flatten - (map - aether/dependency-files - (map - (fn [dep] (get-hierarchy (vector dep))) - (get-dependeces-list artifacts-list))))) - (catch Exception e - nil))) diff --git a/elpa/ejc-sql-20220414.1329/src/ejc_sql/keywords.clj b/elpa/ejc-sql-20220414.1329/src/ejc_sql/keywords.clj deleted file mode 100644 index 6b4ae77c..00000000 --- a/elpa/ejc-sql-20220414.1329/src/ejc_sql/keywords.clj +++ /dev/null @@ -1,38 +0,0 @@ -;;; keywords.clj -- Keep database-specific keywords. - -;;; Copyright © 2019 - Kostafey - -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software Foundation, -;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ - -(ns ejc-sql.keywords) - -(def keywords - {:sqlite - ["ABORT" "ACTION" "ADD" "AFTER" "ALL" "ALTER" "ANALYZE" "AND" "AS" "ASC" "ATTACH" - "AUTOINCREMENT" "BEFORE" "BEGIN" "BETWEEN" "BY" "CASCADE" "CASE" "CAST" "CHECK" - "COLLATE" "COLUMN" "COMMIT" "CONFLICT" "CONSTRAINT" "CREATE" "CROSS" "CURRENT" - "CURRENT_DATE" "CURRENT_TIME" "CURRENT_TIMESTAMP" "DATABASE" "DEFAULT" - "DEFERRABLE" "DEFERRED" "DELETE" "DESC" "DETACH" "DISTINCT" "DO" "DROP" "EACH" - "ELSE" "END" "ESCAPE" "EXCEPT" "EXCLUSIVE" "EXISTS" "EXPLAIN" "FAIL" "FILTER" - "FOLLOWING" "FOR" "FOREIGN" "FROM" "FULL" "GLOB" "GROUP" "HAVING" "IF" "IGNORE" - "IMMEDIATE" "IN" "INDEX" "INDEXED" "INITIALLY" "INNER" "INSERT" "INSTEAD" - "INTERSECT" "INTO" "IS" "ISNULL" "JOIN" "KEY" "LEFT" "LIKE" "LIMIT" "MATCH" - "NATURAL" "NO" "NOT" "NOTHING" "NOTNULL" "NULL" "OF" "OFFSET" "ON" "OR" "ORDER" - "OUTER" "OVER" "PARTITION" "PLAN" "PRAGMA" "PRECEDING" "PRIMARY" "QUERY" "RAISE" - "RANGE" "RECURSIVE" "REFERENCES" "REGEXP" "REINDEX" "RELEASE" "RENAME" "REPLACE" - "RESTRICT" "RIGHT" "ROLLBACK" "ROW" "ROWS" "SAVEPOINT" "SELECT" "SET" "TABLE" - "TEMP" "TEMPORARY" "THEN" "TO" "TRANSACTION" "TRIGGER" "UNBOUNDED" "UNION" - "UNIQUE" "UPDATE" "USING" "VACUUM" "VALUES" "VIEW" "VIRTUAL" "WHEN" "WHERE" - "WINDOW" "WITH" "WITHOUT"]}) diff --git a/elpa/ejc-sql-20220414.1329/src/ejc_sql/lib.clj b/elpa/ejc-sql-20220414.1329/src/ejc_sql/lib.clj deleted file mode 100644 index 3b5496f0..00000000 --- a/elpa/ejc-sql-20220414.1329/src/ejc_sql/lib.clj +++ /dev/null @@ -1,139 +0,0 @@ -;;; lib.clj -- Misc clojure functions for ejc-sql emacs extension. - -;;; Copyright © 2013-2019 - Kostafey - -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software Foundation, -;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ - -(ns ejc-sql.lib - (:require [clojure.string :as s] - [clojure.reflect :refer [resolve-class]])) - -(def ^:dynamic *max-column-width* 30) - -(def windows? - "The value is true if it runs under the os Windows." - (>= 0 (.indexOf (System/getProperty "os.name") "Windows"))) - -(defn in? - "true if `seq` contains `elm`. - Search case insensitive wthen `case-sensitive` is false." - [seq elm & {:keys [case-sensitive] :or {case-sensitive true}}] - (when (and elm seq) - (if (not case-sensitive) - (in? (mapv s/lower-case seq) (s/lower-case elm)) - (some #(= elm %) seq)))) - -(defn get->in - "Case insensitive `get-in` for last key in sequence." - [obj path & {:keys [case-sensitive] :or {case-sensitive false}}] - (if case-sensitive - (get-in obj path) - (get-in obj - (conj (into [] (butlast path)) - (last path)) - (get-in obj - (conj (into [] (butlast path)) - (s/upper-case (last path))) - (get-in obj - (conj (into [] (butlast path)) - (s/lower-case (last path)))))))) - -(defn simple-join [n s] - (s/join - (for [_ (range 0 n)] s))) - -(defn class-exists? [c] - (resolve-class (.getContextClassLoader (Thread/currentThread)) c)) - -(defn is-clob? [x] - (or (instance? java.sql.Clob x) - (and (class-exists? 'oracle.sql.CLOB) - (instance? (Class/forName "oracle.sql.CLOB") x)))) - -(defn clob-to-string - "Turn an Oracle Clob into a String" - ([clob] - (clob-to-string clob true)) - ([clob single-record?] - (with-open [rdr (java.io.BufferedReader. (.getCharacterStream clob))] - (if (or single-record? (not *max-column-width*)) - (apply str (line-seq rdr)) - ;; Show only first `*max-column-width*` (30 by default) symbols - ;; of Clob field. If longer, replace last 3 symbols by dots. - (let [result (apply str (take (+ *max-column-width* 1) - (mapcat seq (line-seq rdr))))] - (if (> (count result) *max-column-width*) - (str (subs result 0 (- *max-column-width* 3)) "...") - result)))))) - -(defn clob-to-string-row - "Check all data in row if it's a CLOB and convert CLOB to string." - [row single-record?] - (mapv (fn [field] - (if (is-clob? field) - (clob-to-string field single-record?) - field)) - row)) - -(defn clean-sql [sql] - (-> sql - (s/replace #"(--).*\n" "") - (s/replace #"( )|( \t)|\t" " ") - (s/replace "^\n" "") - s/trim)) - -(def select-words - '("SELECT" - "SHOW" - "WITH" - "EXPLAIN")) - -(def dml-words - (concat - select-words - '("INSERT" - "UPDATE" - "DELETE"))) - -(def ddl-words - '("CREATE" - "ALTER" - "DROP" - "RENAME")) - -(defn determine-query - "Determine if current SQL starts with one of the words from `words` list." - [sql words] - (let [sql (clean-sql sql) - ignore-set #{\( \[} - pos (loop [pos 0] - (if (ignore-set (get sql pos)) - (recur (inc pos)) - pos)) - sql (s/upper-case (subs sql pos))] - (first (filter (fn [w] (s/starts-with? sql w)) words)))) - -(defn select? [sql] - (determine-query sql select-words)) - -(defn dml? - "Determine if current SQL is Data Manipulation Language (DML) case." - [sql] - (determine-query sql dml-words)) - -(defn ddl? - "Determine if current SQL is Data Definition Language (DDL) case." - [sql] - (determine-query sql ddl-words)) diff --git a/elpa/ejc-sql-20220414.1329/src/ejc_sql/output.clj b/elpa/ejc-sql-20220414.1329/src/ejc_sql/output.clj deleted file mode 100644 index 86fa9950..00000000 --- a/elpa/ejc-sql-20220414.1329/src/ejc_sql/output.clj +++ /dev/null @@ -1,310 +0,0 @@ -;;; output.clj -- Output & formatting clojure functions for ejc-sql. - -;;; Copyright © 2013-2019 - Kostafey - -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software Foundation, -;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ - -(ns ejc-sql.output - (:use clojure.java.io - ejc-sql.lib) - (:require [clojure.string :as s]) - (:import (java.io File) - (java.lang.reflect Method) - (java.util Date) - (java.text SimpleDateFormat) - (org.apache.commons.lang3 StringUtils) - (org.hibernate.engine.jdbc.internal BasicFormatterImpl - DDLFormatterImpl))) - -(def ^:dynamic *add-outside-borders* true) - -(defn get-log-dir [] - (file (if windows? - (System/getenv "AppData") - "/var/log/") - "ejc-sql")) - -(defn get-log-file [& [create-new]] - (loop [xs (take 100 (range))] - (when xs - (let [prev-day (first xs) - log-file (file - (get-log-dir) - (format "%s.log" - (.format - (new java.text.SimpleDateFormat - "yyyy-MM-dd") - (let [cal (java.util.Calendar/getInstance)] - (.setTime cal (new java.util.Date)) - (.add cal java.util.Calendar/DATE - (if prev-day (- prev-day) 0)) - (.getTime cal)))))] - (if (or create-new (.exists log-file)) - log-file - (recur (next xs))))))) - -(defn print-log-file-path [] - (print (.getAbsolutePath (or (get-log-file) (get-log-dir))))) - -(defn log-sql [sql] - (let [log-file (get-log-file true) - is-new-file (not (.exists log-file))] - (when is-new-file - (.mkdirs (File. (.getParent log-file))) - (.createNewFile log-file)) - (with-open [wrtr (clojure.java.io/writer log-file :append true)] - (when is-new-file - (.write wrtr (str "-- -*- mode: sql; -*-\n" - "-- Local Variables:\n" - "-- eval: (ejc-sql-mode)\n" - "-- End:\n"))) - (.write wrtr (str (simple-join 50 "-") " " - (.format (new java.text.SimpleDateFormat - "yyyy.MM.dd HH:mm:ss.S") - (new java.util.Date)) - " " (simple-join 2 "-") "\n" sql "\n"))))) - -(def fetch-size - "Limit number of records to output." - (atom 50)) - -(def max-rows - "Limit number of records to contain in ResultSet." - (atom 99)) - -(def show-too-many-rows-message - "Output message in case of ResultSet is bigger than `fetch-size`." - (atom true)) - -(def column-width-limit - "Limit number of chars per column to output." - (atom 30)) - -(defn set-fetch-size - "Set limit for number of records to output. When nil no limit. - Passed to the JDBC driver a hint as to the number of rows that should be - fetched from the database when more rows are needed for ResultSet objects - generated by a Statement." - [val] - (reset! fetch-size (or val 0))) - -(defn set-max-rows - "Set limit for number of records to contain in ResultSet. When nil no limit. - Sets the limit for the maximum number of rows that any ResultSet object - generated by a Statement object can contain to the given number." - [val] - (reset! max-rows (or val 0))) - -(defn set-show-too-many-rows-message - [val] - (reset! show-too-many-rows-message (or val false))) - -(defn set-column-width-limit - "Set limit for number of chars per column to output. When nil no limit." - [val] - (reset! column-width-limit val)) - -(defn rotate-table - "Rotate result set to show fields list vertically. - Applied to single-record result set. - E.g. transtofm from: a | b | c into: a | 1 - --+---+-- b | 2 - 1 | 2 | 3 c | 3" - [data] - (apply mapv vector data)) - -(def use-unicode (atom false)) - -(defn set-use-unicode - "Set using unicode for grid borders." - [val] - (reset! use-unicode val)) - -(defn u? [unicode-str ascii-str] - (if @use-unicode unicode-str ascii-str)) - -(defn print-maps - "Prints a collection of maps in a textual table. Prints table headings - ks, and then a line of output for each row, corresponding to the keys - in ks. If ks are not specified, use the keys of the first item in rows." - ([ks rows add-borders] - (when (seq rows) - (let [widths (map - (fn [k] - (apply max (count (str k)) - (map #(count (str (get % k))) rows))) - ks) - spacers (map #(apply str (repeat % (u? "─" "-"))) widths) - fmts (map #(str "%-" % "s") widths) - fmt-row (fn [leader divider trailer row] - (str (if add-borders leader "") - (apply str - (interpose - divider - (for [[col fmt] - (map vector (map #(get row %) ks) fmts)] - (format fmt (str col))))) - (if add-borders trailer ""))) - aob *add-outside-borders*] - (println (fmt-row (if aob (u? "│ " "| ") "") (u? " │ " " | ") (if aob (u? " │" " |") "") - (zipmap ks (map name ks)))) - (println (fmt-row (if aob (u? "├─" "|-") "") (u? "─┼─" "-+-") (if aob (u? "─┤" "-|") "") - (zipmap ks spacers))) - (doseq [row rows] - (println (fmt-row (if aob (u? "│ " "| ") "") (u? " │ " " | ") (if aob (u? " │" " |") "") row)))))) - ([rows add-borders] - (print-maps (keys (first rows)) rows add-borders))) - -(defn trim-max-width [x] - (let [s (str x)] - (if (and *max-column-width* - (> *max-column-width* 0) - (> (count s) *max-column-width*)) - (str (subs s 0 (- *max-column-width* 3)) "...") - s))) - -(defn min-not-zero [x y] - (min (if (> x 0) x y) - (if (> y 0) y x))) - -(defn print-table - "Converts a seq of seqs to a textual table. Uses the first seq as the table - headings and the remaining seqs as rows." - ([rows limit] - (when (seq rows) - (let [row-limit (or limit (min-not-zero @max-rows @fetch-size)) - [rows msg] (if (and row-limit - (> row-limit 0) - ;; Since `rows` parameter contains a header - ;; `row` 1 should be added to `row-limit`. - (> (count rows) (+ row-limit 1))) - [(take (+ row-limit 1) rows) - (if @show-too-many-rows-message - (format "Too many rows. Only %s from %s%s are shown." - row-limit - (min-not-zero @max-rows (- (count rows) 1)) - (if (and @max-rows - (> @max-rows 0) - (> (- (count rows) 1) @max-rows)) - "+" "")))] - [rows ""]) - [headers rows] [(map name (first rows)) (rest rows)] - aob *add-outside-borders* - [rows rotated] (if (and (not aob) - (= (count rows) 1) - (> (count (first rows)) 1)) - ;; Rotatate result set table representation - ;; if it has 1 row and many columns. - [(rotate-table [headers (first rows)]) true] - [rows false]) - [single-column-and-row - cell-value] (if-let [single-cell? (and (= (count rows) 1) - (= (count (first rows)) 1))] - [single-cell? (ffirst rows)]) - [headers rows] (if (or rotated single-column-and-row) - ;; Do not restrict column width if result - ;; set has only 1 row or 1 column & 1 row. - [headers rows] - [(map trim-max-width headers) - (map #(map trim-max-width %) rows)]) - rn #"(\r\n)|\n|\r" - nl (System/getProperty "line.separator") - rows (for [row rows] - (map #(if (string? %) - (if single-column-and-row - ;; In case of only 1 column & 1 row unify - ;; newline separators to system line break. - (s/replace % rn nl) - (-> % - (s/replace rn " ") - ;; Tabs to spaces to align columns widths. - (s/replace #"\t" " "))) - ;; Do not remove newline separators if result - ;; set cell is not a string. - %) - row)) - widths (if single-column-and-row - (list - (apply max - (cons - (count (first headers)) - (if (string? cell-value) - (map count (s/split cell-value rn)) - (list (count (str cell-value))))))) - (for [col (rotate-table (conj rows headers))] - (apply max (map #(count (str %)) col)))) - spacers (map #(apply str (repeat % (u? "─" "-"))) widths) - ;; TODO: #(str "%" % "d") for numbers - fmts (if (and rotated (not aob)) - ;; Remove trailing spaces for data column of single-row - ;; result if no outer borders required. - (list (str "%-" (first widths) "s") "%s") - (map #(str "%-" % "s") widths)) - fmt-row (fn [leader divider trailer row] - (str leader - (apply str (interpose - divider - (for [[col fmt] (map vector row fmts)] - (format fmt (str col))))) - trailer))] - (when (not-empty msg) - (println msg) - (println)) - (if (not rotated) - (do - (println (fmt-row (if aob (u? "│ " "| ") "") (u? " │ " " | ") (if aob (u? " │" " |") "") headers)) - (println (fmt-row (if aob (u? "├─" "|-") "") (u? "─┼─" "-+-") (if aob (u? "─┤" "-|") "") spacers)))) - (doseq [row (if (and aob single-column-and-row (string? cell-value)) - (map list (s/split cell-value (re-pattern nl))) - rows)] - (println (fmt-row (if aob (u? "│ " "| ") "") (u? " │ " " | ") (if aob (u? " │" " |") "") row)))))) - ([rows] (print-table rows @fetch-size))) - -(defn unify-str - "Concatenate stings, unify newline separators to the system line break." - [& s] - (if (empty? (filter not-empty s)) - "" - (apply str (map #(s/replace % - #"(\r\n)|\n|\r" - (System/getProperty "line.separator")) - s)))) - -(defn format-sql [sql] - (s/trim - (let [sql (s/trim sql)] - (.format (if (dml? sql) - (BasicFormatterImpl.) - (DDLFormatterImpl.)) - sql)))) - -(defn format-sql-print - "SQL should be printed to provide cross-platform newline handling." - [sql] - (print (format-sql sql))) - -(defn format-sql-if-required [sql] - (if (> (StringUtils/countMatches sql "\n") 1) - sql - (format-sql sql))) - -(defn write-result-file [text & {:keys [result-file - append] - :or {append false}}] - (spit result-file text :append append) - result-file) - -(defn clear-result-file [& {:keys [result-file]}] - (write-result-file "" :result-file result-file)) diff --git a/elpa/ejc-sql-20220414.1329/src/ejc_sql/structure.clj b/elpa/ejc-sql-20220414.1329/src/ejc_sql/structure.clj deleted file mode 100644 index 547f4a64..00000000 --- a/elpa/ejc-sql-20220414.1329/src/ejc_sql/structure.clj +++ /dev/null @@ -1,1149 +0,0 @@ -;;; structure.clj -- Receive database stucture and keep it in cache. - -;;; Copyright © 2016-2019 - Kostafey - -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software Foundation, -;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ - -(ns ejc-sql.structure - (:use [ejc-sql.lib] - [ejc-sql.cache] - [clomacs]) - (:require - [clojure.java.jdbc :as j] - [clojure.string :as s] - [clojure.java.io :as io] - [ejc-sql.connect :as c] - [ejc-sql.output :as o] - [ejc-sql.keywords :as k])) - -(defn- safe-query - "Return `sql` query result or nil in case of error." - [db sql & {:keys [row-fn column-name] - :or {row-fn identity}}] - (try - (if column-name - [[(keyword column-name)] - (mapv (keyword column-name) - (row-fn (j/query db (list sql) {:as-arrays? false})))] - (j/query db (list sql) {:as-arrays? true - :row-fn row-fn})) - (catch Exception _))) - -(defn- db->column - "Execute `sql`, return `column-name` or first column - (if `column-name` is not passed) of result set as result list." - [db sql & {:keys [row-fn column-name] - :or {row-fn identity}}] - (when sql - (rest (map first (safe-query db sql - :row-fn row-fn - :column-name column-name))))) - -(defn- db->>column - "Execute `sql`, return last column of result set as result list." - [db sql] - (when sql - (rest - (map last - (j/query db (list sql) {:as-arrays? true}))))) - -(defn- db->value - "Execute `sql`, return first value of first column of result set as result." - [db sql & {:keys [row-fn] - :or {row-fn identity}}] - (first (db->column db sql :row-fn row-fn))) - -(defn get-ms-sql-server-version [ver] - (-> - (filter not-empty (.split ver " ")) - (nth 3) - Integer/parseInt)) - -(defn is-modern-sql-server? [db] - (let [ver (db->value db "SELECT @@VERSION AS 'SQL Server Version'")] - (if (.startsWith ver "Microsoft SQL Azure") - true - (> (get-ms-sql-server-version ver) 2000)))) - -(def default-queries - {:owners (fn [& _] " - SELECT schema_owner - FROM information_schema.schemata ") - :schemas (fn [& _] " - SELECT schema_name - FROM information_schema.schemata ") - :tables (fn [& {:keys [schema]}] - (format " - SELECT table_name - FROM information_schema.tables - %s - ORDER BY table_name " - (if schema - (format " WHERE table_schema = '%s'" schema) - ""))) - :views (fn [& _] " - SELECT table_name - FROM information_schema.views ") - :all-tables (fn [& _] " - SELECT s.schema_owner, s.schema_name, t.table_name - FROM information_schema.schemata AS s, - information_schema.tables AS t - WHERE t.table_schema = s.schema_name ") - :columns (fn [& {:keys [table]}] - (format " - SELECT column_name - FROM information_schema.columns - WHERE UPPER(table_name) = '%s' - ORDER BY column_name " - (s/upper-case table))) - :view (fn [& {:keys [entity-name]}] - (format " - SELECT v.view_definition - FROM information_schema.views AS v - WHERE UPPER(v.table_name) = '%s' " - (s/upper-case entity-name)))}) - -(def queries - "Database - specific queries used for obtain data about database structure." - { - ;;-------- - :oracle - ;;-------- - {:entity (fn [& {:keys [entity-name]}] - (format " - SELECT text - FROM all_source - WHERE UPPER(name) = '%s' " - (s/upper-case entity-name))) - :entity-type (fn [& {:keys [entity-name]}] - (format " - SELECT object_type - FROM all_objects - WHERE UPPER(OBJECT_NAME) = '%s' - AND object_type NOT IN ('SYNONYM', 'PACKAGE BODY') - UNION - SELECT 'PROCEDURE' FROM dba_procedures - WHERE UPPER(PROCEDURE_NAME) = '%s' - AND rownum = 1" - (s/upper-case entity-name) - (s/upper-case entity-name))) - :view (fn [& {:keys [entity-name]}] - (format " - SELECT text - FROM all_views - WHERE UPPER(view_name) = '%s' " - (s/upper-case entity-name))) - :types (fn [& _] " - SELECT * FROM USER_TYPES ") - :owners (fn [& _] " - SELECT DISTINCT(owner) - FROM ALL_OBJECTS - ORDER BY owner ") - :tables (fn [& {:keys [owner]}] - (format " - SELECT table_name, owner - FROM all_tables - %s - ORDER BY table_name " - (if owner - (format " WHERE UPPER(owner) = '%s' " - (s/upper-case owner)) - ""))) - :views (fn [& {:keys [owner]}] - (format " - SELECT view_name - FROM all_views - %s - ORDER BY view_name " - (if owner - (format " WHERE UPPER(owner) = '%s' " - (s/upper-case owner)) - ""))) - :all-tables (fn [& _] " - SELECT owner, table_name - FROM all_tables - WHERE owner NOT IN ('SYS', 'SYSTEM') - ORDER BY owner ") - :columns (fn [& {:keys [table]}] - (format " - SELECT column_name - FROM ALL_TAB_COLUMNS - WHERE UPPER(table_name) = '%s' " - (s/upper-case table))) - :constraints (fn [& {:keys [owner table]}] - (cond - (and owner table) - (format " - SELECT * FROM all_constraints - WHERE owner = '%s' - AND table_name = '%s' " - owner table) - table - (format " - SELECT * FROM all_constraints - WHERE table_name = '%s' " table) - :else - "SELECT * FROM user_constraints")) - :procedures (fn [& {:keys [owner]}] - (format " - SELECT object_name, procedure_name - FROM all_procedures - %s " (if owner - (format "WHERE owner = '%s' " owner) - ""))) - :parameters (fn [& {:keys [package entity-name]}] - (format " - SELECT data_type, argument_name - FROM SYS.ALL_ARGUMENTS - WHERE object_name = '%s' - AND in_out = 'IN' - %s " - (s/upper-case entity-name) - (if package - (format "AND package_name = '%s'" package) - ""))) - :package (fn [& {:keys [entity-name]}] - ;; entity-name is a package name here - (format " - SELECT text FROM - ( - SELECT text AS text, - 1 AS ordered, - line AS line - FROM all_source - WHERE UPPER(name) = '%s' - AND type = 'PACKAGE' - UNION SELECT '\n\n', 2, 1 from dual - UNION SELECT ' ------------------\n', 3, 1 from dual - UNION SELECT ' -- PACKAGE BODY --\n', 4, 1 from dual - UNION SELECT ' ------------------\n', 5, 1 from dual - UNION SELECT '\n', 6, 1 from dual - UNION - SELECT text, - 7, - line - FROM all_source - WHERE UPPER(name) = '%s' - AND type = 'PACKAGE BODY' - ) - ORDER BY ordered, line " - (s/upper-case entity-name) - (s/upper-case entity-name))) - :table (fn [& {:keys [entity-name]}] - (format " - SELECT dbms_metadata.get_ddl('TABLE','%s') - FROM dual " (s/upper-case entity-name))) - :objects (fn [& _] " - SELECT * FROM all_objects - WHERE object_type IN ('FUNCTION','PROCEDURE','PACKAGE') ") - :keywords (fn [& _] " - SELECT * FROM V$RESERVED_WORDS ORDER BY keyword ")} - ;;-------- - :informix - ;;-------- - {:owners nil - :tables (fn [& _] " - SELECT TRIM(t.tabname) as tablesList - FROM systables AS t - WHERE t.tabtype = 'T' - AND t.tabid >= 100 - ORDER BY t.tabname; ") - :columns (fn [& {:keys [table]}] - (format " - SELECT TRIM(c.colname) AS column_name - FROM systables AS t, syscolumns AS c - WHERE t.tabid = c.tabid - AND t.tabtype = 'T' - AND t.tabid >= 100 - AND TRIM(t.tabname) = '%s' - ORDER BY c.colno; " table))} - ;;------- - :mysql - ;;------- - {:owners (fn [& _] " - SELECT schema_name - FROM information_schema.schemata ") - :tables (default-queries :tables) - :all-tables (fn [& _] " - SELECT s.schema_name, t.table_name - FROM information_schema.schemata AS s, - information_schema.tables AS t - WHERE t.table_schema = s.schema_name ") - :columns (default-queries :columns) - :keywords (fn [& _] " - SELECT name FROM mysql.help_keyword") - :entity-type (fn [& {:keys [entity-name]}] - (format " - SELECT routine_type - FROM information_schema.routines - WHERE UPPER(routine_name) = '%s' - UNION - SELECT 'standard-function' FROM mysql.help_topic t - INNER JOIN mysql.help_category AS c - ON c.help_category_id = t.help_category_id - AND c.parent_category_id IN (SELECT help_category_id - FROM mysql.help_category - WHERE name = 'Functions') - WHERE UPPER(t.name) = '%s'" - (s/upper-case entity-name) - (s/upper-case entity-name))) - :procedures (fn [& _] " - SELECT routine_schema, routine_name - FROM information_schema.routines ") - :procedure (fn [& {:keys [entity-name]}] - (format " - SHOW CREATE PROCEDURE %s " - entity-name)) - :function (fn [& {:keys [entity-name]}] - (format " - SHOW CREATE FUNCTION %s " - entity-name)) - :standard-function (fn [& {:keys [entity-name]}] - (format " - SELECT description FROM mysql.help_topic - WHERE UPPER(name) = '%s' " - (s/upper-case entity-name))) - :parameters (fn [& {:keys [entity-name]}] - (format " - SELECT data_type, parameter_name - FROM information_schema.parameters - WHERE parameter_mode = 'IN' - AND UPPER(specific_name) = '%s'" - (s/upper-case entity-name)))} - ;;-------- - :h2 - ;;-------- - {:tables (fn [& _] ((default-queries :tables) :schema "PUBLIC")) - :views (default-queries :views) - :all-tables (fn [& _] " - SELECT s.schema_owner, s.schema_name, t.table_name - FROM information_schema.schemata AS s, - information_schema.tables AS t - WHERE t.table_schema = s.schema_name - AND LCASE(s.schema_name) != 'information_schema' ") - :columns (default-queries :columns) - :keywords (fn [& _] - "SELECT topic FROM information_schema.help") - :entity-type (fn [& {:keys [entity-name]}] - (format " - SELECT t.table_type - FROM information_schema.tables AS t - WHERE UPPER(t.table_name) = '%s' " - (s/upper-case entity-name))) - :view (fn [& {:keys [entity-name]}] - ((default-queries :view) :entity-name entity-name))} - ;;-------- - :sqlite - ;;-------- - {:tables (fn [& _] "SELECT name FROM sqlite_master WHERE type='table'") - :views (fn [& _] "SELECT name FROM sqlite_master WHERE type='view'") - :all-tables (fn [& _] "SELECT name FROM sqlite_master WHERE type='table'") - :columns (fn [& {:keys [table]}] - (format " - SELECT p.name as columnName - FROM sqlite_master m - LEFT OUTER JOIN pragma_table_info((m.name)) p - ON m.name <> p.name - WHERE m.name = '%s' - ORDER BY columnName " table)) - :keywords (:sqlite k/keywords) - :entity-type (fn [& {:keys [entity-name]}] - (format " - SELECT type FROM sqlite_master - WHERE UPPER(name) = '%s' " - (s/upper-case entity-name))) - :view (fn [& {:keys [entity-name]}] - (format " - SELECT sql FROM sqlite_master - WHERE UPPER(name) = '%s' " - (s/upper-case entity-name)))} - ;;------- - :sqlserver ; ms sql server - ;;------- - {:owners (default-queries :owners) - :schemas (default-queries :schemas) - :tables (default-queries :tables) - :all-tables (default-queries :all-tables) - :columns (default-queries :columns) - :constraints (fn [& {:keys [table]}] - (format " - SELECT type_desc AS constraint_type, - name - FROM sys.objects - WHERE type_desc LIKE '%CONSTRAINT' - AND OBJECT_NAME(parent_object_id)='%s' " table)) - :entity (fn [& {:keys [db entity-name]}] - (if (is-modern-sql-server? db) - (format " - SELECT definition - FROM sys.objects o - JOIN sys.sql_modules m ON m.object_id = o.object_id - WHERE o.object_id = object_id('%s') " entity-name) - (format " - SELECT c.text - FROM sysobjects o - JOIN syscomments c ON c.id = o.id - WHERE o.name = '%s' " entity-name)))} - ;;------- - :postgresql - ;;------- - {:procedure (fn [& {:keys [entity-name]}] - (format " - SELECT pg_get_functiondef(p.oid) - FROM pg_catalog.pg_proc p - WHERE upper(p.proname) = '%s' " - (s/upper-case entity-name))) - :table (fn [& {:keys [entity-name]}] - (format " - SELECT 'CREATE TABLE %s (\n' || - string_agg(column_list.column_expr, ', \n') || - '\n);' - FROM ( - SELECT ' ' || column_name || ' ' || data_type || - coalesce('(' || character_maximum_length || ')', '') || - case when is_nullable = 'YES' - then '' - else ' NOT NULL' - end as column_expr - FROM information_schema.columns - WHERE table_schema = 'public' - AND upper(table_name) = '%s' - ORDER BY ordinal_position) column_list" - entity-name - (s/upper-case entity-name))) - :owners (default-queries :owners) - :schemas (default-queries :schemas) - :tables (default-queries :tables) - :all-tables (default-queries :all-tables) - :columns (default-queries :columns) - :procedures (fn [& _] " - SELECT p.proname - FROM pg_catalog.pg_namespace n - JOIN pg_catalog.pg_proc p - ON p.pronamespace = n.oid - ORDER BY proname ") - :entity-type (fn [& {:keys [entity-name]}] - (format " - SELECT 'namespace' - FROM pg_catalog.pg_namespace n - WHERE upper(n.nspname) = '%s' - UNION - SELECT 'table' - FROM information_schema.tables - WHERE upper(table_name) = '%s' - UNION - SELECT 'view' - FROM information_schema.views - WHERE upper(table_name) = '%s' - UNION - SELECT 'procedure' - FROM pg_catalog.pg_namespace n - JOIN pg_catalog.pg_proc p - ON p.pronamespace = n.oid - WHERE upper(p.proname) = '%s' " - (s/upper-case entity-name) - (s/upper-case entity-name) - (s/upper-case entity-name) - (s/upper-case entity-name))) - :parameters (fn [& {:keys [entity-name]}] - (format " - SELECT pg_catalog.pg_get_function_identity_arguments( - p.oid) - FROM pg_catalog.pg_proc p - WHERE p.proname = '%s'" entity-name)) - :keywords (fn [& _] - "SELECT word FROM pg_get_keywords()")}}) - -;; Use the same database introspection queries for MariaDB as for MySQL. -(def queries (assoc queries :mariadb (queries :mysql))) - -(defn autocomplete-available-for-db? [db-type] - (queries db-type)) - -(defn get-db-name [db] - (let [{:keys [database subname connection-uri dbname]} db] - (or dbname - database - (if subname - (let [separator (if (= (first (.split subname "/")) subname) - ":" "/") - raw-db-name (last (.split subname separator)) - raw-db-name (first (.split raw-db-name "\\?")) - raw-db-name (first (.split raw-db-name ";"))] - raw-db-name) - ;; No subname - parse connection-uri - (let [props-list (.split connection-uri ";") - db-name-prop (first - (filter - (fn [prop] - (= - "databasename" - (.toLowerCase (first (.split prop "="))))) - props-list))] - (if db-name-prop - ;; "databaseName=my_db_name;" - (second (.split db-name-prop "=")) - ;; "jdbc:jtds:sqlserver://localhost:1433/my_db_name;" - (last (.split (first props-list) "/")))))))) - -(defn get-user [db] - (or - (:user db) - (let [{:keys [user connection-uri]} db] - (or user - (if connection-uri - (second (.split - (let [props-list (.split connection-uri ";")] - (first - (filter - (fn [prop] - (= - "user" - (.toLowerCase (first (.split prop "="))))) - props-list))) "=")) - :undefined-user))))) - -(def product-assoc {"oracle:sid" "oracle"}) - -(defn get-db-type [db] - (let [{:keys [subprotocol connection-uri dbtype]} db - result (or dbtype - subprotocol - (let [attrs (.split connection-uri ":")] - (if (= (second attrs) "jtds") - ;; jdbc:jtds:sqlserver://... - (nth attrs 2) - ;; jdbc:sqlserver://localhost\instance:1433; - (second attrs))))] - (keyword (or (product-assoc result) result)))) - -(defn- get? [obj & [force?]] - (when (and obj (or force? (realized? obj))) - @obj)) - -(defn get-this-owner - "Return current owner/schema." - [db & [owner]] - (or owner - (get? (get-in @cache [db :this-owner]) false) - (do - (swap! cache assoc-in [db :this-owner] - (future - ((fn [db] - (let [db-type (get-db-type db)] - (case db-type - :sqlserver (if (is-modern-sql-server? db) - ;; Get default SQL Server schema for session - (db->value db "SELECT SCHEMA_NAME()") - "dbo") - :oracle (db->value - db - "SELECT sys_context('userenv', 'current_schema') - FROM dual") - ;; By default - ;; Assume owner == schema (it can be wrong in general). - (get-user db)))) db))) - (get? (get-in @cache [db :this-owner]) true)))) - -(defn select-db-meta-script - "Return SQL request to obtain some database structure info." - [db meta-type & - {:keys [owner - table - package - entity-name]}] - (let [db-type (get-db-type db) - meta-type (if (keyword? meta-type) meta-type (keyword meta-type)) - ;; owner (get-this-owner db owner) - sql-receiver (get-in queries [db-type meta-type]) - sql (if sql-receiver - (sql-receiver :db db - :owner owner - :schema owner - :table table - :package package - :entity-name entity-name - :db-name (get-db-name db)))] - sql)) - -(defn get-namespace - "Find tables namespace for current database type. - Possible cases for namespace: - * schema is sutable (or both schema and owner) - for this DB type - use `:schemas` - * only owner is sutable, so use `:owners` - * none of them is sutable - `nil`" - [db] - (let [db-type (get-db-type db)] - (cond - (get-in queries [db-type :schemas]) :schemas - (get-in queries [db-type :owners]) :owners - :else nil))) - -(defn get-or-create-cache - "Fill `cache` atom with database structure data, then get data from it. - Parameters: - - `db` - database connection map - - `path` - the keys used to define the place to store data in `cache` atom - - `sql` - query to obtain the desired data from the database - - `force?` - when true, eval `sql` immediately and return data - - `direct-value` - sometimes there is no need to eval `sql` to obtain some - data,and value of this parameter, if it's defined, can be - used as-is - - `exec-fn` - SQL execution function (`db->column` by default) - - `filter-fn` - filer function applied to SQL execution results - - `handler-fn` - additional processing applied to SQL execution results." - [& {:keys [db - path - sql - force? - direct-value - exec-fn - filter-fn - handler-fn] - :or {exec-fn db->column}}] - (let [full-path (into [db] path)] - (if (not (get->in @cache full-path)) - (let [flat-path [db (keyword (s/join "-" (map name path)))] - c-promise (promise)] - (swap! cache-creation-promises assoc-in flat-path c-promise) - (swap! cache assoc-in full-path - (if direct-value - (future (deliver c-promise :ok) - direct-value) - (future (try - (let [result (exec-fn db sql) - result (distinct result) - result (if filter-fn - (filter filter-fn result) - result) - result (if handler-fn - (mapv handler-fn result) - result) - result (if (vector? result) - (sort result) - result)] - (deliver c-promise :ok) - result) - (catch Exception e - (deliver c-promise e) - (list)))))))) - (get? (get-in @cache full-path) force?))) - -(defn get-owners - "Return owners list from cache if already received from DB, - check if receiveing process is not running, then start it." - [db & [force?]] - (let [namespace (get-namespace db)] - (if namespace - (get-or-create-cache :db db - :path [namespace] - :sql (select-db-meta-script db namespace) - :force? force?) - ;; Schemas or owners are not applicable to this database type. - (list)))) - -(defn get-tables - "Return tables list for this owner from cache if already received from DB, - check if receiveing process is not running, then start it." - [db & [owner_ force?]] - (let [owner (get-this-owner db owner_)] - (if owner_ - (get-or-create-cache :db db - :path [:tables owner] - :sql (select-db-meta-script db :tables :owner owner) - :force? force?) - (get-or-create-cache :db db - :path [:all-tables] - :sql (select-db-meta-script db :all-tables) - :force? force? - :exec-fn db->>column)))) - -(defn get-views - "Return views list from cache if already received from DB, - check if receiveing process is not running, then start it." - [db & [owner_ force?]] - (let [owner (get-this-owner db owner_)] - (get-or-create-cache :db db - :path [:views owner] - :sql (select-db-meta-script db :views :owner owner) - :force? force?))) - -(defn get-colomns - "Return colomns list for this table from cache if already received from DB, - check if receiveing process is not running, then start it." - [db table force?] - (when (not (get->in @cache [db :colomns table])) - (swap! cache assoc-in [db :colomns table] - (future ((fn [db table] - (let [sql (select-db-meta-script db :columns - :table table)] - (sort (distinct (db->column db sql))))) - db table)))) - (get? (get->in @cache [db :colomns table]) - force?)) - -(def postgresql-type-aliases - "Some of PostgreSQL type aliases used for show in eldoc." - {"character varying" "varchar" - "bit varying" "varbit"}) - -(defn get-parameters - "Return parameters list of `stored-procedure` from cache if already received - from DB, check if receiveing process is not running, then start it." - [db package stored-procedure & [force?]] - (let [db-type (get-db-type db)] - (get-or-create-cache - :db db - :path (if package - [:stored-procedures package stored-procedure] - [:stored-procedures stored-procedure]) - :sql (select-db-meta-script db :parameters - :package package - :entity-name stored-procedure) - :force? force? - :exec-fn - (case db-type - :postgresql (fn [db sql] - ;; Use only first possible list of parameters if many. - (list (db->value db sql))) - :mysql (fn [db sql] - (list (rest (safe-query db sql)))) - :oracle (fn [db sql] - (list - (map - (fn [[param-type param-name]] - (format "%s %s" param-type param-name)) - (rest - (safe-query db - sql - :row-fn identity - :column-name nil))))) - nil) - :handler-fn - (case db-type - :postgresql (fn [types] - (map - (fn [type] - (let [type (s/trim type)] - (or (postgresql-type-aliases type) - type))) - (s/split types #","))) - :mysql (fn [types] - (map #(s/join " " %) types)) - nil)))) - -(defn get-keywords - "Return keywords list for this database type from cache if already received - from DB, check if receiveing process is not running, then start it." - [db force?] - (if-let [keywords-query (get-in queries [(get-db-type db) :keywords])] - (get-or-create-cache :db db - :path [:keywords] - :direct-value (if (vector? keywords-query) - keywords-query) - :sql (select-db-meta-script db :keywords) - :force? force? - :filter-fn #(not (nil? %))))) - -(defn get-packages - "Return packages list for this owner from cache if already received from DB, - check if receiveing process is not running, then start it." - [db & [owner_ force?]] - (let [owner (get-this-owner db owner_)] - (get-or-create-cache :db db - :path [:packages owner] - :sql (select-db-meta-script db :procedures - :owner owner) - :force? force?))) - -(defn is-owner? [db prefix] - (in? (get-owners db) prefix :case-sensitive false)) - -(clomacs-defn - complete-auto-complete - ejc-complete-auto-complete - :doc "Call Emacs auto-complete if point is the same as before loading.") - -(defn run-autocomplete [db buffer-name point] - (future - ;; Wait for all cache building promises ready. - (mapv deref (vals (get-in @cache-creation-promises [db]))) - ;; Remove them from memory. - (swap! cache-creation-promises assoc-in [db] nil) - ;; Pass to Emacs a note that db structure cache ready (try to autocomplete). - (complete-auto-complete buffer-name point))) - -(defn autocomplete-loading - "Not loaded tables yet. Output pending db structure data..." - ([db buffer-name point] - (run-autocomplete db buffer-name point) - (autocomplete-loading)) - ([] - (list "t"))) - -(defn autocomplete-result - "Output autocomplete result." - [result] - (cons "nil" result)) - -(defn autocomplete-nothing - "Output autocomplete nothing." - [] - (list "nil")) - -(defn get-owners-candidates - "Return owners candidates autocomplete list from the database structure - cache, async request to fill it, if not yet. - The result list has the following structure: - (pending item1 item2 ...) - If `pending` is t - the async request to get the structure is running - if `pending` is nil - no request is running, return result immediately." - [& {:keys [db sql prefix-1 buffer-name point]}] - (let [owners (get-owners db)] - (if prefix-1 - ;; Assume schema|table.# is not applicable. - ;; So, return empty list. - (autocomplete-nothing) - (if owners - (autocomplete-result owners) - ;; pending owners... - (autocomplete-loading db buffer-name point))))) - -(defn get-tables-candidates - "Return tables candidates autocomplete list." - [& {:keys [db sql prefix-1 buffer-name point]}] - (let [tables (if (not prefix-1) - ;; something# - (get-tables db) - (if (is-owner? db prefix-1) - ;; [owner].# - (get-tables db prefix-1) - ;; owners still pending or - ;; unknown?.# case - (list)))] - (if tables - (autocomplete-result tables) - ;; pending tables... - (autocomplete-loading)))) - -(defn get-views-candidates - "Return views candidates autocomplete list." - [& {:keys [db sql prefix-1 buffer-name point]}] - (if-let [views (if (not prefix-1) - ;; something# - (get-views db) - (if (is-owner? db prefix-1) - ;; [owner].# - (get-views db prefix-1) - ;; owners still pending or - ;; unknown?.# case - (list)))] - (autocomplete-result views) - ;; pending views... - (autocomplete-loading))) - -(defn get-packages-candidates - "Return packages candidates autocomplete list." - [& {:keys [db sql buffer-name point]}] - (if-let [packages (get-packages db)] - (autocomplete-result packages) - ;; pending packages... - (autocomplete-loading))) - -(defn match-alias? - "Check if prefix (`probable-alias`) is alias for `table` in this `sql`." - [sql owner table probable-alias] - (let [sql (s/lower-case sql) - owner (if owner - (str (s/lower-case owner) "\\.") - "\\s+(\\w+\\.)?") - table (s/lower-case table) - probable-alias (s/lower-case probable-alias) - alias-pattern (re-pattern - (str owner table "(\\s+as)?" - "\\s+" probable-alias))] - (not (nil? (re-find alias-pattern sql))))) - -(defn get-all-tables - "Get all tables for all owners/schemas." - [db] - (or (get-tables db nil true) - (flatten - (mapv #(get-tables db % true) - (distinct (get-owners db true)))))) - -(def select-re - (re-pattern (str "(?i)\\s*SELECT\\s+(.*\\s+)?FROM\\s+(\\S+)"))) - -(defn select-sql? - "If `sql` is SELECT query, return a table name used in FROM clause. - Otherwise return nil." - [sql] - (nth (re-find select-re sql) 2)) - -(def insert-re - (re-pattern (str "(?i)\\s*INSERT\\s+INTO\\s+(\\S+)\\s+"))) - -(defn insert-sql? - "If `sql` is INSERT query, return a table name used to insert new records. - Otherwise return nil." - [sql] - (second (re-find insert-re sql))) - -(def update-re - (re-pattern (str "(?i)\\s*UPDATE\\s(\\S+)\\s+\n*SET.*"))) - -(defn update-sql? - "If `sql` is UPDATE query, return a table name used to modify the existing - records. Otherwise return nil." - [sql] - (second (re-find update-re sql))) - -(defn get-colomns-candidates - "Return colomns candidates autocomplete list." - [& {:keys [db sql prefix-1 prefix-2 - buffer-name point]}] - ;; Possible cases: - ;; 1. [owner|schema.]table.# - ;; 2. SELECT alias.# FROM [owner|schema.]table AS alias - ;; 3. SELECT complex-alias.# FROM (SELECT...) AS complex-alias - ;; 4. INSERT INTO table (field1, .#) values (123, 'text') - ;; 5. UPDATE table SET field1 = 123, .# = 'text' WHERE id = 1 - ;; - ;; In any case, consider `prefix-1` as table or alias - ;; and optional `prefix-2` as owner or schema. - ;; When no any prefix at all, check for 4 (INSERT) or 5 (UPDATE) case. - (let [owner prefix-2 - tables-list (concat - (if owner - (get-tables db owner) - ;; In case of queries like - ;; "SELECT u.# FROM custom.Users as u" - ;; when "custom" is not the current - ;; schema, the full DB structure tree - ;; sould be built to obtain overall - ;; tables list for all owners/schemas. - (if (get-namespace db) - ;; Database has namespaces - (if (not (get-owners db)) - ;; Not received owners list yet - - ;; pending... - (do - (future (get-all-tables db)) - nil) - ;; Owners list is already here - - ;; force tables list receiving! - (get-all-tables db)) - ;; Database hasn't namespaces - - ;; no owners needed - (get-tables db))) - (get-views db))] - (if (not (and tables-list - (not-empty (filter not-empty tables-list)))) - ;; no tables yet - ;; pending tables... - (autocomplete-loading) - ;; Tables list loaded: - (if (not prefix-1) - (let [insert-or-update-table (or (select-sql? sql) - (insert-sql? sql) - (update-sql? sql))] - (cond - (and (not-empty insert-or-update-table) - (in? tables-list insert-or-update-table - :case-sensitive false)) - ;; SELECT # FROM table - ;; or - ;; INSERT INTO table (field1, .#) values (123, 'text') - ;; or - ;; UPDATE table SET field1 = 123, .# = 'text' WHERE id = 1 - (autocomplete-result - (get-colomns db insert-or-update-table true)) - ;; SELECT or other queries types - :else (autocomplete-nothing))) - (if (in? tables-list prefix-1 :case-sensitive false) - ;; table.# - (let [table prefix-1 - ;; force columns-cache obtaining... - columns-list (get-colomns db table true)] - ;; ok - columns - (autocomplete-result columns-list)) - (let [sql (clean-sql sql) - table-alias (first - (filter - (fn [table] - (match-alias? sql owner table prefix-1)) - tables-list))] - (if table-alias - ;; table-alias.# - (autocomplete-result (get-colomns db table-alias true)) - ;; Check "SELECT t.# FROM (SELECT ... ) AS t" case. - (let [pattern (re-pattern (str "\\(.+\\)(\\s|\\s(as)\\s)" - prefix-1)) - complex-alias (first (re-find pattern sql)) - complex-alias (if complex-alias - (subs complex-alias 1 - (.lastIndexOf complex-alias ")")))] - (if complex-alias - (let [{:keys [success result]} (c/query-meta db complex-alias)] - (if success - ;; complex-alias.# - (autocomplete-result (mapv :name result)) - ;; Can't execute "blah blah" to get metadata in - ;; "SELECT t.# FROM (blah blah) AS t" case. - (autocomplete-nothing))) - ;; unknown?.# case - ;; nothing to complete - (autocomplete-nothing)))))))))) - -(defn get-entity-type - "Determine DB entity type, whether it is a `:view`, `:type`, - `:package`, `:namespace` or `:procedure`." - [db entity-name] - (if-let [sql (and entity-name - (select-db-meta-script db :entity-type - :entity-name entity-name))] - (if-let [found-type (db->value db sql)] - (-> (.split found-type " ") - first - s/lower-case - keyword)))) - -(defn get-entity-type-fmt [db entity-name] - (clomacs/format-result (get-entity-type db entity-name))) - -(def creation-headers - {:oracle {:view (fn [db view] - (format "CREATE OR REPLACE VIEW %%s\n(%s)\nAS\n%%s" - (s/join ", " - (map #(-> % :name s/lower-case) - (:result - (c/query-meta db view)))))) - :package (fn [db _] "CREATE OR REPLACE %2$s\n")}}) - -(defn add-creation-header [db entity-type entity-name sql] - (let [db-type (get-db-type db)] - (if-let [header-creator (get-in creation-headers [db-type entity-type])] - (let [header-format (header-creator db entity-name)] - (format header-format entity-name sql)) - sql))) - -(defn get-entity-description - "Get DB entity creation SQL. - Database entity types: - - `:table` - - `:view` - - `:package` - - `:function` - - `:procedure` - - `:standard-function`." - [& {:keys [db - connection-name - prefix - entity-name - result-file]}] - (let [sql-object (or prefix entity-name) - db-type (get-db-type db)] - (if-let [type (get-entity-type db sql-object)] - (if (and prefix (= :namespace type)) - ;; Omit prefix if it's a `:namespace`. - (get-entity-description :db db - :connection-name connection-name - :prefix nil - :entity-name entity-name - :result-file result-file) - (if-let [entity-obtainig-sql (select-db-meta-script - db - type - :entity-name sql-object)] - (if-let [entity-sql (s/join - "" - (db->column - db - entity-obtainig-sql - :row-fn (fn [row] - (mapv #(if (is-clob? %) - (clob-to-string %) - %) - row)) - :column-name - (case (get-db-type db) - :mysql (case type - :function "create function" - :procedure "create procedure" - nil) - nil)))] - (c/complete (o/unify-str - (add-creation-header - db - type - sql-object - (o/format-sql-if-required entity-sql))) - :mode (if (and (= type :standard-function) - (= db-type :mysql)) - 'rst-mode - 'sql-mode) - :connection-name connection-name - :db db - :result-file result-file - :goto-symbol (if prefix entity-name)) - (c/complete (format "Can't find %s named %s." - (name type) sql-object) - :result-file result-file)) - (c/complete (format (str "Script for obtaining DB entity of type %s " - "was not added for this database type.") - (name type)) - :result-file result-file))) - (c/complete (format "Can't determine type of %s." sql-object) - :result-file result-file)))) - -(defn print-table-meta [db table-name] - (let [result-map (c/table-meta db table-name) - success (:success result-map) - result-data (:result result-map)] - (if success - (do (println (format "Table \"%s\" description:" table-name)) - (println) - (o/print-maps result-data true)) - (println result-data)) - success)) - -(defn describe-table [& {:keys [db - connection-name - table - owner - result-file - add-outside-borders]}] - (with-open [out (io/writer result-file)] - (binding [*out* out - o/*add-outside-borders* add-outside-borders] - (when (print-table-meta db (if owner (str owner "." table) table)) - (when-let [sql (select-db-meta-script db :constraints - :owner owner - :table table)] - (println) - (println "Constraints:") - (println) - (o/print-table (second (c/eval-sql-core :db db - :sql sql - :fetch-size 0 - :max-rows 0))))))) - (c/complete - nil - :display-result true - :connection-name connection-name - :db db - :result-file result-file)) diff --git a/elpa/ejc-sql-20230228.102/ejc-autocomplete.el b/elpa/ejc-sql-20230228.102/ejc-autocomplete.el new file mode 100644 index 00000000..208c0da1 --- /dev/null +++ b/elpa/ejc-sql-20230228.102/ejc-autocomplete.el @@ -0,0 +1,129 @@ +;;; ejc-autocomplete.el -- SQL completitions at point by auto-complete (the part of ejc-sql). + +;;; Copyright © 2013-2020 - Kostafey + +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software Foundation, +;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ + +;;; Code: + +(require 'auto-complete) +(require 'ejc-completion-common) +(require 'ejc-flx) + +(defvar ac-source-ejc-owners + '((candidates . ejc-owners-candidates) + (symbol . "o") + (requires . 1) + (cache . t))) + +(defvar ac-source-ejc-tables + '((candidates . ejc-tables-candidates) + (symbol . "t") + (requires . 1) + (cache . t))) + +(defvar ac-source-ejc-views + '((candidates . ejc-views-candidates) + (symbol . "v") + (requires . 1) + (cache . t))) + +(defvar ac-source-ejc-packages + '((candidates . ejc-packages-candidates) + (symbol . "p") + (requires . 1) + (cache . t))) + +(defvar ac-source-ejc-tables-point + '((candidates . ejc-tables-candidates) + (symbol . "t") + (prefix . ejc-return-point) + (requires . 0) + (cache . t))) + +(defvar ac-source-ejc-colomns + '((candidates . ejc-colomns-candidates) + (symbol . "c") + (requires . 1) + (cache . t))) + +(defvar ac-source-ejc-colomns-point + '((candidates . ejc-colomns-candidates) + (symbol . "c") + (prefix . ejc-return-point) + (requires . 0) + (cache . t))) + +(defvar ac-source-ejc-ansi-sql + '((candidates . ejc-get-ansi-sql-words) + (symbol . "s") + (document . ac-ejc-documentation) + (requires . 1) + (cache . t))) + +(defvar ac-source-ejc-keywords + '((candidates . ejc-get-keywords) + (symbol . "s") + (document . ac-ejc-documentation) + (requires . 1) + (cache . t))) + +;;;###autoload +(defun ejc-ac-setup () + "Add the completion sources to the front of `ac-sources'. +This affects only the current buffer. + +Check against following cases: +prefix-2.prefix-1.# +prefix-1.# +something#" + (interactive) + (add-to-list 'ac-sources 'ac-source-ejc-ansi-sql) + (add-to-list 'ac-sources 'ac-source-ejc-keywords) + (add-to-list 'ac-sources 'ac-source-ejc-owners) + (add-to-list 'ac-sources 'ac-source-ejc-tables) + (add-to-list 'ac-sources 'ac-source-ejc-views) + (add-to-list 'ac-sources 'ac-source-ejc-packages) + (add-to-list 'ac-sources 'ac-source-ejc-tables-point) + (add-to-list 'ac-sources 'ac-source-ejc-colomns) + (add-to-list 'ac-sources 'ac-source-ejc-colomns-point)) + +(defun ejc-ac-hook () + (if ejc-use-flx + (if (require 'flx-ido nil 'noerror) + (setq-local ac-match-function 'ejc-flx-match-internal) + (error (concat "Please install flx.el and flx-ido.el " + "if you use fuzzy completion")))) + (delq 'ac-source-dictionary ac-sources) + (delq 'ac-source-abbrev ac-sources) + (delq 'ac-source-words-in-same-mode-buffers ac-sources)) + +(add-hook 'ejc-sql-minor-mode-hook 'ejc-ac-hook) + +(when (require 'yasnippet nil 'noerror) + (setq yas-snippet-dirs + (nconc yas-snippet-dirs + (list (expand-file-name "snippets" + (file-name-directory + (locate-library "ejc-sql")))))) + (defun ejc-yas-downcase-key (args) + (if ejc-sql-mode + (cl-callf downcase (nth 1 args))) + args) + (advice-add 'yas--fetch :filter-args #'ejc-yas-downcase-key)) + +(provide 'ejc-autocomplete) + +;;; ejc-autocomplete.el ends here diff --git a/elpa/ejc-sql-20230228.102/ejc-company.el b/elpa/ejc-sql-20230228.102/ejc-company.el new file mode 100644 index 00000000..527379a6 --- /dev/null +++ b/elpa/ejc-sql-20230228.102/ejc-company.el @@ -0,0 +1,91 @@ +;;; ejc-company.el -- SQL completitions at point by company-mode (the part of ejc-sql). + +;;; Copyright © 2020 - Kostafey + +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software Foundation, +;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ + +;;; Commentary: + +;; `ejc-company' is a `company' completion backend for `ejc-sql'. +;; To use it, add `ejc-company-backend' to `company-backends': + +;; (requre 'ejc-company) +;; (push 'ejc-company-backend company-backends) + +;;; Code: + +(require 'cl-lib) +(require 'dash) +(require 'company) +(require 'ejc-completion-common) + +(defun ejc-company-make-candidate (candidate) + (let ((text (car candidate)) + (meta (cadr candidate))) + (propertize text 'meta meta))) + +(defun ejc-company-add-meta (meta candidates) + (-map (lambda (k) (list k meta)) + candidates)) + +(defun ejc-company-candidates (prefix) + (let* ((prefix-1 (ejc-get-prefix-word)) + (prefix-2 (save-excursion + (search-backward "." nil t) + (ejc-get-prefix-word))) + (res)) + (dolist (item + (cl-remove-if-not + (lambda (c) (string-prefix-p prefix (car c) t)) + (append + (ejc-append-without-duplicates + (ejc-company-add-meta + "ansi sql" (ejc-get-ansi-sql-words)) + (ejc-company-add-meta + "keyword" (ejc-get-keywords)) + 'car :right) + (ejc-company-add-meta + "owner" (ejc-owners-candidates)) + (ejc-company-add-meta + "table" (ejc-tables-candidates)) + (ejc-company-add-meta + "view" (ejc-views-candidates)) + (if (not prefix-1) + (ejc-company-add-meta + "package" (ejc-packages-candidates))) + (ejc-company-add-meta + "column" (ejc-colomns-candidates))))) + (push (ejc-company-make-candidate item) res)) + res)) + +(defun ejc-company-annotation (candidate) + (format " %s" (get-text-property 0 'meta candidate))) + +(defun ejc-company-doc-buffer (candidate) + (company-doc-buffer (ac-ejc-documentation candidate))) + +(defun ejc-company-backend (command &optional arg &rest ignored) + (interactive (list 'interactive)) + (cl-case command + (interactive (company-begin-backend 'ejc-company-backend)) + (prefix (and (bound-and-true-p ejc-sql-mode) + (company-grab-symbol))) + (candidates (ejc-company-candidates arg)) + (doc-buffer (ejc-company-doc-buffer arg)) + (annotation (ejc-company-annotation arg)))) + +(provide 'ejc-company) + +;;; ejc-company.el ends here diff --git a/elpa/ejc-sql-20230228.102/ejc-completion-common.el b/elpa/ejc-sql-20230228.102/ejc-completion-common.el new file mode 100644 index 00000000..701d9461 --- /dev/null +++ b/elpa/ejc-sql-20230228.102/ejc-completion-common.el @@ -0,0 +1,165 @@ +;;; ejc-completion-common.el -- SQL completitions common functionality (the part of ejc-sql). + +;;; Copyright © 2020 - Kostafey + +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software Foundation, +;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ + +;;; Code: + +(require 'ejc-lib) +(require 'ejc-format) +(require 'ejc-interaction) +(require 'ejc-doc) + +(defcustom ejc-candidates-uppercase t + "Use uppercase candidates or downcase. +Uppercase by default, set to nil to use downcase candidates." + :type 'boolean + :safe #'booleanp + :group 'ejc-sql) + +(defvar ejc-ansi-sql-words + '("select" "where" "and" "or" "from" "insert" "update" "delete" "join" + "order by" "distinct" "create" "alter" "drop" "like" + "grant" "revoke" "deny" "commit" "rollback" "savepoint")) + +(defvar ejc-auxulary-sql-words + '("show" "errors" "desc" "count" "type" "table" "function" "procedure" + "begin" "end" "for" "return")) + +(defcustom ejc-complete-on-dot nil + "When t automatically start completion after inserting a dot for +`company-mode' despite `company-minimum-prefix-length' is bigger than 0." + :type 'boolean + :safe #'booleanp + :group 'ejc-sql) + +(defun ejc-return-point () + "Return point position if point (cursor) is located next to dot char (.#)" + (let ((curr-char (buffer-substring + (save-excursion + (left-char 1) + (point)) + (point)))) + (if (equal curr-char ".") + (point) + nil))) + +(defun ejc-get-prefix-word () + "Return the word preceding dot before the typing." + (save-excursion + (let ((space-dist (or (save-excursion + (re-search-backward "[ \n\t\r(]+" nil t)) + 0)) + (dot (search-backward "." nil t)) + (space (re-search-backward "[ \n\t\r(.]+" nil t))) + (if (and dot + space + (> dot space) + (<= space-dist space)) ; is a dot completition + (buffer-substring (1+ space) dot) + nil)))) + +(defun ejc-get-ansi-sql-words () + "Get ANSI SQL keywords." + (unless (or (ejc-return-point) (ejc-get-prefix-word)) + (if ejc-candidates-uppercase + (append (mapcar 'upcase ejc-ansi-sql-words) + (mapcar 'upcase ejc-auxulary-sql-words)) + (append ejc-ansi-sql-words + ejc-auxulary-sql-words)))) + +(defun ejc-get-keywords () + "Get DB-specific keywords." + (if (ejc-buffer-connected-p) + (unless (or (ejc-return-point) (ejc-get-prefix-word)) + (if ejc-candidates-uppercase + (mapcar 'upcase (ejc-get-keywords-inner ejc-db nil)) + (mapcar 'downcase (ejc-get-keywords-inner ejc-db nil)))))) + +(cl-defun ejc-complete-auto-complete (buffer-name point) + "Called by Clojure side when db structure cache creation process completes. +When the user typed some chars, the request for autocompletion is passed to +Clojure side. If Clojure side has the database structure cache, autocompletion +variants returned immediately. If not, the database structure cache creation +process starts. It's async, so the process of Emacs is not blocked and the +user can move point (cursor), edit SQL and so on. After Clojure side cache +creation process finishes, it calls this `ejc-complete-auto-complete' +function. If the user waits for autocompletion and doesn't move point +(cursor) during this process, he will get autocompletion variants." + (switch-to-buffer buffer-name) + (if (equal point (point)) + (cond ((bound-and-true-p auto-complete-mode) (auto-complete)) + ((bound-and-true-p company-mode) (company-complete)))) + nil) + +(defmacro ejc-candidates (cand-fn) + `(if (ejc-buffer-connected-p) + (let* ((prefix-1 (ejc-get-prefix-word)) + (prefix-2 (save-excursion + (search-backward "." nil t) + (ejc-get-prefix-word))) + (result (funcall ,cand-fn + :db ejc-db + :sql (apply + 'buffer-substring + (ejc-get-sql-boundaries-at-point)) + :prefix-1 prefix-1 + :prefix-2 prefix-2 + :buffer-name (buffer-name) + :point (point))) + (pending (car result)) + (candidates-cache (cdr result))) + (if (ejc-not-nil-str pending) + (progn + (message "Receiving database structure...") + (list)) + candidates-cache)))) + +;;;###autoload +(defun ejc-owners-candidates () + (ejc-candidates 'ejc-get-owners-candidates)) + +;;;###autoload +(defun ejc-tables-candidates () + (ejc-candidates 'ejc-get-tables-candidates)) + +;;;###autoload +(defun ejc-views-candidates () + (ejc-candidates 'ejc-get-views-candidates)) + +;;;###autoload +(defun ejc-packages-candidates () + (ejc-candidates 'ejc-get-packages-candidates)) + +;;;###autoload +(defun ejc-colomns-candidates () + (ejc-candidates 'ejc-get-colomns-candidates)) + +(defun ac-ejc-documentation (symbol-name) + "Return a documentation string for SYMBOL-NAME." + (if (not ejc-doc-created-p) + (ejc-create-doc)) + (gethash (intern (downcase symbol-name)) ejc-sql-doc)) + +(defun ejc-dot-pressed () + (interactive) + (insert ".") + (if (and ejc-complete-on-dot (bound-and-true-p company-mode)) + (call-interactively 'company-complete))) + +(provide 'ejc-completion-common) + +;;; ejc-completion-common.el ends here diff --git a/elpa/ejc-sql-20230228.102/ejc-doc.el b/elpa/ejc-sql-20230228.102/ejc-doc.el new file mode 100644 index 00000000..84f696ca --- /dev/null +++ b/elpa/ejc-sql-20230228.102/ejc-doc.el @@ -0,0 +1,91 @@ +;;; ejc-doc.el -- SQL quick hints documentation (the part of ejc-sql). + +;;; Copyright © 2018-2019 - Kostafey + +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software Foundation, +;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ + +;;; Code: + +(require 'dash) + +(defconst ejc-sql-doc (make-hash-table :test 'eq)) + +(defun ejc-fill-doc (hash-const &rest args) + (-reduce (lambda (key val) + (puthash key val hash-const)) + args)) + +(defvar ejc-doc-created-p nil) + +(defun ejc-create-doc () + (ejc-fill-doc + ejc-sql-doc + 'select + "The SQL SELECT statement returns a result +set of records from one or more tables. + +SELECT + [DISTINCT | DISTINCTROW | ALL] + select_expression,... + FROM table_references + [WHERE where_definition] + [GROUP BY {unsigned_integer | col_name | formula}] + [HAVING where_definition] + [ORDER BY {unsigned_integer | col_name | formula} [ASC | DESC], ...]" + + 'insert + "An SQL INSERT statement adds one or more records +to any single table in a relational database. + +INSERT INTO table (column1 [, column2, column3 ... ]) +VALUES (value1 [, value2, value3 ... ])" + + 'update + "An SQL UPDATE statement changes the data of one +or more records in a table. Either all the rows can +be updated, or a subset may be chosen using a condition. + +UPDATE table_name SET column_name = value [, column_name = value ...] +[WHERE condition]" + + 'delete + "The SQL DELETE statement removes one or more records from a table. + +DELETE FROM table_name [WHERE condition]" + + 'alter + "The ALTER TABLE command modifies column definitions and table constraints +'on the fly'. This means existing definitions are extended, changed or +deleted or existing data is casted to a different type or existing data is +evaluated against the new definitions. + +-- change column definitions +ALTER TABLE { ADD | ALTER } [ COLUMN ] + ; +ALTER TABLE { DROP } [ COLUMN ] + ; + +-- change table constraints +ALTER TABLE { ADD | ALTER } CONSTRAINT + ; +ALTER TABLE { DROP } CONSTRAINT + ;" + 'distinct + "Return different values") + (setq ejc-doc-created-p t)) + +(provide 'ejc-doc) + +;;; ejc-doc.el ends here diff --git a/elpa/ejc-sql-20230228.102/ejc-eldoc.el b/elpa/ejc-sql-20230228.102/ejc-eldoc.el new file mode 100644 index 00000000..3057ca8b --- /dev/null +++ b/elpa/ejc-sql-20230228.102/ejc-eldoc.el @@ -0,0 +1,143 @@ +;;; ejc-eldoc.el -- ejc-sql eldoc support (the part of ejc-sql). + +;;; Copyright (C) 2019 - Kostafey + +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software Foundation, +;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ + +;;; Code: + +(require 'dash) +(require 'eldoc) +(require 'ejc-format) + +(defun ejc-replace-property-mark (text fmt face) + (while (string-match fmt text) + (let ((beg (match-beginning 0)) + (end (match-end 0))) + (setq text (concat (substring text 0 beg) + (substring text (1+ beg)))) + (add-face-text-property beg (1- end) face t text))) + text) + +(defun ejc-propertize (text) + (-> text + (ejc-replace-property-mark "\\@\\(\\w+_?\\)+" + 'font-lock-function-name-face) + (ejc-replace-property-mark "\\%\\(\\w+_?\\)+" + 'font-lock-keyword-face) + (ejc-replace-property-mark "\\#\\(\\w+_?\\)+" + 'eldoc-highlight-function-argument))) + +(defconst ejc-sql-expressions + (list + "SELECT" + "%SELECT #field... %FROM table [%WHERE predicate]" + "FROM" + "%SELECT field... %FROM #table [%WHERE predicate]" + "WHERE" + "%WHERE #predicate [%OR predicate] [%AND predicate]")) + +(defun ejc-get-procedure-before-point () + "Return stored procedure name before the point." + (interactive) + (save-excursion + (goto-char (nth 1 (syntax-ppss))) + (thing-at-point 'symbol))) + +(defun ejc-get-package-before-point () + "Return package name of stored procedure before the point." + (interactive) + (save-excursion + (goto-char (nth 1 (syntax-ppss))) + (beginning-of-thing 'symbol) + (when (equal (string (char-before)) ".") + (left-char) + (thing-at-point 'symbol)))) + +(defun ejc-get-parameter-index () + "Return parameter number around the point." + (interactive) + (let ((index 0) + (ch (string (preceding-char)))) + (save-excursion + (while (nth 2 (syntax-ppss)) + (let ((pss (nth 2 (syntax-ppss)))) + (when (member ch (list " " "\t" "\n" ",")) + (setq index (1+ index)) + (setq ch nil)) + (goto-char pss) + (setq index (1+ index))))) + (max (1- index) 0))) + +(defun ejc-get-word-before-point () + "Return SQL word before the point." + (interactive) + (save-excursion + (if (not (member (string (preceding-char)) (list " " "\t" "\n"))) + (forward-same-syntax -1)) + (goto-char (nth 2 (syntax-ppss))) + (thing-at-point 'symbol))) + +(defun ejc-eldoc-function () + "Returns a doc string appropriate for the current context, or nil." + (if-let ((stored-procedure (if (ejc-buffer-connected-p) + (condition-case nil + (ejc-get-procedure-before-point) + (error nil))))) + (let ((type (ejc-get-entity-type ejc-db stored-procedure)) + (package (ejc-get-package-before-point))) + (if (or (eq type :procedure) + (eq type :function)) + (let ((params (car (ejc-get-parameters ejc-db + package + stored-procedure + t))) + (p-index (ejc-get-parameter-index))) + (ejc-propertize + (format "@%s: (%s)" + stored-procedure + (string-join + (-map + (lambda (p) (if (eql (cdr p) p-index) + (ejc-split-and-join + (lambda (s) (concat "#" s )) + " ") + (car p))) + (-zip params + (number-sequence 0 (1- (length params))))) + ", ")))))) + (if-let ((sql-word (condition-case nil + (ejc-get-word-before-point) + (error nil)))) + (if-let ((sql-expression (lax-plist-get + ejc-sql-expressions + sql-word))) + (ejc-propertize sql-expression))))) + +;;;###autoload +(defun ejc-eldoc-setup () + "Set up eldoc function and enable eldoc-mode." + (interactive) + (cond + ((boundp 'eldoc-documentation-strategy) + (setq-local eldoc-documentation-strategy #'ejc-eldoc-function)) + ((boundp 'eldoc-documentation-functions) + (add-hook 'eldoc-documentation-functions #'ejc-eldoc-function nil t)) + (t (setq-local eldoc-documentation-function #'ejc-eldoc-function))) + (eldoc-mode +1)) + +(provide 'ejc-eldoc) + +;;; ejc-eldoc.el ends here diff --git a/elpa/ejc-sql-20230228.102/ejc-flx.el b/elpa/ejc-sql-20230228.102/ejc-flx.el new file mode 100644 index 00000000..2bb98a38 --- /dev/null +++ b/elpa/ejc-sql-20230228.102/ejc-flx.el @@ -0,0 +1,103 @@ +;;; ejc-flx.el -- Customization flx for ejc (the part of ejc-sql). + +;;; Copyright © 2018 - Kostafey + +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software Foundation, +;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ + +;;; Code: + +(defcustom ejc-use-flx nil + "Non-nil enables `flx' fuzzy matching engine autocompletion." + :group 'ejc-sql + :type 'boolean) + +(defcustom ejc-flx-threshold 2 + "The minimum number of typed chars required to use `flx' for autocompletion. +When 1, enables `flx' usage from the first typed char." + :group 'ejc-sql + :type 'integer) + +(defface ejc-flx-highlight-face + '((t :inherit popup-isearch-match)) + "Face used by flx for highlighting flx match characters in `ejc-sql' buffers." + :group 'ejc-sql) + +(defun ejc-flx-propertize (obj score &optional add-score) + "Return propertized copy of obj according to score. + +SCORE of nil means to clear the properties." + (let ((block-started (cadr score)) + (last-char nil) + (str (if (consp obj) + (substring-no-properties (car obj)) + (substring-no-properties obj)))) + + (when score + (dolist (char (cdr score)) + (when (and last-char + (not (= (1+ last-char) char))) + (put-text-property block-started (1+ last-char) 'face 'ejc-flx-highlight-face str) + (setq block-started char)) + (setq last-char char)) + (put-text-property block-started (1+ last-char) 'face 'ejc-flx-highlight-face str) + (when add-score + (setq str (format "%s [%s]" str (car score))))) + (if (consp obj) + (cons str (cdr obj)) + str))) + +(defun ejc-flx-decorate (things &optional clear) + "Add ido text properties to THINGS. +If CLEAR is specified, clear them instead." + (if flx-ido-use-faces + (let ((decorate-count (min ido-max-prospects + (length things)))) + (nconc + (cl-loop for thing in things + for i from 0 below decorate-count + collect (if clear + (ejc-flx-propertize thing nil) + (ejc-flx-propertize (car thing) (cdr thing)))) + (if clear + (nthcdr decorate-count things) + (mapcar 'car (nthcdr decorate-count things))))) + (if clear + things + (mapcar 'car things)))) + +(defun ejc-flx-match-internal (query items) + "Match QUERY against ITEMS using flx scores. + +If filtered item count is still greater than `flx-ido-threshold', then use flex." + (if (< (length query) ejc-flx-threshold) + (all-completions query items) + (let ((flex-result (flx-flex-match query items))) + (if (< (length flex-result) flx-ido-threshold) + (let* ((matches (cl-loop for item in flex-result + for string = (ido-name item) + for score = (flx-score string query flx-file-cache) + if score + collect (cons item score) + into matches + finally return matches))) + (ejc-flx-decorate (delete-consecutive-dups + (sort matches + (lambda (x y) (> (cadr x) (cadr y)))) + t))) + flex-result)))) + +(provide 'ejc-flx) + +;;; ejc-flx.el ends here diff --git a/elpa/ejc-sql-20230228.102/ejc-format.el b/elpa/ejc-sql-20230228.102/ejc-format.el new file mode 100644 index 00000000..a0957ace --- /dev/null +++ b/elpa/ejc-sql-20230228.102/ejc-format.el @@ -0,0 +1,302 @@ +;;; ejc-format.el -- SQL formatting library (the part of ejc-sql). + +;;; Copyright © 2012-2019 - Kostafey + +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software Foundation, +;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ + +;;; Code: + +(require 'cua-base) +(require 'ejc-lib) +(require 'subr-x) +(require 'ejc-result-buffer) + +(defvar ejc-sql-separator "/" + "The char with purpose to separate the SQL statement both other.") + +(defun ejc-sql-separator-re () + (format "^\\s-*%s\\s-*" (or (alist-get :separator ejc-db) + ejc-sql-separator))) + +(defun ejc-get-border-top () + "Get top position of batch statement(s) seperator `ejc-sql-separator'. +Upper position of this batch statement(s)." + (save-excursion + (if (re-search-backward (ejc-sql-separator-re) nil t nil) + (re-search-forward (ejc-sql-separator-re) nil t nil) + (beginning-of-buffer)) + (point))) + +(defun ejc-get-border-bottom () + "Get bottom position of batch statements seperator `ejc-sql-separator' +Bottom position of this batch statement(s)." + (save-excursion + (if (re-search-forward (ejc-sql-separator-re) nil t nil) + (re-search-backward (ejc-sql-separator-re) nil t nil) + (end-of-buffer)) + (if (equal (string (preceding-char)) "\n") + (backward-char 1)) + (let ((sep-len (length ejc-sql-separator))) + (if (equal (buffer-substring (max (point-min) (- (point) sep-len)) + (point)) + ejc-sql-separator) + (backward-char sep-len))) + (point))) + +(defun ejc-get-org-begin () + "Obtain position for begin of code snippet in `org-mode' buffers." + (save-excursion + (if (and (derived-mode-p 'org-mode) + (re-search-backward "^\\s-*#\\+begin_[(src)(example)].*" + nil t nil)) + (line-end-position) + (point-min)))) + +(defun ejc-get-org-end () + "Obtain position for end of code snippet in `org-mode' buffers." + (save-excursion + (if (and (derived-mode-p 'org-mode) + (re-search-forward "^\\s-*#\\+end_[(src)(example)]" + nil t nil)) + (line-beginning-position) + (point-max)))) + +(cl-defun ejc-get-sql-boundaries-at-point (&optional beg end) + "Returns list of the boundaries of the current SQL expression. +The current SQL expression is the expression under the point. +The boundaries are marked by `ejc-sql-separator's. If the top or +bottom boundary is absent - it returns beginning or end of the +buffer. Set BEG and END parameters to add manual boundaries restrictions." + (let* ((beg (max (or beg (point-min)) + (ejc-get-border-top) + (ejc-get-org-begin))) + (end (min (or end (point-max)) + (ejc-get-border-bottom) + (ejc-get-org-end)))) + (list beg end))) + +(defmacro ejc--in-sql-boundaries (beg end &rest body) + "Inject `beg' and `end' local variables to the `body' scope. +`beg' and `end' are the boundaries of the current sql expression." + `(let* ((boundaries (if (and (boundp ',beg) (boundp ',end)) + (ejc-get-sql-boundaries-at-point ,beg ,end) + (ejc-get-sql-boundaries-at-point))) + (,beg (car boundaries)) + (,end (car (cdr boundaries)))) + ,@body)) + +(defun ejc-mark-this-sql () + "Select (mark) SQL around the point." + (interactive) + (ejc--in-sql-boundaries beg end + (when mark-active + (setq mark-active nil)) + (goto-char beg) + (cua-set-mark) + (goto-char end))) + +(defun ejc-next-sql (&optional mark) + "Goto next SQL statement." + (interactive) + (if (equal (buffer-name) ejc-results-buffer-name) + (ejc-show-next-result) + (ejc--in-sql-boundaries + beg end + (if (and mark (not mark-active)) + (cua-set-mark)) + (goto-char end) + (right-char 1)))) + +(defun ejc-previous-sql (&optional mark) + "Goto previous SQL statement." + (interactive) + (if (equal (buffer-name) ejc-results-buffer-name) + (ejc-show-prev-result) + (ejc--in-sql-boundaries + beg end + (if (and mark (not mark-active)) + (cua-set-mark)) + (goto-char beg) + (left-char 1)))) + +(defun ejc-apply-in-sql-boundaries (func) + (ejc--in-sql-boundaries beg end + (apply func (list beg end)))) + +(cl-defun ejc-get-sql-at-point (&key beg end) + "Return SQL around the point." + (ejc--in-sql-boundaries + beg end + (let ((sql (ejc-strip-text-properties + (buffer-substring beg end)))) + sql))) + +(defun ejc-flash-region (start end &optional timeout) + "Temporarily highlight region from START to END." + (let ((overlay (make-overlay start end))) + (overlay-put overlay 'face 'secondary-selection) + (run-with-timer (or timeout 0.2) nil 'delete-overlay overlay))) + +(cl-defun ejc-flash-this-sql (&key beg end) + "Select (mark) SQL around the point." + (interactive) + (ejc--in-sql-boundaries + beg end + (ejc-flash-region beg end))) + +(defmacro ejc-ensure-sql-mode (&rest body) + `(if (not (equal major-mode 'sql-mode)) + (error "SQL formatting is suitable in sql-mode only.") + (progn ,@body))) + +(defun ejc-format-sql (beg end) + (interactive "r") + (ejc-ensure-sql-mode + (save-excursion + (mapc (lambda (from-to) + (ejc-apply-in-sql-boundaries + (lambda (beg end) + (replace-regexp (car from-to) (cadr from-to) nil beg end)))) + '(("\n" " ") + ("," ", ") + (" +" " ") + ("," ",\n ") + ("select" "select \n ") + (" from " "\nfrom \n ") + (" where " "\nwhere \n ") + (" and " "\n and ") + (" or " "\n or ") + (" order by " "\norder by \n") + (" inner join " "\ninner join ") + (" left join " "\nleft join ") + (" on " "\n on ") + (" group by " "\ngroup by ")))))) + +(defun ejc-format-sql-at-point (arg) + "Format SQL bounded by the `ejc-sql-separator' or/and buffer +boundaries." + (interactive "P") + (save-excursion + (ejc--in-sql-boundaries + beg end + (if arg + (ejc-format-sql beg end) + (let ((result (ejc-format-by-hibernate + (buffer-substring beg end)))) + (delete-region beg end) + (insert result))) + (when (equal (char-before beg) + (string-to-char ejc-sql-separator)) + (goto-char beg) + (insert "\n"))) + (ejc-flash-this-sql))) + +(defun ejc-format-sql-region (beg end) + "Pretty-print SQL bounded by the selection area." + (interactive "r") + (let ((result (ejc-format-by-hibernate (buffer-substring beg end)))) + (delete-region beg end) + (insert result))) + +(defun ejc-insert-file-header () + (interactive) + (insert (concat "-- -*- mode: sql; -*-\n" + "-- Local Variables:\n" + "-- eval: (ejc-sql-mode)\n" + "-- End:\n"))) + +(defvar ejc-clear-sql-regexp + (concat "^\\s-*\\t*\"" + "\\|\\\\n\"\s-*\\+$" + "\\|\\\\n\";$")) + +(defun ejc-strinp-sql-at-point () + (interactive) + (ejc--in-sql-boundaries + beg end + (save-excursion + (replace-regexp ejc-clear-sql-regexp "" nil beg end) + (whitespace-cleanup-region beg end)))) + +(defun ejc-longest-line-length (beg-line end-line) + (save-excursion + (let ((curr-line beg-line) + (max-length 0) + (new-length 0)) + (while (<= curr-line end-line) + (goto-line curr-line) + (setq new-length (save-excursion + (end-of-line) + (current-column))) + (if (> new-length max-length) + (setq max-length new-length)) + (setq curr-line (1+ curr-line))) + max-length))) + +(defun ejc-is-separator-string (pos) + (equal (string-trim (buffer-substring + pos + (save-excursion + (end-of-line) + (point)))) + ejc-sql-separator)) + +(defun ejc-dress-sql-at-point () + (interactive) + (ejc-strinp-sql-at-point) + (save-excursion + (ejc--in-sql-boundaries + beg end + (let* ((beg-line (progn (goto-char beg) + (right-char) + (line-number-at-pos))) + (end-line (progn (goto-char end) + (if (ejc-is-separator-string end) + (left-char 1)) + (line-number-at-pos))) + (length-line (ejc-longest-line-length beg-line end-line)) + (curr-line beg-line)) + (while (<= curr-line end-line) + (goto-line curr-line) + (beginning-of-line) + (insert "\"") + (end-of-line) + (dotimes (counter (+ 2 (- length-line (current-column)))) + (insert " ")) + (if (equal curr-line end-line) + (insert "\\n\";") + (insert "\\n\" +")) + (setq curr-line (1+ curr-line))))))) + +(defun ejc-get-word-at-point (pos) + "Return SQL word around the point." + (interactive "d") + (let* ((char (char-after pos)) + (str (char-to-string char))) + (save-excursion + (let* ((end (if (member str '(" " ")" "<" ">" "=")) + (point) + (progn + (forward-sexp 1) + (point)))) + (beg (progn + (forward-sexp -1) + (point))) + (sql-word (buffer-substring beg end))) + sql-word)))) + +(provide 'ejc-format) + +;;; ejc-format.el ends here diff --git a/elpa/ejc-sql-20230228.102/ejc-interaction.el b/elpa/ejc-sql-20230228.102/ejc-interaction.el new file mode 100644 index 00000000..f6f0be5e --- /dev/null +++ b/elpa/ejc-sql-20230228.102/ejc-interaction.el @@ -0,0 +1,342 @@ +;;; ejc-interaction.el -- ejc-sql interact with Clojure. -*- lexical-binding: t -*- + +;;; Copyright © 2013-2020 - Kostafey + +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software Foundation, +;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ + +;;; Code: + +(require 'dash) +(require 'ejc-lib) +(require 'ejc-format) +(require 'clomacs) + +(clomacs-create-httpd-start ejc-httpd-start + :lib-name "ejc-sql") + +(clomacs-create-httpd-stop ejc-httpd-stop + :lib-name "ejc-sql") + +(clomacs-defun ejc-sql-set-db + set-db + :lib-name "ejc-sql" + :namespace ejc-sql.connect + :doc "Define ejc-sql.connect/db var." + :httpd-starter 'ejc-httpd-start) + +(clomacs-defun ejc-add-classpath + add-classpath + :lib-name "ejc-sql" + :namespace ejc-sql.classpath) + +(clomacs-defun ejc-require + clojure.core/require + :lib-name "ejc-sql") + +(clomacs-defun ejc-import + clojure.core/import + :lib-name "ejc-sql") + +(clomacs-defun ejc-class-for-name + Class/forName + :lib-name "ejc-sql") + +(clomacs-defun ejc-get-dependeces-files-list + get-dependeces-files-list + :lib-name "ejc-sql" + :namespace ejc-sql.deps-resolver + :return-type :list) + +(clomacs-defun ejc-resolve-dependencies + resolve-dependencies + :lib-name "ejc-sql" + :namespace cemerick.pomegranate.aether) + +(defun ejc-connect-to-db (conn-struct) + (let* ((jars-to-load + (if-let (dependencies (alist-get :dependencies conn-struct)) + ;; Resolve dependencies and prepare jars paths list to load. + (ejc-get-dependeces-files-list dependencies) + (let* ((classpath (alist-get :classpath conn-struct)) + (dependency-jars (-map + (lambda (jar-path) + (ejc-get-dependeces-files-list + (ejc-path-to-lein-artifact jar-path))) + classpath))) + ;; Join jar files paths from `:classpath' vector of + ;; `ejc-create-connection' and dependencies for this jars. + (delq nil + (delete-dups + (append + (-flatten dependency-jars) + (append classpath nil)))))))) + (-map 'ejc-add-classpath jars-to-load)) + (when-let ((classname (alist-get :classname conn-struct))) + (ejc-class-for-name classname) + (ejc-import (read classname))) + (ejc-sql-set-db conn-struct)) + +(clomacs-defun ejc--eval-sql-and-log-print + eval-sql-and-log-print + :lib-name "ejc-sql" + :namespace ejc-sql.connect + :return-type :string + :doc "Core function to evaluate SQL queries. + Prepare SQL string, evaluate SQL script and write them to log file") + +(clomacs-defun ejc--is-query-running-p + is-query-running? + :lib-name "ejc-sql" + :namespace ejc-sql.connect + :return-type :boolean) + +(clomacs-defun ejc--cancel-query + cancel-query + :lib-name "ejc-sql" + :namespace ejc-sql.connect + :doc "Cancel current query." + :interactive t + :return-type :list) + +(clomacs-defun ejc--describe-table + describe-table + :lib-name "ejc-sql" + :namespace ejc-sql.structure) + +(clomacs-defun ejc-get-entity-type + get-entity-type-fmt + :lib-name "ejc-sql" + :namespace ejc-sql.structure + :return-type :eval) + +(clomacs-defun ejc-get-parameters + get-parameters + :lib-name "ejc-sql" + :namespace ejc-sql.structure + :return-type :list) + +(clomacs-defun ejc-get-entity-description + get-entity-description + :lib-name "ejc-sql" + :namespace ejc-sql.structure) + +(clomacs-defun ejc--get-result-file-path + get-result-file-path + :lib-name "ejc-sql" + :namespace ejc-sql.output) + +(clomacs-defun ejc-print + clojure.core/print + :lib-name "ejc-sql" + :return-type :string + :return-value :stdout) + +(clomacs-defun ejc-write-result-file + write-result-file + :namespace ejc-sql.output + :lib-name "ejc-sql" + :return-type :string) + +(clomacs-defun ejc-clear-result-file + clear-result-file + :namespace ejc-sql.output + :lib-name "ejc-sql" + :return-type :string) + +(clomacs-defun ejc-get-log-file-path + print-log-file-path + :lib-name "ejc-sql" + :namespace ejc-sql.output + :return-value :stdout) + +(clomacs-defun ejc-format-by-hibernate + format-sql-print + :lib-name "ejc-sql" + :namespace ejc-sql.output + :return-value :stdout) + +(clomacs-defun ejc-set-fetch-size + set-fetch-size + :lib-name "ejc-sql" + :namespace ejc-sql.output + :doc (concat "Set limit for number of records to output. " + "When nil no limit.")) + +(clomacs-defun ejc-set-show-too-many-rows-message + set-show-too-many-rows-message + :lib-name "ejc-sql" + :namespace ejc-sql.output + :doc (concat "Show 'Too many rows...' message in case" + "of ResultSet is bigger than `fetch-size'.")) + +(clomacs-defun ejc-set-max-rows + set-max-rows + :lib-name "ejc-sql" + :namespace ejc-sql.output + :doc (concat "Set limit for number of records to contain " + "in ResultSet. When nil no limit.")) + +(clomacs-defun ejc-set-column-width-limit + set-column-width-limit + :lib-name "ejc-sql" + :namespace ejc-sql.output + :doc (concat "Set limit for number of chars per column to " + "output to output. When nil no limit.")) + +(clomacs-defun ejc-set-use-unicode + set-use-unicode + :lib-name "ejc-sql" + :namespace ejc-sql.output + :doc "Set using unicode for grid borders.") + +(clomacs-defun ejc-get-stucture + get-stucture + :lib-name "ejc-sql" + :namespace ejc-sql.structure + :return-type :list) + +(clomacs-defun ejc-get-owners-candidates + get-owners-candidates + :lib-name "ejc-sql" + :namespace ejc-sql.structure + :return-type :list) + +(clomacs-defun ejc-get-tables-candidates + get-tables-candidates + :lib-name "ejc-sql" + :namespace ejc-sql.structure + :return-type :list) + +(clomacs-defun ejc-get-views-candidates + get-views-candidates + :lib-name "ejc-sql" + :namespace ejc-sql.structure + :return-type :list) + +(clomacs-defun ejc-get-packages-candidates + get-packages-candidates + :lib-name "ejc-sql" + :namespace ejc-sql.structure + :return-type :list) + +(clomacs-defun ejc-get-colomns-candidates + get-colomns-candidates + :lib-name "ejc-sql" + :namespace ejc-sql.structure + :return-type :list) + +(clomacs-defun ejc-get-cached-owners-list + get-owners + :lib-name "ejc-sql" + :namespace ejc-sql.structure + :return-type :list) + +(clomacs-defun ejc-get-cached-tables-list + get-tables + :lib-name "ejc-sql" + :namespace ejc-sql.structure + :return-type :list + :doc "Return cached tables list. + Requires `ejc-db' buffer local variable as parameter.") + +(clomacs-defun ejc-get-cached-colomns-list + get-colomns + :lib-name "ejc-sql" + :namespace ejc-sql.structure + :return-type :list) + +(clomacs-defun ejc-get-keywords-inner + get-keywords + :lib-name "ejc-sql" + :namespace ejc-sql.structure + :return-type :list) + +(clomacs-defun ejc-invalidate-cache-inner + invalidate-cache + :lib-name "ejc-sql" + :namespace ejc-sql.cache + :doc (concat "Clean your current connection cache " + "(database owners and tables list).")) + +(clomacs-defun ejc-validate-connection + validate-connection + :lib-name "ejc-sql" + :namespace ejc-sql.connect + :return-type :eval) + +(defun ejc-invalidate-cache () + "Clean current connection cache (database owners and tables list)." + (interactive) + (ejc-invalidate-cache-inner ejc-db)) + +(clomacs-defun ejc-output-cache + output-cache + :lib-name "ejc-sql" + :namespace ejc-sql.cache + :return-type :eval) + +(defun ejc-print-cache () + "Print current database connection cache when run from connected SQL buffer. +Print all connections cache otherwise." + (interactive) + (pprint (ejc-output-cache ejc-db))) + +(clomacs-defun ejc-select-db-meta-script + select-db-meta-script + :lib-name "ejc-sql" + :namespace ejc-sql.structure) + +(clomacs-defun ejc-get-db-name + get-db-name + :lib-name "ejc-sql" + :namespace ejc-sql.structure) + +(clomacs-defun ejc-get-this-owner + get-this-owner + :lib-name "ejc-sql" + :namespace ejc-sql.structure) + +(defun ejc-unset-mode-name () + (if (derived-mode-p 'org-mode) + (setq mode-name "Org") + (if (derived-mode-p 'sql-mode) + (setq mode-name "SQL")))) + +(defun ejc-quit-connection () + "Stop nREPL process, mark ejc-sql-mode buffers disconnected." + (interactive) + (when (y-or-n-p "Are you sure you want to close all jdbc connections?") + (ejc-httpd-stop) + (cider--close-connection (clomacs-get-connection "ejc-sql")) + ;; Update modeline of ejc-sql-mode buffers - mark as disconnected. + (let ((buffers (buffer-list))) + (while buffers + (with-current-buffer (car buffers) + (when (member 'ejc-sql-mode minor-mode-list) + (ejc-unset-mode-name) + (spinner-stop))) + (setq buffers (cdr buffers))))) + (unless (cider-connected-p) + (cider-close-ancillary-buffers))) + +(defalias 'ejc-close-connection 'ejc-quit-connection) + +(defun ejc-buffer-connected-p () + "Check if current buffer is connected to database." + (and (clomacs-get-connection "ejc-sql") (boundp 'ejc-db) ejc-db)) + +(provide 'ejc-interaction) + +;;; ejc-interaction.el ends here diff --git a/elpa/ejc-sql-20230228.102/ejc-lib.el b/elpa/ejc-sql-20230228.102/ejc-lib.el new file mode 100644 index 00000000..459519dc --- /dev/null +++ b/elpa/ejc-sql-20230228.102/ejc-lib.el @@ -0,0 +1,172 @@ +;;; ejc-lib.el -- ejc-sql shared objects (the part of ejc-sql). + +;;; Copyright © 2013-2023 - Kostafey + +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software Foundation, +;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ + +;;; Code: + +(require 's) +(require 'dash) +(require 'sql) + +(defvar-local ejc-connection-name nil + "Buffer-local connection name created with `ejc-create-connection'.") + +(defvar-local ejc-connection-struct nil + "Buffer-local connection structure.") + +(defun ejc-lein-artifact-to-path (artifact) + "Get ~/.m2 jar file path of artifact." + (if (not (vectorp artifact)) + (error + "Expect leiningen artifact, e.g. [com.h2database/h2 \"1.4.199\"].")) + (let* ((group (car (split-string + (ejc-strip-text-properties (symbol-name (elt artifact 0))) + "/"))) + (name (or (cadr (split-string + (ejc-strip-text-properties + (symbol-name (elt artifact 0))) "/")) + group)) + (version (elt artifact 1))) + (format "~/.m2/repository/%s/%s/%s/%s-%s.jar" + (mapconcat 'identity (split-string group "\\.") "/") + name + version + name + version))) + +(defun ejc-path-to-lein-artifact (path) + "Get leiningen artifact from ~/.m2 jar file path." + (if (not (stringp path)) + (error + "Expect jar file path.")) + (let* ((path (s-replace "\\" "/" path)) + (path (nth 1 (s-split ".m2/repository/" path))) + (path-elements (s-split "/" path)) + (version (nth (- (length path-elements) 2) path-elements)) + (name (nth (- (length path-elements) 3) path-elements)) + (group (s-join "." (-> path-elements -butlast -butlast -butlast)))) + (read + (format "[[%s/%s \"%s\"]]" + group + name + version)))) + +(defun ejc-string-endswith-p (s ending) + "Return non-nil if string S ends with ENDING." + (let ((elength (length ending))) + (string= (substring s (- 0 elength)) ending))) + +(defun ejc-find-file-in-load-path (search-file-name &optional fail-on-error) + "Return the full path to `file-name'. +`file-name' is searching in the emacs `load-path'." + (let ((result nil)) + (dolist (path load-path) + (let ((search-file-path (expand-file-name search-file-name path))) + (if (file-exists-p search-file-path) + (setq result search-file-path)))) + (if (and fail-on-error (not result)) + (error (concat "Can't find file " search-file-name)) + result))) + +(defun ejc-strip-text-properties (txt) + (set-text-properties 0 (length txt) nil txt) + txt) + +(defvar ejc-product-assoc + '((sqlserver . ms) + (oracle:sid . oracle))) + +(defun ejc-get-product-name (db) + "Get database type from db connection info." + (let ((product-name (or (alist-get :subprotocol db) + (alist-get :dbtype db)))) + (or (cdr (assoc-string product-name ejc-product-assoc)) + (car (assoc-string product-name sql-product-alist)) + 'ansi))) + +(defun ejc-ensure-file-directory-exists (file-path) + (let ((dir (file-name-directory file-path))) + (if (not (file-accessible-directory-p dir)) + (make-directory dir)))) + +(defun ejc-save-to-file (file-path data) + "Save Elisp variable DATA to FILE-PATH." + (ejc-ensure-file-directory-exists file-path) + (with-temp-file file-path + (prin1 data (current-buffer)))) + +(cl-defun ejc-load-from-file (file-path &key default check) + "Read Elisp variable from FILE-PATH." + (ejc-ensure-file-directory-exists file-path) + (condition-case nil + (with-temp-buffer + (insert-file-contents file-path) + (let ((value (read (current-buffer)))) + (if (and check (funcall check value)) + value + (error "File contents don't match function check.")))) + (error (ejc-save-to-file file-path default) + default))) + +(defun ejc-plist-p (lst) + "Check if LST is a plist." + (condition-case nil + (progn + (lax-plist-get lst nil) + t) + (error nil))) + +(defun ejc-flatten-index (imenu-index) + "Flatten imenu index into a plain list. +IMENU-INDEX - imenu index tree." + (-mapcat + (lambda (x) + (if (imenu--subalist-p x) + (mapcar (lambda (y) (cons (car y) (cdr y))) + (ejc-flatten-index (cdr x))) + (list x))) + imenu-index)) + +(defun ejc-split-and-join (fn split &optional join) + "Split string by SPLIT, apply FN to each substring, than join by JOIN." + (let ((join (or join split))) + (string-join + (-map fn (split-string (car p) split)) + join))) + +(defun ejc-not-nil-str (s) + (not (equal s "nil"))) + +(defun ejc-append-without-duplicates (list-left list-right comparator lead) + "Unite LIST-LEFT and LIST-RIGHT without duplicates items. +Check items equality by COMPARATOR function. +In case if some item presents in both lists (in terms of COMPARATOR +equality) get the item from LIST-LEFT if LEAD param is `:left'or +get it from LIST-RIGHT if LEAD param is `:right'." + (let* ((a (if (eq lead :left) list-left list-right)) + (b (if (eq lead :left) list-right list-left)) + (a-results (-map comparator a))) + (append a + (-filter + (lambda (b-item) + (not (-contains-p a-results + (funcall comparator b-item)))) + b)))) + +(provide 'ejc-lib) + +;;; ejc-lib.el ends here diff --git a/elpa/ejc-sql-20230228.102/ejc-result-buffer.el b/elpa/ejc-sql-20230228.102/ejc-result-buffer.el new file mode 100644 index 00000000..fb61175a --- /dev/null +++ b/elpa/ejc-sql-20230228.102/ejc-result-buffer.el @@ -0,0 +1,212 @@ +;;; ejc-result-buffer.el + +;;; Copyright © 2019-2020 - Kostafey + +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software Foundation, +;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ + +;;; Code: + +(require 'ejc-lib) +(require 'ejc-result-mode) + +(defvar ejc-results-buffer nil + "The results buffer.") + +(defvar ejc-results-buffer-name "*ejc-sql-output*" + "The results buffer name.") + +(defvar ejc-result-file-template "ejc-sql-result-%d.txt" + "SQL evaluation results file name template.") + +(defvar ejc-result-file-path nil + "The current result file path. Refreshed by any finished SQL evaluation.") + +(defcustom ejc-results-path temporary-file-directory + "SQL evaluation result files location." + :group 'ejc-sql + :type 'string) + +(defcustom ejc-ring-length 10 + "The number of SQL evaluation results to keep." + :group 'ejc-sql + :type 'integer) + +(defcustom ejc-show-result-bottom nil + "When t show result output buffer in the bottom window." + :group 'ejc-sql + :type 'boolean) + +(defvar ejc-ring-position 0 + "Current SQL evaluation result position in ring.") + +(defvar ejc-modes-ring (list) + "List of SQL evaluation result modes.") + +(defcustom ejc-modes-ring-file (expand-file-name + "ejc-modes-ring.el" + ejc-results-path) + "Previous SQL evaluation result modes file location." + :group 'ejc-sql + :type 'string) + +(defun ejc-update-modes-ring (mode) + "Update SQL evaluation result modes list, persist it in `ejc-modes-ring-file'." + (setf (alist-get ejc-ring-position ejc-modes-ring) mode) + (ejc-save-to-file ejc-modes-ring-file ejc-modes-ring)) + +(defun ejc-load-modes-ring () + "Load SQL evaluation result modes list `ejc-modes-ring' var." + (setq ejc-modes-ring + (ejc-load-from-file ejc-modes-ring-file :default (list)))) + +(defun ejc-get-result-file-path () + "Get current SQL evaluation result file path." + (expand-file-name (format ejc-result-file-template ejc-ring-position) + ejc-results-path)) + +(defun ejc-inc-ring-position () + (setq ejc-ring-position (1+ ejc-ring-position) + ejc-ring-position (if (>= ejc-ring-position ejc-ring-length) + 0 + ejc-ring-position))) + +(defun ejc-dec-ring-position () + (setq ejc-ring-position (1- ejc-ring-position) + ejc-ring-position (if (< ejc-ring-position 0) + (1- ejc-ring-length) + ejc-ring-position))) + +(defun ejc-iterate-ring (inc-or-dec &optional should-exist) + (funcall inc-or-dec) + (if should-exist + (let ((idx 0)) + (while (and (not (file-exists-p (ejc-get-result-file-path))) + (if (< idx ejc-ring-length) + t + (progn + (setq ejc-ring-position 0) + nil))) + (setq idx (1+ idx)) + (funcall inc-or-dec)))) + (setq ejc-result-file-path (ejc-get-result-file-path))) + +(defun ejc-next-result-file-path (&optional should-exist) + (ejc-iterate-ring 'ejc-inc-ring-position should-exist)) + +(defun ejc-prev-result-file-path (&optional should-exist) + (ejc-iterate-ring 'ejc-dec-ring-position should-exist)) + +(defun ejc-get-output-buffer () + "Get or create buffer for output SQL evaluation results. +It can be result sets, record affected messages, SQL definition of entities +or error messages." + (when (not (and ejc-results-buffer + (buffer-live-p ejc-results-buffer))) + (setq ejc-results-buffer (get-buffer-create + ejc-results-buffer-name)) + (with-current-buffer ejc-results-buffer + (ejc-result-mode))) + (with-current-buffer ejc-results-buffer + ;; Clear undo history + (setq buffer-undo-list nil)) + ejc-results-buffer) + +(defun ejc-output-mode-specific-customization () + (cl-case ejc-result-table-impl + (orgtbl-mode (when (org-table-p) (org-table-align))) + (ejc-result-mode (read-only-mode 1)))) + +(defun ejc-show-result-buffer (output-buffer) + (if ejc-show-result-bottom + (display-buffer output-buffer '(display-buffer-at-bottom . ())) + (display-buffer output-buffer))) + +;;;###autoload +(cl-defun ejc-show-last-result (&key result + mode + connection-name + db + goto-symbol) + "Popup buffer with last SQL execution result output." + (interactive) + (let ((output-buffer (ejc-get-output-buffer))) + (with-current-buffer output-buffer + (read-only-mode -1) + (erase-buffer) + (when mode + (ejc-update-modes-ring mode) + (funcall mode)) + (ejc-add-connection connection-name db) + (if result + ;; SQL evaluation result passed directly to fn + (insert result) + ;; SQL evaluation result rendered to file + (insert-file-contents (ejc-get-result-file-path))) + (ejc-output-mode-specific-customization) + (beginning-of-buffer) + (let* ((window (or (get-buffer-window output-buffer t) + (progn + (ejc-show-result-buffer output-buffer) + (get-buffer-window output-buffer t)))) + (frame (window-frame window))) + (if (not (eq frame (selected-frame))) + (make-frame-visible frame)) + (if goto-symbol + ;; Reversed, since if the result buffer is a package, it can + ;; contain 2 concatenated parts: header and implementation. + ;; Assume user wants to locate a point (cursor) in + ;; procedure implementation. + (if-let* ((items-list (reverse (delq imenu--rescan-item + (ejc-flatten-index + (condition-case nil + (imenu--make-index-alist) + (error nil)))))) + ;; Find symbol position (typically to locate the + ;; beginning of procedure implementation in the package). + (pos (alist-get goto-symbol items-list nil nil 'equal))) + (set-window-point window pos))))))) + +(cl-defun ejc-show-ring-result (prev-or-next) + (let ((output-buffer (ejc-get-output-buffer))) + (set-buffer output-buffer) + (read-only-mode -1) + (erase-buffer) + (ejc-add-connection ejc-connection-name ejc-db) + (let ((file-path (funcall prev-or-next t)) + (mode (alist-get ejc-ring-position (or ejc-modes-ring + (ejc-load-modes-ring))))) + (if mode + (funcall mode)) + (insert-file-contents file-path) + (ejc-output-mode-specific-customization) + (beginning-of-buffer) + (ejc-show-result-buffer output-buffer) + (message file-path)))) + +;;;###autoload +(cl-defun ejc-show-prev-result () + "Change `ejc-results-buffer' contents: show previous SQL evaluation result." + (interactive) + (ejc-show-ring-result 'ejc-prev-result-file-path)) + +;;;###autoload +(cl-defun ejc-show-next-result () + "Change `ejc-results-buffer' contents: show next SQL evaluation result." + (interactive) + (ejc-show-ring-result 'ejc-next-result-file-path)) + +(provide 'ejc-result-buffer) + +;;; ejc-result-buffer.el ends here diff --git a/elpa/ejc-sql-20230228.102/ejc-result-mode.el b/elpa/ejc-sql-20230228.102/ejc-result-mode.el new file mode 100644 index 00000000..3f849c7f --- /dev/null +++ b/elpa/ejc-sql-20230228.102/ejc-result-mode.el @@ -0,0 +1,51 @@ +;;; ejc-result-mode.el + +;;; Copyright © 2017-2020 - Kostafey + +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software Foundation, +;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ + +;;; Code: + +(defface ejc-result-table-borders-face '((t :inherit font-lock-comment-face + :italic nil)) + "Face used to font-lock table borders." + :group 'ejc-sql-faces) + +(defconst ejc-result-font-lock-keywords + '(("|" . 'ejc-result-table-borders-face) + ("-" . 'ejc-result-table-borders-face) + ("+" . 'ejc-result-table-borders-face) + ("│" . 'ejc-result-table-borders-face) + ("─" . 'ejc-result-table-borders-face) + ("┼" . 'ejc-result-table-borders-face))) + +(defvar ejc-result-mode-hook nil + "Functions to be called when `ejc-result-mode' is entered.") + +(defun ejc-result-mode () + (interactive) + (kill-all-local-variables) + (setq truncate-lines t) + (setq major-mode 'ejc-result-mode + mode-name "SQL-Result") + (cl-case ejc-result-table-impl + (orgtbl-mode (orgtbl-mode 1)) + (ejc-result-mode (setq view-read-only t))) + (setq font-lock-defaults '(ejc-result-font-lock-keywords)) + (run-hooks 'ejc-result-mode-hook)) + +(provide 'ejc-result-mode) + +;;; ejc-result-mode.el ends here diff --git a/elpa/ejc-sql-20230228.102/ejc-sql-autoloads.el b/elpa/ejc-sql-20230228.102/ejc-sql-autoloads.el new file mode 100644 index 00000000..c05dbe88 --- /dev/null +++ b/elpa/ejc-sql-20230228.102/ejc-sql-autoloads.el @@ -0,0 +1,225 @@ +;;; ejc-sql-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (autoloads nil "ejc-autocomplete" "ejc-autocomplete.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from ejc-autocomplete.el + +(autoload 'ejc-ac-setup "ejc-autocomplete" "\ +Add the completion sources to the front of `ac-sources'. +This affects only the current buffer. + +Check against following cases: +prefix-2.prefix-1.# +prefix-1.# +something#" t nil) + +(register-definition-prefixes "ejc-autocomplete" '("ac-source-ejc-" "ejc-ac-hook")) + +;;;*** + +;;;### (autoloads nil "ejc-company" "ejc-company.el" (0 0 0 0)) +;;; Generated autoloads from ejc-company.el + +(register-definition-prefixes "ejc-company" '("ejc-company-")) + +;;;*** + +;;;### (autoloads nil "ejc-completion-common" "ejc-completion-common.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from ejc-completion-common.el + +(autoload 'ejc-owners-candidates "ejc-completion-common" nil nil nil) + +(autoload 'ejc-tables-candidates "ejc-completion-common" nil nil nil) + +(autoload 'ejc-views-candidates "ejc-completion-common" nil nil nil) + +(autoload 'ejc-packages-candidates "ejc-completion-common" nil nil nil) + +(autoload 'ejc-colomns-candidates "ejc-completion-common" nil nil nil) + +(register-definition-prefixes "ejc-completion-common" '("ac-ejc-documentation" "ejc-")) + +;;;*** + +;;;### (autoloads nil "ejc-doc" "ejc-doc.el" (0 0 0 0)) +;;; Generated autoloads from ejc-doc.el + +(register-definition-prefixes "ejc-doc" '("ejc-")) + +;;;*** + +;;;### (autoloads nil "ejc-eldoc" "ejc-eldoc.el" (0 0 0 0)) +;;; Generated autoloads from ejc-eldoc.el + +(autoload 'ejc-eldoc-setup "ejc-eldoc" "\ +Set up eldoc function and enable eldoc-mode." t nil) + +(register-definition-prefixes "ejc-eldoc" '("ejc-")) + +;;;*** + +;;;### (autoloads nil "ejc-flx" "ejc-flx.el" (0 0 0 0)) +;;; Generated autoloads from ejc-flx.el + +(register-definition-prefixes "ejc-flx" '("ejc-")) + +;;;*** + +;;;### (autoloads nil "ejc-format" "ejc-format.el" (0 0 0 0)) +;;; Generated autoloads from ejc-format.el + +(register-definition-prefixes "ejc-format" '("ejc-")) + +;;;*** + +;;;### (autoloads nil "ejc-interaction" "ejc-interaction.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from ejc-interaction.el + +(register-definition-prefixes "ejc-interaction" '("ejc-")) + +;;;*** + +;;;### (autoloads nil "ejc-lib" "ejc-lib.el" (0 0 0 0)) +;;; Generated autoloads from ejc-lib.el + +(register-definition-prefixes "ejc-lib" '("ejc-")) + +;;;*** + +;;;### (autoloads nil "ejc-result-buffer" "ejc-result-buffer.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from ejc-result-buffer.el + +(autoload 'ejc-show-last-result "ejc-result-buffer" "\ +Popup buffer with last SQL execution result output. + +\(fn &key RESULT MODE CONNECTION-NAME DB GOTO-SYMBOL)" t nil) + +(autoload 'ejc-show-prev-result "ejc-result-buffer" "\ +Change `ejc-results-buffer' contents: show previous SQL evaluation result." t nil) + +(autoload 'ejc-show-next-result "ejc-result-buffer" "\ +Change `ejc-results-buffer' contents: show next SQL evaluation result." t nil) + +(register-definition-prefixes "ejc-result-buffer" '("ejc-")) + +;;;*** + +;;;### (autoloads nil "ejc-result-mode" "ejc-result-mode.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from ejc-result-mode.el + +(register-definition-prefixes "ejc-result-mode" '("ejc-result-")) + +;;;*** + +;;;### (autoloads nil "ejc-sql" "ejc-sql.el" (0 0 0 0)) +;;; Generated autoloads from ejc-sql.el + +(autoload 'ejc-sql-mode "ejc-sql" "\ +Toggle ejc-sql mode. + +This is a minor mode. If called interactively, toggle the +`ejc-Sql mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `ejc-sql-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + +\(fn &optional ARG)" t nil) + +(autoload 'ejc-create-menu "ejc-sql" nil nil nil) + +(autoload 'ejc-insert-connection-data "ejc-sql" "\ +Insert configured connection data to keep it between Emacs restarts. +Assume to be evaluated somewhere in .emacs or any file, loaded as Emacs +configuration. + +\(fn CONNECTION-NAME)" t nil) + +(autoload 'ejc-connect-interactive "ejc-sql" "\ +Create new connection interactively and connect to it. + +\(fn CONNECTION-NAME)" t nil) + +(autoload 'ejc-connect "ejc-sql" "\ +Connect to selected db. + +\(fn CONNECTION-NAME)" t nil) + +(autoload 'ejc-connect-existing-repl "ejc-sql" "\ +Connect to existing ejc-sql nREPL running process. +You can `cd` to your ejc-sql project folder (typically +'~/.emacs.d/elpa/ejc-sql-') and launch nREPL via `lein repl`. +Then run in Emacs `ejc-connect-existing-repl', type HOST and PORT +from your `lein run` console output. Finally, use `ejc-connect' from +any SQL buffer to connect to exact database, as always. " t nil) + +(autoload 'ejc-eval-user-sql-region "ejc-sql" "\ +Evaluate SQL bounded by the selection area. + +\(fn BEG END)" t nil) + +(autoload 'ejc-eval-user-sql-at-point "ejc-sql" "\ +Evaluate SQL bounded by the `ejc-sql-separator' or/and buffer +boundaries. + +\(fn &key SYNC BEG END (DISPLAY-RESULT t))" t nil) + +(autoload 'ejc-show-tables-list "ejc-sql" "\ +Output tables list." t nil) + +(autoload 'ejc-show-views-list "ejc-sql" "\ +Output views list." t nil) + +(autoload 'ejc-show-user-types-list "ejc-sql" "\ +Output user types list. + +\(fn &optional OWNER)" t nil) + +(autoload 'ejc-show-constraints-list "ejc-sql" "\ +Output constraints list. + +\(fn &optional OWNER TABLE)" t nil) + +(autoload 'ejc-show-procedures-list "ejc-sql" "\ +Output procedures list." t nil) + +(autoload 'ejc-get-temp-editor-buffer "ejc-sql" "\ + + +\(fn &optional NUM)" t nil) + +(autoload 'ejc-version "ejc-sql" "\ +Get the ejc-sql version as string." t nil) + +(register-definition-prefixes "ejc-sql" '("ejc-")) + +;;;*** + +;;;### (autoloads nil nil ("ejc-sql-pkg.el") (0 0 0 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; ejc-sql-autoloads.el ends here diff --git a/elpa/ejc-sql-20230228.102/ejc-sql-pkg.el b/elpa/ejc-sql-20230228.102/ejc-sql-pkg.el new file mode 100644 index 00000000..f2c19318 --- /dev/null +++ b/elpa/ejc-sql-20230228.102/ejc-sql-pkg.el @@ -0,0 +1,17 @@ +(define-package "ejc-sql" "20230228.102" "Emacs SQL client uses Clojure JDBC." + '((emacs "26.3") + (clomacs "0.0.5") + (dash "2.16.0") + (spinner "1.7.3")) + :commit "29308faad38e9cabd98fb5a8450df15db1e4a4cb" :authors + '(("Kostafey" . "kostafey@gmail.com")) + :maintainers + '(("Kostafey" . "kostafey@gmail.com")) + :maintainer + '("Kostafey" . "kostafey@gmail.com") + :keywords + '("sql" "jdbc") + :url "https://github.com/kostafey/ejc-sql") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/ejc-sql-20230228.102/ejc-sql.el b/elpa/ejc-sql-20230228.102/ejc-sql.el new file mode 100644 index 00000000..c60e0aa1 --- /dev/null +++ b/elpa/ejc-sql-20230228.102/ejc-sql.el @@ -0,0 +1,885 @@ +;;; ejc-sql.el --- Emacs SQL client uses Clojure JDBC. -*- lexical-binding: t -*- + +;;; Copyright © 2012-2020 - Kostafey + +;; Author: Kostafey +;; URL: https://github.com/kostafey/ejc-sql +;; Keywords: sql, jdbc +;; Version: 0.4.1 +;; Package-Requires: ((emacs "26.3")(clomacs "0.0.5")(dash "2.16.0")(spinner "1.7.3")) + +;; This file is not part of GNU Emacs. + +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software Foundation, +;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ + +;;; Commentary: + +;; ejc-sql turns Emacs into simple SQL client, it uses JDBC connection to +;; databases via clojure/java.jdbc lib. + +;; See README.md for detailed description. + +;;; Code: + +(require 'sql) +(require 'dash) +(require 'cl-lib) +(require 'org-table) +(require 'ejc-lib) +(require 'ejc-eldoc) +(require 'ejc-format) +(require 'ejc-interaction) +(require 'ejc-result-mode) +(require 'ejc-result-buffer) +(require 'ejc-completion-common) + +(defvar-local ejc-db nil + "JDBC connection info for current SQL buffer.") + +(defvar ejc-connections nil + "List of existing configured jdbc connections") + +(defvar ejc-current-buffer-query nil + "Current SQL edit buffer lanched query.") + +(defcustom ejc-temp-editor-buffer-name "ejc-sql-editor" + "Template name for buffers used to ad-hoc edit SQL scripts." + :group 'ejc-sql + :type 'string) + +(defcustom ejc-temp-editor-file-path (expand-file-name "~/tmp/ejc-sql/") + "Directory to save temp ad-hoc SQL edit buffers contents." + :group 'ejc-sql + :type 'string) + +(defcustom ejc-keymap-prefix (kbd "C-c e") + "ejc-sql keymap prefix." + :group 'ejc-sql + :type 'string) + +(defcustom ejc-date-output-format "%d.%m.%Y %H:%M:%S" + "ejc-sql date output format." + :group 'ejc-sql + :type 'string) + +(defcustom ejc-connection-validate-timeout 5 + "The time in seconds to wait for the database connection validation." + :group 'ejc-sql + :type 'integer) + +(defcustom ejc-result-table-impl 'orgtbl-mode + "Set mode for result-set table. Possible values are one of: +'orgtbl-mode +'ejc-result-mode." + :group 'ejc-sql + :type 'symbol) + +(defcustom ejc-org-mode-babel-wrapper t + "Add wrapper around org-mode default `org-babel-execute:sql'." + :type 'boolean + :safe #'booleanp + :group 'ejc-sql) + +(defcustom ejc-org-mode-show-results t + "When t show SQL query results of `org-mode' code snippet in the same buffer. +An expected behaviour for `org-mode' users. Disable popup window with SQL +results. When nil, otherwise, provide `ejc-sql' users expected behaviour." + :group 'ejc-sql + :type 'boolean) + +(defcustom ejc-jdbc-drivers + '("sqlite" [org.xerial/sqlite-jdbc "3.23.1"] + "h2" [com.h2database/h2 "1.4.199"] + "mysql" [mysql/mysql-connector-java "5.1.44"] + "postgresql" [postgresql/postgresql "9.3-1102.jdbc41"] + "sqlserver" [com.microsoft.sqlserver/mssql-jdbc "6.2.2.jre8"] + "oracle" [com.oracle.jdbc/ojdbc8 "12.2.0.1"]) + "Artifacts used as JDBC drivers for each database type in Leiningen format." + :group 'ejc-sql + :type '(plist :key-type string :value-type (vector symbol string))) + +(defcustom ejc-completion-system 'standard + "The completion system used by `ejc-connect'." + :group 'ejc-sql + :type '(radio + (const :tag "Ido" ido) + (const :tag "Standard" standard) + (function :tag "Custom function"))) + +(defvar-local ejc-replace-double-quotes nil + "When t replace double quotes with single ones in SQL before evaluation.") + +(defvar ejc-sql-mode-keymap (make-keymap) "ejc-sql-mode keymap.") +(define-key ejc-sql-mode-keymap (kbd "C-c C-c") 'ejc-eval-user-sql-at-point) +(define-key ejc-sql-mode-keymap (kbd "C-c C-r") 'ejc-eval-user-sql-region) +(define-key ejc-sql-mode-keymap (kbd "C-h t") 'ejc-describe-table) +(define-key ejc-sql-mode-keymap (kbd "C-h d") 'ejc-describe-entity) +(define-key ejc-sql-mode-keymap (kbd "C-M-S-b") (lambda () (interactive) (ejc-previous-sql t))) +(define-key ejc-sql-mode-keymap (kbd "C-M-S-f") (lambda () (interactive) (ejc-next-sql t))) +(define-key ejc-sql-mode-keymap (kbd "C-M-b") 'ejc-previous-sql) +(define-key ejc-sql-mode-keymap (kbd "C-M-f") 'ejc-next-sql) +(define-key ejc-sql-mode-keymap (kbd "C-g") 'ejc-cancel-query) +(define-key ejc-sql-mode-keymap (kbd "M-.") 'ejc-describe-entity) +(define-key ejc-sql-mode-keymap (kbd "M-,") 'ejc-show-prev-result) +(define-key ejc-sql-mode-keymap (kbd ".") 'ejc-dot-pressed) + +(defvar ejc-command-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "c") #'ejc-connect) + (define-key map (kbd "i") #'ejc-connect-interactive) + (define-key map (kbd "") #'ejc-show-last-result) + (define-key map (kbd "t") #'ejc-show-tables-list) + (define-key map (kbd "v") #'ejc-show-views-list) + (define-key map (kbd "p") #'ejc-show-procedures-list) + (define-key map (kbd "T") #'ejc-show-user-types-list) + (define-key map (kbd "s") #'ejc-strinp-sql-at-point) + (define-key map (kbd "S") #'ejc-dress-sql-at-point) + (define-key map (kbd "f") #'ejc-format-sql-at-point) + map) + "Keymap for ejc-sql commands after `ejc-keymap-prefix'.") +(fset 'ejc-command-map ejc-command-map) + +(define-key ejc-sql-mode-keymap ejc-keymap-prefix 'ejc-command-map) + +(defvar ejc-sql-minor-mode-exit-hook nil + "*Functions to be called when `ejc-sql-mode' is exited.") + +(defvar ejc-sql-minor-mode-hook nil + "*Functions to be called when `ejc-sql-mode' is entered.") + +(defvar ejc-sql-connected-hook nil + "Hook run when nREPL started and some buffer connected to DataBase.") + +(defvar ejc-sql-complete-query-hook nil + "Hook run when SQL query executed and the result is outputted.") + +(defvar ejc-sql-mode nil) + +(defvar ejc-conn-statistics (list) + "Keep connection usage statistics and offer most frequently used first + when `ejc-connect' is called.") + +(defcustom ejc-conn-statistics-file (expand-file-name + "~/.ejc-sql/connection-statistics.el") + "Connection usage statistics data file location." + :group 'ejc-sql + :type 'string) + +(defface ejc-separator-face + '((t :inherit font-lock-function-name-face)) + "Face used to highlight SQL statement separators." + :group 'ejc-sql) + +(defun ejc-refresh-font-lock () + (funcall (if ejc-sql-mode + 'font-lock-add-keywords + 'font-lock-remove-keywords) + nil `((,(ejc-sql-separator-re) . 'ejc-separator-face))) + (if (fboundp 'font-lock-flush) + (font-lock-flush) + (when font-lock-mode + (with-no-warnings (font-lock-fontify-buffer))))) + +;;;###autoload +(define-minor-mode ejc-sql-mode + "Toggle ejc-sql mode." + :lighter " ejc" + :keymap ejc-sql-mode-keymap + :group 'ejc + :global nil + (if ejc-sql-mode + (progn + (ejc-create-menu) + (ejc-refresh-font-lock) + (run-hooks 'ejc-sql-minor-mode-hook)) + (progn + (ejc-refresh-font-lock) + (run-hooks 'ejc-sql-minor-mode-exit-hook)))) + +;;;###autoload +(defun ejc-create-menu () + (define-key-after + ejc-sql-mode-keymap + [menu-bar ejc-menu] + (cons "ejc-sql" (make-sparse-keymap "ejc-sql mode")) + 'tools ) + (define-key + ejc-sql-mode-keymap + [menu-bar ejc-menu ev] + '("Eval SQL" . ejc-eval-user-sql-at-point)) + (define-key + ejc-sql-mode-keymap + [menu-bar ejc-menu fs] + '("Format SQL" . ejc-format-sql-at-point)) + (define-key + ejc-sql-mode-keymap + [menu-bar ejc-menu ms] + '("Mark SQL" . ejc-mark-this-sql)) + (define-key + ejc-sql-mode-keymap + [menu-bar ejc-menu tl] + '("Show tables list" . ejc-show-tables-list)) + (define-key + ejc-sql-mode-keymap + [menu-bar ejc-menu cl] + '("Show constraints list" . ejc-show-constraints-list)) + (define-key + ejc-sql-mode-keymap + [menu-bar ejc-menu pl] + '("Show procedures list" . ejc-show-procedures-list)) + (define-key + ejc-sql-mode-keymap + [menu-bar ejc-menu ss] + '("Strip SQL" . ejc-strinp-sql-at-point)) + (define-key + ejc-sql-mode-keymap + [menu-bar ejc-menu ds] + '("Dress SQL" . ejc-dress-sql-at-point)) + (define-key + ejc-sql-mode-keymap + [menu-bar ejc-menu ol] + '("Open log" . ejc-open-log)) + (define-key + ejc-sql-mode-keymap + [menu-bar ejc-menu sl] + '("Show last result" . ejc-show-last-result)) + (define-key + ejc-sql-mode-keymap + [menu-bar ejc-menu qc] + '("Quit connection" . ejc-quit-connection))) + +(cl-defun ejc-create-connection (connection-name + &key + ;; ---------- + ;; DriverManager (preferred): + dbtype + dbname + host + port + ;; others (may include :user and :password) + ;; ---------- + ;; Raw: + connection-uri + ;; others (may include :user and :password) + ;; ---------- + ;; DriverManager (alternative / legacy style): + subprotocol + subname + ;; ---------- + ;; Others: + user + password + dependencies + classpath + separator + sslmode + ;; ---------- + ;; Optional: + classname) + "Add new connection configuration named CONNECTION-NAME. +It adds new connection to `ejc-connections' list or replace existing with the +same CONNECTION-NAME. +For more details about parameters see `get-connection' function in jdbc.clj: +`https://github.com/clojure/java.jdbc/blob/master/src/main/clojure/clojure/java/jdbc.clj'" + (setq ejc-connections + (-remove (lambda (x) (equal (car x) connection-name)) + ejc-connections)) + (setq ejc-connections + (cons (cons + connection-name + (let ((new-connection nil)) + (-map (lambda (arg) + (if (cdr arg) + (setq new-connection + (cons arg new-connection)))) + (list + (cons :dbtype dbtype) + (cons :dbname dbname) + (cons :host host) + (cons :port port) + (cons :connection-uri connection-uri) + (cons :subprotocol subprotocol) + (cons :subname subname) + (cons :user user) + (cons :password password) + (cons :dependencies dependencies) + (cons :classpath + (when classpath + (if (vectorp classpath) + (apply 'vector + (-map 'file-truename classpath)) + (vector (file-truename classpath))))) + (cons :separator separator) + (cons :sslmode sslmode) + (cons :classname classname))) + new-connection)) + ejc-connections))) + +(cl-defun ejc-completing-read (prompt choices &key initial-input) + "Present a PROMPT with CHOICES and optional INITIAL-INPUT." + (cond + ((eq ejc-completion-system 'ido) + (ido-completing-read prompt choices nil nil initial-input)) + ((eq ejc-completion-system 'standard) + (completing-read prompt choices nil nil initial-input)) + (t (funcall ejc-completion-system prompt choices)))) + +(defun ejc-read-file-name (prompt) + "Read file name, prompting with PROMPT." + (cond + ((eq ejc-completion-system 'ido) + (ido-read-file-name prompt)) + (t + (read-file-name prompt)))) + +(defun ejc-find-connection (connection-name) + "Return pair with name CONNECTION-NAME and db connection structure from +`ejc-connections'." + (-find (lambda (x) (equal (car x) connection-name)) + ejc-connections)) + +(defun ejc-load-conn-statistics () + "Load connection usage statistics to `ejc-conn-statistics' var." + (setq ejc-conn-statistics + (ejc-load-from-file ejc-conn-statistics-file + :default (list) + :check 'ejc-plist-p))) + +(defun ejc-update-conn-statistics (connection-name) + "Update connection usage statistics, persist it in `ejc-conn-statistics-file'" + (setq ejc-conn-statistics + (lax-plist-put + ejc-conn-statistics + connection-name + (1+ (or (lax-plist-get ejc-conn-statistics connection-name) 0)))) + (ejc-save-to-file ejc-conn-statistics-file ejc-conn-statistics)) + +(defun ejc-set-mode-name (connection-name) + "Show CONNECTION-NAME as part of `mode-name' in `mode-line'." + (setq mode-name (format "%s->[%s]" + (car (split-string + (if (listp mode-name) + (car mode-name) + mode-name) + "->\\[.+\\]")) + connection-name))) + +(cl-defun ejc-add-connection (&optional connection-name db) + "Add ejc connection information to current buffer. +If the current mode is `sql-mode' prepare buffer to operate as `ejc-sql-mode'." + (when (derived-mode-p 'sql-mode) + (sql-set-product (if db + (ejc-get-product-name db) + "ansi")) + (ejc-sql-mode t)) + (setq-local ejc-connection-name connection-name) + (setq-local ejc-db db) + (ejc-set-mode-name connection-name)) + +(defun ejc-eval-org-snippet (&optional orig-fun body params) + "Used to eval SQL code in `org-mode' code snippets." + (if (or (not ejc-org-mode-babel-wrapper) + (and (cdr (assq :engine params)) + (not + (yes-or-no-p + (concat "ejc-sql is enabled, ignore source block connection" + " header arguments and use ejc-sql to execute it? "))))) + (funcall orig-fun body params) + (cl-multiple-value-bind (beg end) (save-mark-and-excursion + (org-babel-mark-block) + (list (point) (mark))) + (ejc-eval-user-sql-at-point + :beg beg + :end end + :sync ejc-org-mode-show-results + :display-result (not ejc-org-mode-show-results)) + (if ejc-org-mode-show-results + (with-temp-buffer + (insert-file-contents (ejc-get-result-file-path)) + (buffer-string)))))) + +(defun ejc-org-edit-special (orig-fun &rest args) + (if (and (equal "sql" (car (org-babel-get-src-block-info))) + (boundp 'ejc-db) ejc-db + (boundp 'ejc-connection-name) ejc-connection-name) + (let* ((db ejc-db) + (connection-name ejc-connection-name)) + (apply orig-fun args) + (ejc-add-connection connection-name db)) + (apply orig-fun args))) + +(defun ejc-read-connection-name () + "Read connection-name in minibuffer." + (ejc-completing-read + "DataBase connection name: " + (let ((conn-list (mapcar 'car ejc-connections)) + (conn-statistics (ejc-load-conn-statistics))) + (-sort (lambda (c1 c2) + (> (or (lax-plist-get conn-statistics c1) 0) + (or (lax-plist-get conn-statistics c2) 0))) + conn-list)))) + +;;;###autoload +(defun ejc-insert-connection-data (connection-name) + "Insert configured connection data to keep it between Emacs restarts. +Assume to be evaluated somewhere in .emacs or any file, loaded as Emacs +configuration." + (interactive + (list (or (and (boundp 'connection-name) connection-name) + (ejc-read-connection-name)))) + (let ((connection-params (cdr (ejc-find-connection connection-name)))) + (insert + (format "(ejc-create-connection\n \"%s\"%s)" + connection-name + (-reduce-from + (lambda (result x) + (concat result + (format "\n %s \"%s\"" + (symbol-name (car x)) + (cdr x)))) + "" + connection-params))))) + +(defalias 'ejc-save-connection-data 'ejc-insert-connection-data) + +(defun ejc-resolve-jdbc-driver (dbtype) + "Resolve and download artifacts (JDBC drivers) for DBTYPE. +Apropriate artifacts list located in `ejc-jdbc-drivers'." + (let* ((artifact (lax-plist-get ejc-jdbc-drivers dbtype)) + (jar-path (ejc-lein-artifact-to-path artifact))) + (if (not (and (file-exists-p jar-path) + (if (> (file-attribute-size (file-attributes jar-path)) + 0) + t + ;; If JDBC driver jar file is accidentally empty - it + ;; should be deleted and reinstalled. + (progn (delete-file jar-path) + nil)))) + (ejc-resolve-dependencies + :coordinates (vector artifact) + :repositories '(("central" . "https://repo1.maven.org/maven2/") + ("clojars" . "https://clojars.org/repo")))) + jar-path)) + +;;;###autoload +(defun ejc-connect-interactive (connection-name) + "Create new connection interactively and connect to it." + (interactive + (list + (or (and (boundp 'connection-name) connection-name) + (read-string "DataBase new connection name: ")))) + (let* ((db-types '(("MySQL" . "mysql") + ("Oracle" . "oracle") + ("MS SQL Server" . "sqlserver") + ("H2" . "h2") + ("SQLite" . "sqlite") + ("PostgreSQL" . "postgresql"))) + (dbtype (cdr (assoc-string + (ejc-completing-read + "Database type: " + (cl-sort (-map 'car db-types) + 'string-lessp :key 'downcase)) + db-types))) + (properties + (-concat + (pcase dbtype + ("sqlite" + `((:subprotocol . "sqlite") + (:subname . ""))) + ("h2" + `((:subprotocol . "h2") + (:subname . ""))) + ("mysql" + `((:dbtype . "mysql") + (:classname . "com.mysql.jdbc.Driver") + (:dbname . "") + (:host . "localhost") + (:port . "3306"))) + ("postgresql" + `((:dbtype . "postgresql") + (:dbname . "") + (:host . "localhost") + (:port . "5432"))) + ("sqlserver" + `((:dbtype . "sqlserver") + (:dbname . "") + (:host . "localhost") + (:port . "1433"))) + ("oracle" + `((:dbtype . "oracle") + (:dbname . "") + (:host . "localhost") + (:port . "1521")))) + '((:classpath . "") + (:user . "") + (:password . "")))) + (args + (-reduce-from + (lambda (memo p) + (-concat + memo + (list + (car p) + (cl-case (car p) + (:dbtype (cdr p)) + (:classpath (ejc-resolve-jdbc-driver dbtype)) + (:classname (cdr p)) + (:subprotocol (cdr p)) + (:subname (if (member dbtype '("h2" "sqlite")) + (let ((fpath + (file-truename + (ejc-read-file-name "DB file: ")))) + (if (equal "h2" dbtype) + (concat "file://" + (file-name-sans-extension + (file-name-sans-extension + fpath)) + ";AUTO_SERVER=TRUE") + fpath)) + (read-string "DataBase subname: " (cdr p)))) + (:dbname (read-string "DataBase name: " (cdr p))) + (:host (read-string "Host: " (cdr p))) + (:port (read-string "Port: " (cdr p))) + (:user (read-string "User: ")) + (:password (read-passwd "Password: ")))))) + (list connection-name) + properties))) + (apply 'ejc-create-connection args) + (ejc-connect connection-name))) + +;;;###autoload +(defun ejc-connect (connection-name) + "Connect to selected db." + (interactive (list + (or (and (boundp 'connection-name) connection-name) + (ejc-read-connection-name)))) + (if-let ((db (cdr (ejc-find-connection connection-name)))) + (progn + (ejc-update-conn-statistics connection-name) + (ejc-add-connection connection-name db) + (when (derived-mode-p 'org-mode) + (require 'ob-sql) + (advice-add 'org-babel-execute:sql :around 'ejc-eval-org-snippet) + (advice-add 'org-edit-special :around #'ejc-org-edit-special)) + (message "Connection started...") + (clomacs-with-nrepl "ejc-sql" + (lambda (db connection-name) + (ejc-connect-to-db db) + (let ((validation-result + (ejc-validate-connection + :db db + :timeout ejc-connection-validate-timeout))) + (when (alist-get :status validation-result) + (ejc-set-mode-name connection-name) + (run-hooks 'ejc-sql-connected-hook) + (message (let ((msg (alist-get :message validation-result))) + (if (equal "Connected." msg) + (format + "Connected -> %s." + (propertize connection-name + 'face 'font-lock-keyword-face)) + msg)))))) + :params (list db connection-name))) + (ejc-connect-interactive connection-name))) + +;;;###autoload +(defun ejc-connect-existing-repl () + "Connect to existing ejc-sql nREPL running process. +You can `cd` to your ejc-sql project folder (typically +'~/.emacs.d/elpa/ejc-sql-') and launch nREPL via `lein repl`. +Then run in Emacs `ejc-connect-existing-repl', type HOST and PORT +from your `lein run` console output. Finally, use `ejc-connect' from +any SQL buffer to connect to exact database, as always. " + (interactive) + (let* ((params (cider-select-endpoint)) + (host (car params)) + (port (cdr params)) + (current-repl-b-name (cider-connect (list :host host :port port))) + (ejc-repl-b-name (nrepl-repl-buffer-name + (list + :session-name "ejc-sql" + :repl-type "clj" + :host host + :port port)))) + (with-current-buffer current-repl-b-name + (rename-buffer ejc-repl-b-name)))) + +(defun ejc-check-connection () + (unless (ejc-buffer-connected-p) + (error "Run M-x ejc-connect first!"))) + +(defun ejc-get-sql-from-string (sql) + (let* ((sql (replace-regexp-in-string ejc-clear-sql-regexp "" sql)) + (sql (if ejc-replace-double-quotes + (replace-regexp-in-string "\"" "'" sql) + sql))) + sql)) + +(defun ejc-add-outside-borders-p () + (cl-case ejc-result-table-impl + (orgtbl-mode t) + (ejc-result-mode nil))) + +(defun ejc-message-query-done (start-time status) + (message + "%s SQL query at %s. Exec time %.03f" + (cl-case status + (:done (propertize "Done" 'face 'font-lock-keyword-face)) + (:error (propertize "Error" 'face 'error)) + (:terminated (propertize "Terminated" 'face 'font-lock-keyword-face))) + (format-time-string ejc-date-output-format + (current-time)) + (float-time (time-since start-time)))) + +(defun ejc-spinner-stop () + "Stop spinner indicating current running query." + (if ejc-current-buffer-query + (with-current-buffer ejc-current-buffer-query + (spinner-stop)))) + +(cl-defun ejc-complete-query (result-file-path + &key + start-time + status + display-result + mode + connection-name + db + goto-symbol) + "Called by Clojure side, when SQL evaluation thread completes." + (ejc-spinner-stop) + (if result-file-path + (setq ejc-result-file-path result-file-path)) + (if display-result + (ejc-show-last-result :mode mode + :connection-name connection-name + :db db + :goto-symbol goto-symbol)) + (if (and start-time status) + (ejc-message-query-done start-time status)) + (run-hooks 'ejc-sql-complete-query-hook) + nil) + +(cl-defun ejc-cancel-query (&key start-time) + "Terminate current (long) running query. Aimed to cancel SELECT queries. +Unsafe for INSERT/UPDATE/CREATE/ALTER queries." + (interactive) + (ejc-spinner-stop) + (if (and (clomacs-get-connection "ejc-sql") + (ejc--is-query-running-p)) + (let ((start-time (or start-time (ejc--cancel-query)))) + (ejc-message-query-done start-time :terminated)) + (keyboard-quit))) + +(defun ejc-get-prompt-symbol-under-point (msg) + "Read user typed string from minibuffer. +MSG is a first part of the prompt message. The second optional part in +brackets is a symbol under point (cursor). Return a list of two items: +(schema|owner db-entity)." + (let* ((prefix (if (not mark-active) + (ejc-get-prefix-word))) + (sql-symbol (if mark-active + (buffer-substring (mark) (point)) + (ejc-get-word-at-point (point)))) + (enable-recursive-minibuffers t) + (typed-string (read-string + (if sql-symbol + (format "%s (default %s): " + msg + (if prefix + (format "%s.%s" prefix sql-symbol) + sql-symbol)) + (format "%s: " msg))))) + (if (equal typed-string "") + (list prefix sql-symbol) + (let ((split-typed-string (split-string typed-string "\\."))) + (if (cadr split-typed-string) + split-typed-string + (list nil typed-string)))))) + +(defun ejc-describe-table (prefix table-name) + "Describe SQL table TABLE-NAME (default table name - word around the point)." + (interactive (ejc-get-prompt-symbol-under-point "Describe table")) + (ejc-check-connection) + (ejc--describe-table :db ejc-db + :connection-name ejc-connection-name + :table table-name + :owner prefix + :result-file (ejc-next-result-file-path) + :add-outside-borders (ejc-add-outside-borders-p))) + +(defun ejc-describe-entity (prefix entity-name) + "Describe SQL entity ENTITY-NAME - function, procedure, type or view + (default entity name - word around the point)." + (interactive (ejc-get-prompt-symbol-under-point "Describe entity")) + (ejc-check-connection) + (ejc-get-entity-description :db ejc-db + :connection-name ejc-connection-name + :prefix prefix + :entity-name entity-name + :result-file (ejc-next-result-file-path))) + +(cl-defun ejc-eval-user-sql (sql &key + db + rows-limit + fetch-size + column-width-limit + append + sync + display-result + result-file) + "User starts SQL evaluation process." + (message "Processing SQL query...") + (when sql + (spinner-start 'rotating-line) + (setq ejc-current-buffer-query (current-buffer)) + (let* ((prepared-sql (ejc-get-sql-from-string sql))) + (ejc--eval-sql-and-log-print + (or db ejc-db) + prepared-sql + :start-time (current-time) + :rows-limit rows-limit + :fetch-size fetch-size + :column-width-limit column-width-limit + :append append + :sync sync + :display-result display-result + :result-file (or result-file + (ejc-next-result-file-path)) + :add-outside-borders (ejc-add-outside-borders-p))))) + +;;;###autoload +(defun ejc-eval-user-sql-region (beg end) + "Evaluate SQL bounded by the selection area." + (interactive "r") + (ejc-check-connection) + (let ((sql (buffer-substring beg end))) + (ejc-eval-user-sql sql + :display-result t)) + (if (region-active-p) + (deactivate-mark))) + +;;;###autoload +(cl-defun ejc-eval-user-sql-at-point (&key + sync + beg + end + (display-result t)) + "Evaluate SQL bounded by the `ejc-sql-separator' or/and buffer +boundaries." + (interactive) + (ejc-check-connection) + (ejc-flash-this-sql :beg beg + :end end) + (ejc-eval-user-sql (ejc-get-sql-at-point :beg beg :end end) + :sync sync + :display-result display-result)) + +;;;###autoload +(defun ejc-show-tables-list () + "Output tables list." + (interactive) + (ejc-check-connection) + (ejc-eval-user-sql + (ejc-select-db-meta-script ejc-db :all-tables) + :rows-limit 0 + :fetch-size 0 + :column-width-limit 0 + :display-result t)) + +;;;###autoload +(defun ejc-show-views-list () + "Output views list." + (interactive) + (ejc-check-connection) + (ejc-eval-user-sql + (ejc-select-db-meta-script ejc-db :views) + :rows-limit 0 + :column-width-limit 0 + :display-result t)) + +;;;###autoload +(defun ejc-show-user-types-list (&optional owner) + "Output user types list." + (interactive) + (ejc-check-connection) + (ejc-eval-user-sql (ejc-select-db-meta-script ejc-db :types + :owner owner))) + +;;;###autoload +(defun ejc-show-constraints-list (&optional owner table) + "Output constraints list." + (interactive) + (ejc-check-connection) + (ejc-eval-user-sql (ejc-select-db-meta-script ejc-db :constraints + :owner owner + :table table))) + +;;;###autoload +(defun ejc-show-procedures-list () + "Output procedures list." + (interactive) + (ejc-check-connection) + (ejc-eval-user-sql + (ejc-select-db-meta-script ejc-db :procedures + :owner (ejc-get-this-owner ejc-db)) + :rows-limit 0 + :column-width-limit 0 + :display-result t)) + +;;;###autoload +(defun ejc-get-temp-editor-buffer (&optional num) + (interactive "P") + "Switch to buffer dedicated to ad-hoc edit and SQL scripts. +If the buffer is not exists - create it. +Buffer can be saved to file with `ejc-temp-editor-file' path." + (let* ((tmp-file-name (if num + (format "%s-%s" + ejc-temp-editor-buffer-name + (if (numberp num) + (int-to-string num) + num)) + ejc-temp-editor-buffer-name)) + (tmp-file-path (progn + (unless (file-exists-p ejc-temp-editor-file-path) + (make-directory ejc-temp-editor-file-path t)) + (expand-file-name (concat tmp-file-name ".sql") + ejc-temp-editor-file-path))) + (tmp-buffer-name (format "*%s*" tmp-file-name))) + (if (get-buffer tmp-buffer-name) + (switch-to-buffer tmp-buffer-name) + (progn + (find-file tmp-file-path) + (rename-buffer tmp-buffer-name) + (sql-mode) + (ejc-add-connection) + (get-buffer tmp-buffer-name))))) + +(defun ejc-open-log () + (interactive) + (find-file-read-only (ejc-get-log-file-path)) + (goto-char (point-max))) + +;;;###autoload +(defun ejc-version () + "Get the ejc-sql version as string." + (interactive) + (if (require 'pkg-info nil t) + (message "ejc-sql %s" (pkg-info-version-info 'ejc-sql)) + (error "Cannot determine version without package pkg-info"))) + +(provide 'ejc-sql) + +;;; ejc-sql.el ends here diff --git a/elpa/ejc-sql-20230228.102/project.clj b/elpa/ejc-sql-20230228.102/project.clj new file mode 100644 index 00000000..95fae0fb --- /dev/null +++ b/elpa/ejc-sql-20230228.102/project.clj @@ -0,0 +1,13 @@ +(defproject ejc-sql "0.4.1-SNAPSHOT" + :description "Interact with database via java/clojure libs to run SQL scripts" + :url "https://github.com/kostafey/ejc-sql" + :license {:name "GPL 2.0+" + :url "http://www.gnu.org/licenses/old-licenses/gpl-2.0.html"} + :dependencies [[org.clojure/clojure "1.11.1"] + [org.clojure/java.jdbc "0.7.10"] + [org.hibernate/hibernate-core "5.4.1.Final"] + [com.cemerick/pomegranate "1.1.0"] + [leiningen-core "2.9.3"] + [org.apache.commons/commons-lang3 "3.5"] + [org.apache.httpcomponents/httpclient "4.5.5"] + [clomacs "0.0.5-SNAPSHOT"]]) diff --git a/elpa/ejc-sql-20230228.102/snippets/sql-mode/alter.yasnippet b/elpa/ejc-sql-20230228.102/snippets/sql-mode/alter.yasnippet new file mode 100644 index 00000000..77a047ed --- /dev/null +++ b/elpa/ejc-sql-20230228.102/snippets/sql-mode/alter.yasnippet @@ -0,0 +1,6 @@ +# -*- mode: snippet -*- +# name: altertable +# key: altertable +# -- +ALTER TABLE ${1:table} + ADD ${2:column_name} ${3:column_definition} diff --git a/elpa/ejc-sql-20230228.102/snippets/sql-mode/begin.snippet b/elpa/ejc-sql-20230228.102/snippets/sql-mode/begin.snippet new file mode 100644 index 00000000..346dff8b --- /dev/null +++ b/elpa/ejc-sql-20230228.102/snippets/sql-mode/begin.snippet @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: begin +# key: begin +# -- +BEGIN + $0 +END; \ No newline at end of file diff --git a/elpa/ejc-sql-20230228.102/snippets/sql-mode/delete.yasnippet b/elpa/ejc-sql-20230228.102/snippets/sql-mode/delete.yasnippet new file mode 100644 index 00000000..27cc2af9 --- /dev/null +++ b/elpa/ejc-sql-20230228.102/snippets/sql-mode/delete.yasnippet @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: delete +# key: delete +# -- +DELETE FROM ${1:table_name} WHERE ${2:where_stmt} \ No newline at end of file diff --git a/elpa/ejc-sql-20230228.102/snippets/sql-mode/grant.yasnippet b/elpa/ejc-sql-20230228.102/snippets/sql-mode/grant.yasnippet new file mode 100644 index 00000000..42611f4c --- /dev/null +++ b/elpa/ejc-sql-20230228.102/snippets/sql-mode/grant.yasnippet @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: grant +# key: grant +# -- +GRANT ALL PRIVILEGES + ON ${1:object_type} + TO ${2:user}; \ No newline at end of file diff --git a/elpa/ejc-sql-20230228.102/snippets/sql-mode/inner.yasnippet b/elpa/ejc-sql-20230228.102/snippets/sql-mode/inner.yasnippet new file mode 100644 index 00000000..44e85d94 --- /dev/null +++ b/elpa/ejc-sql-20230228.102/snippets/sql-mode/inner.yasnippet @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: inner +# key: inner +# -- +INNER JOIN ${1:table_name} ON $2 \ No newline at end of file diff --git a/elpa/ejc-sql-20230228.102/snippets/sql-mode/insert.yasnippet b/elpa/ejc-sql-20230228.102/snippets/sql-mode/insert.yasnippet new file mode 100644 index 00000000..b38c3ebb --- /dev/null +++ b/elpa/ejc-sql-20230228.102/snippets/sql-mode/insert.yasnippet @@ -0,0 +1,6 @@ +# -*- mode: snippet -*- +# name: insert +# key: insert +# -- +INSERT INTO ${1:table_name} (${2:column1}, ${3:column2}) +VALUES ($0value1, value2) \ No newline at end of file diff --git a/elpa/ejc-sql-20230228.102/snippets/sql-mode/left.yasnippet b/elpa/ejc-sql-20230228.102/snippets/sql-mode/left.yasnippet new file mode 100644 index 00000000..aa0d7277 --- /dev/null +++ b/elpa/ejc-sql-20230228.102/snippets/sql-mode/left.yasnippet @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: left +# key: left +# -- +LEFT JOIN ${1:table_name} ON $2 \ No newline at end of file diff --git a/elpa/ejc-sql-20230228.102/snippets/sql-mode/revoke.yasnippet b/elpa/ejc-sql-20230228.102/snippets/sql-mode/revoke.yasnippet new file mode 100644 index 00000000..2fa27e7e --- /dev/null +++ b/elpa/ejc-sql-20230228.102/snippets/sql-mode/revoke.yasnippet @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: revoke +# key: revoke +# -- +REVOKE ALL PRIVILEGES + ON ${1:object_type} + FROM ${2:user}; \ No newline at end of file diff --git a/elpa/ejc-sql-20230228.102/snippets/sql-mode/right.yasnippet b/elpa/ejc-sql-20230228.102/snippets/sql-mode/right.yasnippet new file mode 100644 index 00000000..fef03b27 --- /dev/null +++ b/elpa/ejc-sql-20230228.102/snippets/sql-mode/right.yasnippet @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: right +# key: right +# -- +RIGHT JOIN ${1:table_name} ON $2 \ No newline at end of file diff --git a/elpa/ejc-sql-20230228.102/snippets/sql-mode/select.yasnippet b/elpa/ejc-sql-20230228.102/snippets/sql-mode/select.yasnippet new file mode 100644 index 00000000..4e5fe935 --- /dev/null +++ b/elpa/ejc-sql-20230228.102/snippets/sql-mode/select.yasnippet @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: select +# key: select +# -- +SELECT `(if (eq sql-product 'sqlserver) "first 20 ")`* +FROM ${1:table_name} +WHERE `(if (eq sql-product 'oracle) "rownum < 20\n AND ")`${2:where_stmt} \ No newline at end of file diff --git a/elpa/ejc-sql-20230228.102/snippets/sql-mode/update.yasnippet b/elpa/ejc-sql-20230228.102/snippets/sql-mode/update.yasnippet new file mode 100644 index 00000000..5f15e73f --- /dev/null +++ b/elpa/ejc-sql-20230228.102/snippets/sql-mode/update.yasnippet @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: update +# key: update +# -- +UPDATE ${1:table_name} +SET ${2:column1} = ${3:value}, ${4:column2} = ${5:value} +WHERE ${6:some_column} = ${7:some_value} \ No newline at end of file diff --git a/elpa/ejc-sql-20230228.102/snippets/sql-mode/where.yasnippet b/elpa/ejc-sql-20230228.102/snippets/sql-mode/where.yasnippet new file mode 100644 index 00000000..13d87f2f --- /dev/null +++ b/elpa/ejc-sql-20230228.102/snippets/sql-mode/where.yasnippet @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: where +# key: where +# -- +WHERE `(if (eq sql-product 'oracle) "rownum < 20\n AND ")`${2:where_stmt} \ No newline at end of file diff --git a/elpa/ejc-sql-20230228.102/src/ejc_sql/cache.clj b/elpa/ejc-sql-20230228.102/src/ejc_sql/cache.clj new file mode 100644 index 00000000..196cb16b --- /dev/null +++ b/elpa/ejc-sql-20230228.102/src/ejc_sql/cache.clj @@ -0,0 +1,84 @@ +;;; cache.clj -- Keep database stucture cache. + +;;; Copyright © 2019-2023 - Kostafey + +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software Foundation, +;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ + +(ns ejc-sql.cache + (:require [clomacs :as clomacs])) + +(def cache + "Keep information about structure of databases used for autocomplete & eldoc. + This data contains (depends on database type): + ├── owners/schemas + | ├── tables + | | └── columns + | └── views + ├── packages + | └── stored procedures & functions + | └── parameters + └── keywords + It's global: same database structure information shared beetween + different buffers connected to the same database." + (atom {})) + +(def cache-creation-promises + "Signs of database structure cache created." + (atom {})) + +(defn get-cache + "Get actual cache." + [] + @cache) + +(defn deref-cache [db] + [db + (into + {} + (map + (fn [entity-k] + [entity-k + (let [item (get-in (get-cache) [db entity-k])] + (if (future? item) + (deref item) + (if (map? item) + (into + {} + (map + (fn [sub-entity-k] + [sub-entity-k + (let [sub-item (get-in (get-cache) + [db entity-k sub-entity-k])] + (if (future? sub-item) + (deref sub-item) + sub-item))]) + (keys item))) + item)))]) + (keys + ((get-cache) db))))]) + +(defn output-cache + "Output actual cache to printable format." + [db] + (clomacs/format-result + (if db + (second (deref-cache db)) + (into {} (map deref-cache (keys (get-cache))))))) + +(defn invalidate-cache + "Clean your current connection cache (database owners and tables list)." + [db] + (swap! cache assoc-in [db] nil) + (swap! cache-creation-promises assoc-in [db] nil)) diff --git a/elpa/ejc-sql-20230228.102/src/ejc_sql/classpath.clj b/elpa/ejc-sql-20230228.102/src/ejc_sql/classpath.clj new file mode 100644 index 00000000..c0d5612b --- /dev/null +++ b/elpa/ejc-sql-20230228.102/src/ejc_sql/classpath.clj @@ -0,0 +1,66 @@ +;; Version of `add-classpath` imlementation from Kaocha project. +;; https://github.com/lambdaisland/kaocha/blob/master/src/kaocha/classpath.clj + +(ns ejc-sql.classpath + "This is the add-classpath function from Pomegranate 1.0.0, extracted so we + don't need to pull in Aether." + (:refer-clojure :exclude [add-classpath]) + (:require [dynapath.util :as dp] + [clojure.java.io :as io])) + +(def new-jdk + (>= (BigDecimal. (System/getProperty "java.specification.version")) 1.9)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Pomegranate + +(defn ensure-compiler-loader + "Ensures the clojure.lang.Compiler/LOADER var is bound to a DynamicClassLoader, + so that we can add to Clojure's classpath dynamically." + [] + (when-not (bound? Compiler/LOADER) + (.bindRoot Compiler/LOADER (clojure.lang.DynamicClassLoader. (clojure.lang.RT/baseLoader))))) + +(defn- classloader-hierarchy + "Returns a seq of classloaders, with the tip of the hierarchy first. + Uses the current thread context ClassLoader as the tip ClassLoader + if one is not provided." + ([] + (if new-jdk + (ensure-compiler-loader) + (classloader-hierarchy (.. Thread currentThread getContextClassLoader))) + (classloader-hierarchy (deref clojure.lang.Compiler/LOADER))) + ([tip] + (->> tip + (iterate #(.getParent %)) + (take-while boolean)))) + +(defn- modifiable-classloader? + "Returns true iff the given ClassLoader is of a type that satisfies + the dynapath.dynamic-classpath/DynamicClasspath protocol, and it can + be modified." + [cl] + (dp/addable-classpath? cl)) + +(defn add-classpath + "A corollary to the (deprecated) `add-classpath` in clojure.core. This implementation + requires a java.io.File or String path to a jar file or directory, and will attempt + to add that path to the right classloader (with the search rooted at the current + thread's context classloader)." + ([jar-or-dir classloader] + (when-not (dp/add-classpath-url classloader (.toURL (.toURI (io/file jar-or-dir)))) + (throw (IllegalStateException. (str classloader " is not a modifiable classloader"))))) + ([jar-or-dir] + (let [classloaders (classloader-hierarchy)] + (if-let [cl (if new-jdk + (filter modifiable-classloader? classloaders) + (last (filter modifiable-classloader? classloaders)))] + ;; Add to all classloaders that allow it. Brute force but doesn't hurt. + (if new-jdk + (run! #(add-classpath jar-or-dir %) cl) + (add-classpath jar-or-dir cl)) + (throw (IllegalStateException. (str "Could not find a suitable classloader to modify from " + classloaders))))))) + +;; /Pomegranate +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/elpa/ejc-sql-20230228.102/src/ejc_sql/connect.clj b/elpa/ejc-sql-20230228.102/src/ejc_sql/connect.clj new file mode 100644 index 00000000..645d8a34 --- /dev/null +++ b/elpa/ejc-sql-20230228.102/src/ejc_sql/connect.clj @@ -0,0 +1,330 @@ +;;; connect.clj -- Core clojure functions for ejc-sql emacs extension. + +;;; Copyright © 2013-2023 - Kostafey + +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software Foundation, +;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ + +(ns ejc-sql.connect + (:require [clojure.java.jdbc :as j] + [clojure.java.io :as io] + [clojure.string :as s] + [clomacs :refer [clomacs-defn]] + [ejc-sql.output :as o] + [ejc-sql.lib :refer [select? ddl? clob-to-string-row *max-column-width*]] + [ejc-sql.cache :refer [invalidate-cache]]) + (:import [java.sql SQLException])) + +(def db + "DataBase connection properties list from the last transaction. +For debug purpose." + (atom nil)) + +(defn set-db [ejc-db] + (reset! db ejc-db)) + +(def current-query + "Current running query data." + (atom {})) + +(defn handle-special-cases [db sql] + (case (:subprotocol db) + "oracle" (case (clojure.string/upper-case sql) + "SHOW ERRORS" (str "SELECT line, position, sequence, text + FROM all_errors + WHERE type = 'FUNCTION' + AND name = 'FILTERDICT' + AND attribute != 'WARNING' + AND owner = '" (:user db) "' + ORDER BY line, position, sequence") + sql) + sql)) + +(defn is-statement-not-closed? [] + (let [stmt (:stmt @current-query)] + (and (not (nil? stmt)) + (not (.isClosed stmt))))) + +(defn is-query-process-running? [] + (let [runner (:runner @current-query)] + (and + (not (nil? runner)) + (not (future-done? runner)) + (not (future-cancelled? runner))))) + +(defn is-query-running? [] + (or (is-statement-not-closed?) + (is-query-process-running?))) + +(defn cancel-query + "Terminate current (long) running query. Aimed to cancel SELECT queries. + Unsafe for INSERT/UPDATE/CREATE/ALTER queries." + [] + (future + (when (is-statement-not-closed?) + (let [conn (:conn @current-query)] + (try + (.rollback conn) + (finally + (.close conn))))) + (when (is-query-process-running?) + (future-cancel (:runner @current-query)))) + (:start-time @current-query)) + +(defn validate-connection [& {:keys [db timeout] + :or {db @ejc-sql.connect/db + timeout 5}}] + (letfn [(abstract-is-valid [msg] + (clomacs/format-result + {:status true + :message (str "Warning: can't validate connection. " + "Please, update your JDBC driver and " + "restart the REPL.\n" + msg)}))] + (try + (clomacs/format-result + {:status (.isValid (j/get-connection db) timeout) + :message "Connected."}) + (catch AbstractMethodError e + (abstract-is-valid (.getMessage e))) + (catch java.sql.SQLFeatureNotSupportedException e + (abstract-is-valid (.getMessage e)))))) + +(defn get-separator-re + "Handle cases where separator is a part of string in SQL query. +E.g. you can use default separator char `/` in this query: +SELECT * FROM urls WHERE path like '%http://localhost%'" + [separator] + (re-pattern + (format + "%s(? @o/max-rows 0) + @o/show-too-many-rows-message) + ;; Get one more row to recognize that + ;; the actual number of records from this + ;; query is bigger than `max-rows`. + (+ @o/max-rows 1) + @o/max-rows) + 0)})] + (swap! current-query assoc + :stmt stmt + :conn conn) + (j/query db stmt + {:as-arrays? true + :result-set-fn + (fn [rs] + (let [single-record? + (not (next (next rs)))] + (mapv + #(clob-to-string-row + % single-record?) + rs)))})))) + (let [result (first (j/execute! db (list sql))) + msg (if (> result 0) + (str "Records affected: " result) + "Executed")] + (when (ddl? sql) + (invalidate-cache db)) + (list :message msg))) + (catch SQLException e + (list :message + (o/unify-str "Error: " (.getMessage e)))))) + +(defn- eval-user-sql + "Receive raw SQL from the user, log it, divide by statements and eval them." + [db sql & {:keys [rows-limit + fetch-size + append + display-result + result-file]}] + (let [sql (s/trim sql) + _ (do (o/log-sql (str sql "\n")) + (o/clear-result-file :result-file result-file)) + [sql + manual-separator] (if (s/starts-with? (s/lower-case sql) "delimiter") + ;; User defined statement separator manually + ;; before SQL expression. + ;; Remove `delimiter` command from SQL expression. + [(s/trim (s/replace-first sql delimiter-re "")) + (second (re-find delimiter-re sql))] + [sql nil]) + sql (handle-special-cases db sql) + statement-separator-re (get-separator-re (or manual-separator ";")) + results (doall + (for [sql-part (filter + ;; Remove parts contains comments only. + (fn [part] + (seq (s/trim + (s/replace part comments-re "")))) + (if (or (not (:separator db)) manual-separator) + (s/split sql statement-separator-re) + [sql]))] + (let [[result-type result] (eval-sql-core :db db + :sql sql-part + :max-rows rows-limit + :fetch-size fetch-size)] + (if (= result-type :result-set) + (o/print-table result fetch-size) + (println result)) + [result-type result])))] + (complete + nil + :start-time (:start-time @current-query) + :status (if (or + (every? (fn [[result-type _]] + (= result-type :result-set)) + results) + (not (some (fn [[result-type result]] + (and + (not (= result-type :result-set)) + (s/starts-with? (s/lower-case result) + "error"))) + results))) + :done + (if (and + (= (count results) 1) + (some (fn [[_ result]] + (.contains (s/lower-case result) + "closed connection")) + results)) + :terminated + :error)) + :display-result display-result + :result-file result-file))) + +(defn eval-sql-and-log-print + "Write SQL to log file, evaluate it and print result." + [db sql & {:keys [rows-limit + fetch-size + column-width-limit + append + start-time + sync + display-result + result-file + add-outside-borders] + :or {append false + sync false + display-result true + add-outside-borders true}}] + (letfn [(run-query [] + (try + (with-open [out (io/writer result-file)] + (binding [*out* out + o/*add-outside-borders* add-outside-borders + *max-column-width* (or column-width-limit + @o/column-width-limit)] + (eval-user-sql db sql + :rows-limit rows-limit + :fetch-size fetch-size + :append append + :display-result display-result + :result-file result-file))) + (catch Exception e + (complete + (str (.getMessage e) "\n" + (s/join "\n" (.getStackTrace e))) + :start-time (:start-time @current-query) + :status :error + :display-result true + :result-file result-file))))] + (if sync + (run-query) + (swap! current-query assoc + :runner (future (run-query)) + :start-time start-time)))) + +(defn query-meta + "Get metadata for `sql` result dataset." + [db sql] + (try + {:success true + :result (j/db-query-with-resultset + db + [(str "SELECT nodata.* " + "FROM (" sql ") nodata " + "WHERE 0 = 1")] + (fn [rs] + (let [rs-meta (.getMetaData rs) + col-count (.getColumnCount rs-meta)] + (mapv (fn [i] + {:name (.getColumnLabel rs-meta i) + :type (.getColumnTypeName rs-meta i)}) + (range 1 (+ 1 col-count))))))} + (catch SQLException e + {:success false + :result (str "Error: " (.getMessage e))}))) + +(defn table-meta + [db table-name] + (set-db db) + (query-meta db (str "SELECT * FROM " table-name))) diff --git a/elpa/ejc-sql-20230228.102/src/ejc_sql/deps_resolver.clj b/elpa/ejc-sql-20230228.102/src/ejc_sql/deps_resolver.clj new file mode 100644 index 00000000..3048b1a4 --- /dev/null +++ b/elpa/ejc-sql-20230228.102/src/ejc_sql/deps_resolver.clj @@ -0,0 +1,66 @@ +;;; deps_resolver.clj -- Discover required jar artifacts. + +;;; Copyright © 2020-2023 - Kostafey + +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software Foundation, +;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ + +(ns ejc-sql.deps-resolver + (:require + [cemerick.pomegranate.aether :as aether] + [leiningen.core.project :refer [default-repositories]])) + +(defn get-hierarchy [artifacts-list] + (aether/dependency-hierarchy + artifacts-list + (aether/resolve-dependencies + :coordinates artifacts-list + :repositories default-repositories))) + +(def artifacts (atom (list))) + +(defn art-wanderer [art] + (if (and + (coll? art) + (vector? art) + (not (coll? (nth art 0)))) + (swap! artifacts conj art) + (dorun (map art-wanderer art)))) + +(defn run-wanderer [art] + (reset! artifacts (list)) + (dorun (map art-wanderer art)) + @artifacts) + +(defn get-dependeces-list + "Get artifacts dependeces hierarchy as a flatten list." + [artifacts-list] + (-> artifacts-list get-hierarchy run-wanderer)) + +(defn get-dependeces-files-list + "Resolve dependeces and return a list of all requred jar files paths. + `artifacts-list` is a leningen dependeces vector. + E.g. '[[com.ibm.informix/jdbc \"4.50.3\"]]." + [artifacts-list] + (try + (map + (fn [dep-file] (.getPath dep-file)) + (flatten + (map + aether/dependency-files + (map + (fn [dep] (get-hierarchy (vector dep))) + (get-dependeces-list artifacts-list))))) + (catch Exception _ + nil))) diff --git a/elpa/ejc-sql-20230228.102/src/ejc_sql/keywords.clj b/elpa/ejc-sql-20230228.102/src/ejc_sql/keywords.clj new file mode 100644 index 00000000..6b4ae77c --- /dev/null +++ b/elpa/ejc-sql-20230228.102/src/ejc_sql/keywords.clj @@ -0,0 +1,38 @@ +;;; keywords.clj -- Keep database-specific keywords. + +;;; Copyright © 2019 - Kostafey + +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software Foundation, +;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ + +(ns ejc-sql.keywords) + +(def keywords + {:sqlite + ["ABORT" "ACTION" "ADD" "AFTER" "ALL" "ALTER" "ANALYZE" "AND" "AS" "ASC" "ATTACH" + "AUTOINCREMENT" "BEFORE" "BEGIN" "BETWEEN" "BY" "CASCADE" "CASE" "CAST" "CHECK" + "COLLATE" "COLUMN" "COMMIT" "CONFLICT" "CONSTRAINT" "CREATE" "CROSS" "CURRENT" + "CURRENT_DATE" "CURRENT_TIME" "CURRENT_TIMESTAMP" "DATABASE" "DEFAULT" + "DEFERRABLE" "DEFERRED" "DELETE" "DESC" "DETACH" "DISTINCT" "DO" "DROP" "EACH" + "ELSE" "END" "ESCAPE" "EXCEPT" "EXCLUSIVE" "EXISTS" "EXPLAIN" "FAIL" "FILTER" + "FOLLOWING" "FOR" "FOREIGN" "FROM" "FULL" "GLOB" "GROUP" "HAVING" "IF" "IGNORE" + "IMMEDIATE" "IN" "INDEX" "INDEXED" "INITIALLY" "INNER" "INSERT" "INSTEAD" + "INTERSECT" "INTO" "IS" "ISNULL" "JOIN" "KEY" "LEFT" "LIKE" "LIMIT" "MATCH" + "NATURAL" "NO" "NOT" "NOTHING" "NOTNULL" "NULL" "OF" "OFFSET" "ON" "OR" "ORDER" + "OUTER" "OVER" "PARTITION" "PLAN" "PRAGMA" "PRECEDING" "PRIMARY" "QUERY" "RAISE" + "RANGE" "RECURSIVE" "REFERENCES" "REGEXP" "REINDEX" "RELEASE" "RENAME" "REPLACE" + "RESTRICT" "RIGHT" "ROLLBACK" "ROW" "ROWS" "SAVEPOINT" "SELECT" "SET" "TABLE" + "TEMP" "TEMPORARY" "THEN" "TO" "TRANSACTION" "TRIGGER" "UNBOUNDED" "UNION" + "UNIQUE" "UPDATE" "USING" "VACUUM" "VALUES" "VIEW" "VIRTUAL" "WHEN" "WHERE" + "WINDOW" "WITH" "WITHOUT"]}) diff --git a/elpa/ejc-sql-20230228.102/src/ejc_sql/lib.clj b/elpa/ejc-sql-20230228.102/src/ejc_sql/lib.clj new file mode 100644 index 00000000..3b5496f0 --- /dev/null +++ b/elpa/ejc-sql-20230228.102/src/ejc_sql/lib.clj @@ -0,0 +1,139 @@ +;;; lib.clj -- Misc clojure functions for ejc-sql emacs extension. + +;;; Copyright © 2013-2019 - Kostafey + +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software Foundation, +;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ + +(ns ejc-sql.lib + (:require [clojure.string :as s] + [clojure.reflect :refer [resolve-class]])) + +(def ^:dynamic *max-column-width* 30) + +(def windows? + "The value is true if it runs under the os Windows." + (>= 0 (.indexOf (System/getProperty "os.name") "Windows"))) + +(defn in? + "true if `seq` contains `elm`. + Search case insensitive wthen `case-sensitive` is false." + [seq elm & {:keys [case-sensitive] :or {case-sensitive true}}] + (when (and elm seq) + (if (not case-sensitive) + (in? (mapv s/lower-case seq) (s/lower-case elm)) + (some #(= elm %) seq)))) + +(defn get->in + "Case insensitive `get-in` for last key in sequence." + [obj path & {:keys [case-sensitive] :or {case-sensitive false}}] + (if case-sensitive + (get-in obj path) + (get-in obj + (conj (into [] (butlast path)) + (last path)) + (get-in obj + (conj (into [] (butlast path)) + (s/upper-case (last path))) + (get-in obj + (conj (into [] (butlast path)) + (s/lower-case (last path)))))))) + +(defn simple-join [n s] + (s/join + (for [_ (range 0 n)] s))) + +(defn class-exists? [c] + (resolve-class (.getContextClassLoader (Thread/currentThread)) c)) + +(defn is-clob? [x] + (or (instance? java.sql.Clob x) + (and (class-exists? 'oracle.sql.CLOB) + (instance? (Class/forName "oracle.sql.CLOB") x)))) + +(defn clob-to-string + "Turn an Oracle Clob into a String" + ([clob] + (clob-to-string clob true)) + ([clob single-record?] + (with-open [rdr (java.io.BufferedReader. (.getCharacterStream clob))] + (if (or single-record? (not *max-column-width*)) + (apply str (line-seq rdr)) + ;; Show only first `*max-column-width*` (30 by default) symbols + ;; of Clob field. If longer, replace last 3 symbols by dots. + (let [result (apply str (take (+ *max-column-width* 1) + (mapcat seq (line-seq rdr))))] + (if (> (count result) *max-column-width*) + (str (subs result 0 (- *max-column-width* 3)) "...") + result)))))) + +(defn clob-to-string-row + "Check all data in row if it's a CLOB and convert CLOB to string." + [row single-record?] + (mapv (fn [field] + (if (is-clob? field) + (clob-to-string field single-record?) + field)) + row)) + +(defn clean-sql [sql] + (-> sql + (s/replace #"(--).*\n" "") + (s/replace #"( )|( \t)|\t" " ") + (s/replace "^\n" "") + s/trim)) + +(def select-words + '("SELECT" + "SHOW" + "WITH" + "EXPLAIN")) + +(def dml-words + (concat + select-words + '("INSERT" + "UPDATE" + "DELETE"))) + +(def ddl-words + '("CREATE" + "ALTER" + "DROP" + "RENAME")) + +(defn determine-query + "Determine if current SQL starts with one of the words from `words` list." + [sql words] + (let [sql (clean-sql sql) + ignore-set #{\( \[} + pos (loop [pos 0] + (if (ignore-set (get sql pos)) + (recur (inc pos)) + pos)) + sql (s/upper-case (subs sql pos))] + (first (filter (fn [w] (s/starts-with? sql w)) words)))) + +(defn select? [sql] + (determine-query sql select-words)) + +(defn dml? + "Determine if current SQL is Data Manipulation Language (DML) case." + [sql] + (determine-query sql dml-words)) + +(defn ddl? + "Determine if current SQL is Data Definition Language (DDL) case." + [sql] + (determine-query sql ddl-words)) diff --git a/elpa/ejc-sql-20230228.102/src/ejc_sql/output.clj b/elpa/ejc-sql-20230228.102/src/ejc_sql/output.clj new file mode 100644 index 00000000..682bd67e --- /dev/null +++ b/elpa/ejc-sql-20230228.102/src/ejc_sql/output.clj @@ -0,0 +1,337 @@ +;;; output.clj -- Output & formatting clojure functions for ejc-sql. + +;;; Copyright © 2013-2023 - Kostafey + +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software Foundation, +;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ + +(ns ejc-sql.output + (:require [clojure.string :as s] + [clojure.java.io :refer [file writer]] + [ejc-sql.lib :refer [*max-column-width* dml? simple-join windows?]]) + (:import (java.io File) + (java.lang Character$UnicodeBlock) + (org.apache.commons.lang3 StringUtils) + (org.hibernate.engine.jdbc.internal BasicFormatterImpl + DDLFormatterImpl))) + +(def ^:dynamic *add-outside-borders* true) + +(defn get-log-dir [] + (file (if windows? + (System/getenv "AppData") + "/var/log/") + "ejc-sql")) + +(defn get-log-file [& [create-new]] + (loop [xs (take 100 (range))] + (when xs + (let [prev-day (first xs) + log-file (file + (get-log-dir) + (format "%s.log" + (.format + (new java.text.SimpleDateFormat + "yyyy-MM-dd") + (let [cal (java.util.Calendar/getInstance)] + (.setTime cal (new java.util.Date)) + (.add cal java.util.Calendar/DATE + (if prev-day (- prev-day) 0)) + (.getTime cal)))))] + (if (or create-new (.exists log-file)) + log-file + (recur (next xs))))))) + +(defn print-log-file-path [] + (print (.getAbsolutePath (or (get-log-file) (get-log-dir))))) + +(defn log-sql [sql] + (let [log-file (get-log-file true) + is-new-file (not (.exists log-file))] + (when is-new-file + (.mkdirs (File. (.getParent log-file))) + (.createNewFile log-file)) + (with-open [wrtr (writer log-file :append true)] + (when is-new-file + (.write wrtr (str "-- -*- mode: sql; -*-\n" + "-- Local Variables:\n" + "-- eval: (ejc-sql-mode)\n" + "-- End:\n"))) + (.write wrtr (str (simple-join 50 "-") " " + (.format (new java.text.SimpleDateFormat + "yyyy.MM.dd HH:mm:ss.S") + (new java.util.Date)) + " " (simple-join 2 "-") "\n" sql "\n"))))) + +(def fetch-size + "Limit number of records to output." + (atom 50)) + +(def max-rows + "Limit number of records to contain in ResultSet." + (atom 99)) + +(def show-too-many-rows-message + "Output message in case of ResultSet is bigger than `fetch-size`." + (atom true)) + +(def column-width-limit + "Limit number of chars per column to output." + (atom 30)) + +(defn set-fetch-size + "Set limit for number of records to output. When nil no limit. + Passed to the JDBC driver a hint as to the number of rows that should be + fetched from the database when more rows are needed for ResultSet objects + generated by a Statement." + [val] + (reset! fetch-size (or val 0))) + +(defn set-max-rows + "Set limit for number of records to contain in ResultSet. When nil no limit. + Sets the limit for the maximum number of rows that any ResultSet object + generated by a Statement object can contain to the given number." + [val] + (reset! max-rows (or val 0))) + +(defn set-show-too-many-rows-message + [val] + (reset! show-too-many-rows-message (or val false))) + +(defn set-column-width-limit + "Set limit for number of chars per column to output. When nil no limit." + [val] + (reset! column-width-limit val)) + +(defn rotate-table + "Rotate result set to show fields list vertically. + Applied to single-record result set. + E.g. transtofm from: a | b | c into: a | 1 + --+---+-- b | 2 + 1 | 2 | 3 c | 3" + [data] + (apply mapv vector data)) + +(def use-unicode (atom false)) + +(defn set-use-unicode + "Set using unicode for grid borders." + [val] + (reset! use-unicode val)) + +(defn u? [unicode-str ascii-str] + (if @use-unicode unicode-str ascii-str)) + +(defn print-maps + "Prints a collection of maps in a textual table. Prints table headings + ks, and then a line of output for each row, corresponding to the keys + in ks. If ks are not specified, use the keys of the first item in rows." + ([ks rows add-borders] + (when (seq rows) + (let [widths (map + (fn [k] + (apply max (count (str k)) + (map #(count (str (get % k))) rows))) + ks) + spacers (map #(apply str (repeat % (u? "─" "-"))) widths) + fmts (map #(str "%-" % "s") widths) + fmt-row (fn [leader divider trailer row] + (str (if add-borders leader "") + (apply str + (interpose + divider + (for [[col fmt] + (map vector (map #(get row %) ks) fmts)] + (format fmt (str col))))) + (if add-borders trailer ""))) + aob *add-outside-borders*] + (println (fmt-row (if aob (u? "│ " "| ") "") (u? " │ " " | ") (if aob (u? " │" " |") "") + (zipmap ks (map name ks)))) + (println (fmt-row (if aob (u? "├─" "|-") "") (u? "─┼─" "-+-") (if aob (u? "─┤" "-|") "") + (zipmap ks spacers))) + (doseq [row rows] + (println (fmt-row (if aob (u? "│ " "| ") "") (u? " │ " " | ") (if aob (u? " │" " |") "") row)))))) + ([rows add-borders] + (print-maps (keys (first rows)) rows add-borders))) + +(defn trim-max-width [x] + (let [s (str x)] + (if (and *max-column-width* + (> *max-column-width* 0) + (> (count s) *max-column-width*)) + (str (subs s 0 (- *max-column-width* 3)) "...") + s))) + +(defn min-not-zero [x y] + (min (if (> x 0) x y) + (if (> y 0) y x))) + +(defn- cjk-char? + "Return true if argument char is CJK character." + [char] + (= (Character$UnicodeBlock/of char) + Character$UnicodeBlock/CJK_UNIFIED_IDEOGRAPHS)) + +(defn- cjk-chars-count + "Return count of CJK characters in string." + [text] + (count (filter cjk-char? text))) + +(defn- string-length + "Return string length, given that CJK characters have a length of 2." + [text] + (loop [string text + length 0] + (if (= (count string) 0) + length + (recur (next string) (+ length + (if (cjk-char? (first string)) 2 1)))))) + +(defn print-table + "Converts a seq of seqs to a textual table. Uses the first seq as the table + headings and the remaining seqs as rows." + ([rows limit] + (when (seq rows) + (let [row-limit (or limit (min-not-zero @max-rows @fetch-size)) + [rows msg] (if (and row-limit + (> row-limit 0) + ;; Since `rows` parameter contains a header + ;; `row` 1 should be added to `row-limit`. + (> (count rows) (+ row-limit 1))) + [(take (+ row-limit 1) rows) + (when @show-too-many-rows-message + (format "Too many rows. Only %s from %s%s are shown." + row-limit + (min-not-zero @max-rows (- (count rows) 1)) + (if (and @max-rows + (> @max-rows 0) + (> (- (count rows) 1) @max-rows)) + "+" "")))] + [rows ""]) + [headers rows] [(map name (first rows)) (rest rows)] + aob *add-outside-borders* + [rows rotated] (if (and (not aob) + (= (count rows) 1) + (> (count (first rows)) 1)) + ;; Rotatate result set table representation + ;; if it has 1 row and many columns. + [(rotate-table [headers (first rows)]) true] + [rows false]) + [single-column-and-row + cell-value] (when-let [single-cell? (and (= (count rows) 1) + (= (count (first rows)) 1))] + [single-cell? (ffirst rows)]) + [headers rows] (if (or rotated single-column-and-row) + ;; Do not restrict column width if result + ;; set has only 1 row or 1 column & 1 row. + [headers rows] + [(map trim-max-width headers) + (map #(map trim-max-width %) rows)]) + rn #"(\r\n)|\n|\r" + nl (System/getProperty "line.separator") + rows (for [row rows] + (map #(if (string? %) + (if single-column-and-row + ;; In case of only 1 column & 1 row unify + ;; newline separators to system line break. + (s/replace % rn nl) + (-> % + (s/replace rn " ") + ;; Tabs to spaces to align columns widths. + (s/replace #"\t" " "))) + ;; Do not remove newline separators if result + ;; set cell is not a string. + %) + row)) + widths (if single-column-and-row + (list + (apply max + (cons + (string-length (first headers)) + (if (string? cell-value) + (map string-length (s/split cell-value rn)) + (list (string-length (str cell-value))))))) + (for [col (rotate-table (conj rows headers))] + (apply max (map #(string-length (str %)) col)))) + spacers (map #(apply str (repeat % (u? "─" "-"))) widths) + ;; TODO: #(str "%" % "d") for numbers + fmts (if (and rotated (not aob)) + ;; Remove trailing spaces for data column of single-row + ;; result if no outer borders required. + (list (fn [text] (let [width (- (first widths) + (cjk-chars-count text)) + pattern (str "%-" width "s")] + (format pattern text))) + (fn [text] (let [pattern "%s"] + (format pattern text)))) + (map (fn [w] + (fn [text] (let [width (- w (cjk-chars-count text)) + pattern (str "%-" width "s")] + (format pattern text)))) + widths)) + fmt-row (fn [leader divider trailer row] + (str leader + (apply str (interpose + divider + (for [[col fmt] (map vector row fmts)] + (fmt (str col))))) + trailer))] + (when (not-empty msg) + (println msg) + (println)) + (when (not rotated) + (println (fmt-row (if aob (u? "│ " "| ") "") (u? " │ " " | ") (if aob (u? " │" " |") "") headers)) + (println (fmt-row (if aob (u? "├─" "|-") "") (u? "─┼─" "-+-") (if aob (u? "─┤" "-|") "") spacers))) + (doseq [row (if (and aob single-column-and-row (string? cell-value)) + (map list (s/split cell-value (re-pattern nl))) + rows)] + (println (fmt-row (if aob (u? "│ " "| ") "") (u? " │ " " | ") (if aob (u? " │" " |") "") row)))))) + ([rows] (print-table rows @fetch-size))) + +(defn unify-str + "Concatenate stings, unify newline separators to the system line break." + [& s] + (if (empty? (filter not-empty s)) + "" + (apply str (map #(s/replace % + #"(\r\n)|\n|\r" + (System/getProperty "line.separator")) + s)))) + +(defn format-sql [sql] + (s/trim + (let [sql (s/trim sql)] + (.format (if (dml? sql) + (BasicFormatterImpl.) + (DDLFormatterImpl.)) + sql)))) + +(defn format-sql-print + "SQL should be printed to provide cross-platform newline handling." + [sql] + (print (format-sql sql))) + +(defn format-sql-if-required [sql] + (if (> (StringUtils/countMatches sql "\n") 1) + sql + (format-sql sql))) + +(defn write-result-file [text & {:keys [result-file + append] + :or {append false}}] + (spit result-file text :append append) + result-file) + +(defn clear-result-file [& {:keys [result-file]}] + (write-result-file "" :result-file result-file)) diff --git a/elpa/ejc-sql-20230228.102/src/ejc_sql/structure.clj b/elpa/ejc-sql-20230228.102/src/ejc_sql/structure.clj new file mode 100644 index 00000000..97f0d092 --- /dev/null +++ b/elpa/ejc-sql-20230228.102/src/ejc_sql/structure.clj @@ -0,0 +1,1176 @@ +;;; structure.clj -- Receive database stucture and keep it in cache. + +;;; Copyright © 2016-2023 - Kostafey + +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software Foundation, +;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ + +(ns ejc-sql.structure + (:require + [clojure.java.jdbc :as j] + [clojure.string :as s] + [clojure.java.io :as io] + [clomacs :refer [clomacs-defn]] + [ejc-sql.lib :refer [is-clob? clob-to-string clean-sql in? get->in]] + [ejc-sql.cache :refer [cache cache-creation-promises]] + [ejc-sql.connect :as c] + [ejc-sql.output :as o] + [ejc-sql.keywords :as k])) + +(defn- safe-query + "Return `sql` query result or nil in case of error." + [db sql & {:keys [row-fn column-name] + :or {row-fn identity}}] + (try + (if column-name + [[(keyword column-name)] + (mapv (keyword column-name) + (row-fn (j/query db (list sql) {:as-arrays? false})))] + (j/query db (list sql) {:as-arrays? true + :row-fn row-fn})) + (catch Exception _))) + +(defn- db->column + "Execute `sql`, return `column-name` or first column + (if `column-name` is not passed) of result set as result list." + [db sql & {:keys [row-fn column-name] + :or {row-fn identity}}] + (when sql + (rest (map first (safe-query db sql + :row-fn row-fn + :column-name column-name))))) + +(defn- db->>column + "Execute `sql`, return last column of result set as result list." + [db sql] + (when sql + (rest + (map last + (j/query db (list sql) {:as-arrays? true}))))) + +(defn- db->value + "Execute `sql`, return first value of first column of result set as result." + [db sql & {:keys [row-fn] + :or {row-fn identity}}] + (first (db->column db sql :row-fn row-fn))) + +(defn get-ms-sql-server-version [ver] + (-> + (filter not-empty (.split ver " ")) + (nth 3) + Integer/parseInt)) + +(defn is-modern-sql-server? [db] + (let [ver (db->value db "SELECT @@VERSION AS 'SQL Server Version'")] + (if (.startsWith ver "Microsoft SQL Azure") + true + (> (get-ms-sql-server-version ver) 2000)))) + +(def queries + "Database - specific queries used for obtain data about database structure." + (let [default-queries + {:owners (fn [& _] " + SELECT schema_owner + FROM information_schema.schemata ") + :schemas (fn [& _] " + SELECT schema_name + FROM information_schema.schemata ") + :tables (fn [& {:keys [schema]}] + (format " + SELECT table_name + FROM information_schema.tables + %s + ORDER BY table_name " + (if schema + (format " WHERE table_schema = '%s'" schema) + ""))) + :views (fn [& _] " + SELECT table_name + FROM information_schema.views ") + :all-tables (fn [& _] " + SELECT s.schema_owner, s.schema_name, t.table_name + FROM information_schema.schemata AS s, + information_schema.tables AS t + WHERE t.table_schema = s.schema_name ") + :columns (fn [& {:keys [table]}] + (format " + SELECT column_name + FROM information_schema.columns + WHERE UPPER(table_name) = '%s' + ORDER BY column_name " + (s/upper-case table))) + :view (fn [& {:keys [entity-name]}] + (format " + SELECT v.view_definition + FROM information_schema.views AS v + WHERE UPPER(v.table_name) = '%s' " + (s/upper-case entity-name)))} + ;;-------- + oracle + ;;-------- + {:entity (fn [& {:keys [entity-name]}] + (format " + SELECT text + FROM all_source + WHERE UPPER(name) = '%s' " + (s/upper-case entity-name))) + :entity-type (fn [& {:keys [entity-name]}] + (format " + SELECT object_type + FROM all_objects + WHERE UPPER(OBJECT_NAME) = '%s' + AND object_type NOT IN ('SYNONYM', 'PACKAGE BODY') + UNION + SELECT 'PROCEDURE' FROM all_procedures + WHERE UPPER(OBJECT_NAME) = '%s' + AND object_type = 'PROCEDURE' + AND rownum = 1" + (s/upper-case entity-name) + (s/upper-case entity-name))) + :view (fn [& {:keys [entity-name]}] + (format " + SELECT text + FROM all_views + WHERE UPPER(view_name) = '%s' " + (s/upper-case entity-name))) + :types (fn [& _] " + SELECT * FROM USER_TYPES ") + :owners (fn [& _] " + SELECT DISTINCT(owner) + FROM ALL_OBJECTS + ORDER BY owner ") + :tables (fn [& {:keys [owner]}] + (format " + SELECT table_name, owner + FROM all_tables + %s + ORDER BY table_name " + (if owner + (format " WHERE UPPER(owner) = '%s' " + (s/upper-case owner)) + ""))) + :views (fn [& {:keys [owner]}] + (format " + SELECT view_name + FROM all_views + %s + ORDER BY view_name " + (if owner + (format " WHERE UPPER(owner) = '%s' " + (s/upper-case owner)) + ""))) + :all-tables (fn [& _] " + SELECT owner, table_name + FROM all_tables + WHERE owner NOT IN ('SYS', 'SYSTEM') + ORDER BY owner ") + :columns (fn [& {:keys [table]}] + (format " + SELECT column_name + FROM ALL_TAB_COLUMNS + WHERE UPPER(table_name) = '%s' " + (s/upper-case table))) + :constraints (fn [& {:keys [owner table]}] + (cond + (and owner table) + (format " + SELECT * FROM all_constraints + WHERE owner = '%s' + AND table_name = '%s' " + owner table) + table + (format " + SELECT * FROM all_constraints + WHERE table_name = '%s' " table) + :else + "SELECT * FROM user_constraints")) + :procedures (fn [& {:keys [owner]}] + (format " + SELECT object_name, procedure_name + FROM all_procedures + %s " (if owner + (format "WHERE owner = '%s' " owner) + ""))) + :parameters (fn [& {:keys [package entity-name]}] + (format " + SELECT data_type, argument_name + FROM SYS.ALL_ARGUMENTS + WHERE object_name = '%s' + AND in_out = 'IN' + %s " + (s/upper-case entity-name) + (if package + (format "AND package_name = '%s'" package) + ""))) + :package (fn [& {:keys [entity-name]}] + ;; entity-name is a package name here + (format " + SELECT text FROM + ( + SELECT text AS text, + 1 AS ordered, + line AS line + FROM all_source + WHERE UPPER(name) = '%s' + AND type = 'PACKAGE' + UNION SELECT '\n\n', 2, 1 from dual + UNION SELECT ' ------------------\n', 3, 1 from dual + UNION SELECT ' -- PACKAGE BODY --\n', 4, 1 from dual + UNION SELECT ' ------------------\n', 5, 1 from dual + UNION SELECT '\n', 6, 1 from dual + UNION + SELECT text, + 7, + line + FROM all_source + WHERE UPPER(name) = '%s' + AND type = 'PACKAGE BODY' + ) + ORDER BY ordered, line " + (s/upper-case entity-name) + (s/upper-case entity-name))) + :table (fn [& {:keys [entity-name]}] + (format " + SELECT dbms_metadata.get_ddl('TABLE','%s') + FROM dual " (s/upper-case entity-name))) + :objects (fn [& _] " + SELECT * FROM all_objects + WHERE object_type IN ('FUNCTION','PROCEDURE','PACKAGE') ") + :keywords (fn [& _] " + SELECT * FROM V$RESERVED_WORDS ORDER BY keyword ")} + ;;-------- + informix + ;;-------- + {:owners nil + :tables (fn [& _] " + SELECT TRIM(t.tabname) as tablesList + FROM systables AS t + WHERE t.tabtype = 'T' + AND t.tabid >= 100 + ORDER BY t.tabname; ") + :columns (fn [& {:keys [table]}] + (format " + SELECT TRIM(c.colname) AS column_name + FROM systables AS t, syscolumns AS c + WHERE t.tabid = c.tabid + AND t.tabtype = 'T' + AND t.tabid >= 100 + AND TRIM(t.tabname) = '%s' + ORDER BY c.colno; " table))} + ;;------- + mysql + ;;------- + {:owners (fn [& _] " + SELECT schema_name + FROM information_schema.schemata ") + :tables (default-queries :tables) + :all-tables (fn [& _] " + SELECT s.schema_name, t.table_name + FROM information_schema.schemata AS s, + information_schema.tables AS t + WHERE t.table_schema = s.schema_name ") + :columns (default-queries :columns) + :keywords (fn [& _] " + SELECT name FROM mysql.help_keyword") + :entity-type (fn [& {:keys [entity-name]}] + (format " + SELECT routine_type + FROM information_schema.routines + WHERE UPPER(routine_name) = '%s' + UNION + SELECT 'standard-function' FROM mysql.help_topic t + INNER JOIN mysql.help_category AS c + ON c.help_category_id = t.help_category_id + AND c.parent_category_id IN (SELECT help_category_id + FROM mysql.help_category + WHERE name = 'Functions') + WHERE UPPER(t.name) = '%s' + UNION + SELECT 'table' as table_name + FROM information_schema.tables + WHERE UPPER(table_name) = '%s'" + (s/upper-case entity-name) + (s/upper-case entity-name) + (s/upper-case entity-name))) + :constraints (fn [& {:keys [owner table]}] + (cond + (and owner table) + (format " + SELECT column_name, constraint_name, + referenced_column_name, referenced_table_name + FROM information_schema.key_column_usage + WHERE constraint_schema = '%s' + AND table_name = '%s' " + owner table) + table + (format " + SELECT column_name, constraint_name, + referenced_column_name, referenced_table_name + FROM information_schema.key_column_usage + WHERE table_name = '%s' " table) + :else + "SELECT * FROM information_schema.key_column_usage")) + :procedures (fn [& _] " + SELECT routine_schema, routine_name + FROM information_schema.routines ") + :procedure (fn [& {:keys [entity-name]}] + (format " + SHOW CREATE PROCEDURE %s " + entity-name)) + :function (fn [& {:keys [entity-name]}] + (format " + SHOW CREATE FUNCTION %s " + entity-name)) + :table (fn [& {:keys [entity-name]}] + (format "SHOW CREATE TABLE %s " entity-name)) + :standard-function (fn [& {:keys [entity-name]}] + (format " + SELECT description FROM mysql.help_topic + WHERE UPPER(name) = '%s' " + (s/upper-case entity-name))) + :parameters (fn [& {:keys [entity-name]}] + (format " + SELECT data_type, parameter_name + FROM information_schema.parameters + WHERE parameter_mode = 'IN' + AND UPPER(specific_name) = '%s'" + (s/upper-case entity-name)))} + ;;-------- + h2 + ;;-------- + {:tables (fn [& _] ((default-queries :tables) :schema "PUBLIC")) + :views (default-queries :views) + :all-tables (fn [& _] " + SELECT s.schema_owner, s.schema_name, t.table_name + FROM information_schema.schemata AS s, + information_schema.tables AS t + WHERE t.table_schema = s.schema_name + AND LCASE(s.schema_name) != 'information_schema' ") + :columns (default-queries :columns) + :keywords (fn [& _] + "SELECT topic FROM information_schema.help") + :entity-type (fn [& {:keys [entity-name]}] + (format " + SELECT t.table_type + FROM information_schema.tables AS t + WHERE UPPER(t.table_name) = '%s' " + (s/upper-case entity-name))) + :view (fn [& {:keys [entity-name]}] + ((default-queries :view) :entity-name entity-name))} + ;;-------- + sqlite + ;;-------- + {:tables (fn [& _] "SELECT name FROM sqlite_master WHERE type='table'") + :views (fn [& _] "SELECT name FROM sqlite_master WHERE type='view'") + :all-tables (fn [& _] "SELECT name FROM sqlite_master WHERE type='table'") + :columns (fn [& {:keys [table]}] + (format " + SELECT p.name as columnName + FROM sqlite_master m + LEFT OUTER JOIN pragma_table_info((m.name)) p + ON m.name <> p.name + WHERE m.name = '%s' + ORDER BY columnName " table)) + :keywords (:sqlite k/keywords) + :entity-type (fn [& {:keys [entity-name]}] + (format " + SELECT type FROM sqlite_master + WHERE UPPER(name) = '%s' " + (s/upper-case entity-name))) + :view (fn [& {:keys [entity-name]}] + (format " + SELECT sql FROM sqlite_master + WHERE UPPER(name) = '%s' " + (s/upper-case entity-name)))} + ;;------- + sqlserver ; ms sql server + ;;------- + {:owners (default-queries :owners) + :schemas (default-queries :schemas) + :tables (default-queries :tables) + :all-tables (default-queries :all-tables) + :columns (default-queries :columns) + :constraints (fn [& {:keys [table]}] + (format " + SELECT type_desc AS constraint_type, + name + FROM sys.objects + WHERE type_desc LIKE '%CONSTRAINT' + AND OBJECT_NAME(parent_object_id)='%s' " table)) + :entity (fn [& {:keys [db entity-name]}] + (if (is-modern-sql-server? db) + (format " + SELECT definition + FROM sys.objects o + JOIN sys.sql_modules m ON m.object_id = o.object_id + WHERE o.object_id = object_id('%s') " entity-name) + (format " + SELECT c.text + FROM sysobjects o + JOIN syscomments c ON c.id = o.id + WHERE o.name = '%s' " entity-name)))} + ;;------- + postgresql + ;;------- + {:procedure (fn [& {:keys [entity-name]}] + (format " + SELECT pg_get_functiondef(p.oid) + FROM pg_catalog.pg_proc p + WHERE upper(p.proname) = '%s' " + (s/upper-case entity-name))) + :table (fn [& {:keys [entity-name]}] + (format " + SELECT 'CREATE TABLE %s (\n' || + string_agg(column_list.column_expr, ', \n') || + '\n);' + FROM ( + SELECT ' ' || column_name || ' ' || data_type || + coalesce('(' || character_maximum_length || ')', '') || + case when is_nullable = 'YES' + then '' + else ' NOT NULL' + end as column_expr + FROM information_schema.columns + WHERE table_schema = 'public' + AND upper(table_name) = '%s' + ORDER BY ordinal_position) column_list" + entity-name + (s/upper-case entity-name))) + :owners (default-queries :owners) + :schemas (default-queries :schemas) + :tables (default-queries :tables) + :all-tables (default-queries :all-tables) + :columns (default-queries :columns) + :procedures (fn [& _] " + SELECT p.proname + FROM pg_catalog.pg_namespace n + JOIN pg_catalog.pg_proc p + ON p.pronamespace = n.oid + ORDER BY proname ") + :entity-type (fn [& {:keys [entity-name]}] + (format " + SELECT 'namespace' + FROM pg_catalog.pg_namespace n + WHERE upper(n.nspname) = '%s' + UNION + SELECT 'table' + FROM information_schema.tables + WHERE upper(table_name) = '%s' + UNION + SELECT 'view' + FROM information_schema.views + WHERE upper(table_name) = '%s' + UNION + SELECT 'procedure' + FROM pg_catalog.pg_namespace n + JOIN pg_catalog.pg_proc p + ON p.pronamespace = n.oid + WHERE upper(p.proname) = '%s' " + (s/upper-case entity-name) + (s/upper-case entity-name) + (s/upper-case entity-name) + (s/upper-case entity-name))) + :parameters (fn [& {:keys [entity-name]}] + (format " + SELECT pg_catalog.pg_get_function_identity_arguments( + p.oid) + FROM pg_catalog.pg_proc p + WHERE p.proname = '%s'" entity-name)) + :keywords (fn [& _] + "SELECT word FROM pg_get_keywords()")}] + {:oracle oracle + :informix informix + :mysql mysql + :mariadb mysql + :h2 h2 + :sqlite sqlite + :sqlserver sqlserver + :postgresql postgresql})) + +(defn get-db-name [db] + (let [{:keys [database subname connection-uri dbname]} db] + (or dbname + database + (if subname + (let [separator (if (= (first (.split subname "/")) subname) + ":" "/") + raw-db-name (last (.split subname separator)) + raw-db-name (first (.split raw-db-name "\\?")) + raw-db-name (first (.split raw-db-name ";"))] + raw-db-name) + ;; No subname - parse connection-uri + (let [props-list (.split connection-uri ";") + db-name-prop (first + (filter + (fn [prop] + (= + "databasename" + (.toLowerCase (first (.split prop "="))))) + props-list))] + (if db-name-prop + ;; "databaseName=my_db_name;" + (second (.split db-name-prop "=")) + ;; "jdbc:jtds:sqlserver://localhost:1433/my_db_name;" + (last (.split (first props-list) "/")))))))) + +(defn get-user [db] + (or + (:user db) + (let [{:keys [user connection-uri]} db] + (or user + (if connection-uri + (second (.split + (let [props-list (.split connection-uri ";")] + (first + (filter + (fn [prop] + (= + "user" + (.toLowerCase (first (.split prop "="))))) + props-list))) "=")) + :undefined-user))))) + +(def product-assoc {"oracle:sid" "oracle"}) + +(defn get-db-type [db] + (let [{:keys [subprotocol connection-uri dbtype]} db + result (or dbtype + subprotocol + (let [attrs (.split connection-uri ":")] + (if (= (second attrs) "jtds") + ;; jdbc:jtds:sqlserver://... + (nth attrs 2) + ;; jdbc:sqlserver://localhost\instance:1433; + (second attrs))))] + (keyword (or (product-assoc result) result)))) + +(defn- get? [obj & [force?]] + (when (and obj (or force? (realized? obj))) + @obj)) + +(defn get-this-owner + "Return current owner/schema." + [db & [owner]] + (or owner + (get? (get-in @cache [db :this-owner]) false) + (do + (swap! cache assoc-in [db :this-owner] + (future + ((fn [db] + (let [db-type (get-db-type db)] + (case db-type + :sqlserver (if (is-modern-sql-server? db) + ;; Get default SQL Server schema for session + (db->value db "SELECT SCHEMA_NAME()") + "dbo") + :oracle (db->value + db + "SELECT sys_context('userenv', 'current_schema') + FROM dual") + ;; By default + ;; Assume owner == schema (it can be wrong in general). + (get-user db)))) db))) + (get? (get-in @cache [db :this-owner]) true)))) + +(defn select-db-meta-script + "Return SQL request to obtain some database structure info." + [db meta-type & + {:keys [owner + table + package + entity-name]}] + (let [db-type (get-db-type db) + meta-type (if (keyword? meta-type) meta-type (keyword meta-type)) + ;; owner (get-this-owner db owner) + sql-receiver (get-in queries [db-type meta-type]) + sql (when sql-receiver + (sql-receiver :db db + :owner owner + :schema owner + :table table + :package package + :entity-name entity-name + :db-name (get-db-name db)))] + sql)) + +(defn get-namespace + "Find tables namespace for current database type. + Possible cases for namespace: + * schema is sutable (or both schema and owner) + for this DB type - use `:schemas` + * only owner is sutable, so use `:owners` + * none of them is sutable - `nil`" + [db] + (let [db-type (get-db-type db)] + (cond + (get-in queries [db-type :schemas]) :schemas + (get-in queries [db-type :owners]) :owners + :else nil))) + +(defn get-or-create-cache + "Fill `cache` atom with database structure data, then get data from it. + Parameters: + - `db` - database connection map + - `path` - the keys used to define the place to store data in `cache` atom + - `sql` - query to obtain the desired data from the database + - `force?` - when true, eval `sql` immediately and return data + - `direct-value` - sometimes there is no need to eval `sql` to obtain some + data,and value of this parameter, if it's defined, can be + used as-is + - `exec-fn` - SQL execution function (`db->column` by default) + - `filter-fn` - filer function applied to SQL execution results + - `handler-fn` - additional processing applied to SQL execution results." + [& {:keys [db + path + sql + force? + direct-value + exec-fn + filter-fn + handler-fn] + :or {exec-fn db->column}}] + (let [full-path (into [db] path)] + (if (not (get->in @cache full-path)) + (let [flat-path [db (keyword (s/join "-" (map name path)))] + c-promise (promise)] + (swap! cache-creation-promises assoc-in flat-path c-promise) + (swap! cache assoc-in full-path + (if direct-value + (future (deliver c-promise :ok) + direct-value) + (future (try + (let [result (exec-fn db sql) + result (distinct result) + result (if filter-fn + (filter filter-fn result) + result) + result (if handler-fn + (mapv handler-fn result) + result) + result (if (vector? result) + (sort result) + result)] + (deliver c-promise :ok) + result) + (catch Exception e + (deliver c-promise e) + (list)))))))) + (get? (get-in @cache full-path) force?))) + +(defn get-owners + "Return owners list from cache if already received from DB, + check if receiveing process is not running, then start it." + [db & [force?]] + (let [namespace (get-namespace db)] + (if namespace + (get-or-create-cache :db db + :path [namespace] + :sql (select-db-meta-script db namespace) + :force? force?) + ;; Schemas or owners are not applicable to this database type. + (list)))) + +(defn get-tables + "Return tables list for this owner from cache if already received from DB, + check if receiveing process is not running, then start it." + [db & [owner_ force?]] + (let [owner (get-this-owner db owner_)] + (if owner_ + (get-or-create-cache :db db + :path [:tables owner] + :sql (select-db-meta-script db :tables :owner owner) + :force? force?) + (get-or-create-cache :db db + :path [:all-tables] + :sql (select-db-meta-script db :all-tables) + :force? force? + :exec-fn db->>column)))) + +(defn get-views + "Return views list from cache if already received from DB, + check if receiveing process is not running, then start it." + [db & [owner_ force?]] + (let [owner (get-this-owner db owner_)] + (get-or-create-cache :db db + :path [:views owner] + :sql (select-db-meta-script db :views :owner owner) + :force? force?))) + +(defn get-colomns + "Return colomns list for this table from cache if already received from DB, + check if receiveing process is not running, then start it." + [db table force?] + (when (not (get->in @cache [db :colomns table])) + (swap! cache assoc-in [db :colomns table] + (future ((fn [db table] + (let [sql (select-db-meta-script db :columns + :table table)] + (sort (distinct (db->column db sql))))) + db table)))) + (get? (get->in @cache [db :colomns table]) + force?)) + +(def postgresql-type-aliases + "Some of PostgreSQL type aliases used for show in eldoc." + {"character varying" "varchar" + "bit varying" "varbit"}) + +(defn get-parameters + "Return parameters list of `stored-procedure` from cache if already received + from DB, check if receiveing process is not running, then start it." + [db package stored-procedure & [force?]] + (let [db-type (get-db-type db)] + (get-or-create-cache + :db db + :path (if package + [:stored-procedures package stored-procedure] + [:stored-procedures stored-procedure]) + :sql (select-db-meta-script db :parameters + :package package + :entity-name stored-procedure) + :force? force? + :exec-fn + (case db-type + :postgresql (fn [db sql] + ;; Use only first possible list of parameters if many. + (list (db->value db sql))) + :mysql (fn [db sql] + (list (rest (safe-query db sql)))) + :oracle (fn [db sql] + (list + (map + (fn [[param-type param-name]] + (format "%s %s" param-type param-name)) + (rest + (safe-query db + sql + :row-fn identity + :column-name nil))))) + nil) + :handler-fn + (case db-type + :postgresql (fn [types] + (map + (fn [type] + (let [type (s/trim type)] + (or (postgresql-type-aliases type) + type))) + (s/split types #","))) + :mysql (fn [types] + (map #(s/join " " %) types)) + nil)))) + +(defn get-keywords + "Return keywords list for this database type from cache if already received + from DB, check if receiveing process is not running, then start it." + [db force?] + (when-let [keywords-query (get-in queries [(get-db-type db) :keywords])] + (get-or-create-cache :db db + :path [:keywords] + :direct-value (when (vector? keywords-query) + keywords-query) + :sql (select-db-meta-script db :keywords) + :force? force? + :filter-fn #(not (nil? %))))) + +(defn get-packages + "Return packages list for this owner from cache if already received from DB, + check if receiveing process is not running, then start it." + [db & [owner_ force?]] + (let [owner (get-this-owner db owner_)] + (get-or-create-cache :db db + :path [:packages owner] + :sql (select-db-meta-script db :procedures + :owner owner) + :force? force?))) + +(defn is-owner? [db prefix] + (in? (get-owners db) prefix :case-sensitive false)) + +(clomacs-defn + complete-auto-complete + 'ejc-complete-auto-complete + :doc "Call Emacs auto-complete if point is the same as before loading.") + +(defn run-autocomplete [db buffer-name point] + (future + ;; Wait for all cache building promises ready. + (mapv deref (vals (get-in @cache-creation-promises [db]))) + ;; Remove them from memory. + (swap! cache-creation-promises assoc-in [db] nil) + ;; Pass to Emacs a note that db structure cache ready (try to autocomplete). + (complete-auto-complete buffer-name point))) + +(defn autocomplete-loading + "Not loaded tables yet. Output pending db structure data..." + ([db buffer-name point] + (run-autocomplete db buffer-name point) + (autocomplete-loading)) + ([] + (list "t"))) + +(defn autocomplete-result + "Output autocomplete result." + [result] + (cons "nil" result)) + +(defn autocomplete-nothing + "Output autocomplete nothing." + [] + (list "nil")) + +(defn get-owners-candidates + "Return owners candidates autocomplete list from the database structure + cache, async request to fill it, if not yet. + The result list has the following structure: + (pending item1 item2 ...) + If `pending` is t - the async request to get the structure is running + if `pending` is nil - no request is running, return result immediately." + [& {:keys [db sql prefix-1 buffer-name point]}] + (let [owners (get-owners db)] + (if prefix-1 + ;; Assume schema|table.# is not applicable. + ;; So, return empty list. + (autocomplete-nothing) + (if owners + (autocomplete-result owners) + ;; pending owners... + (autocomplete-loading db buffer-name point))))) + +(defn get-tables-candidates + "Return tables candidates autocomplete list." + [& {:keys [db sql prefix-1 buffer-name point]}] + (let [tables (if (not prefix-1) + ;; something# + (get-tables db) + (if (is-owner? db prefix-1) + ;; [owner].# + (get-tables db prefix-1) + ;; owners still pending or + ;; unknown?.# case + (list)))] + (if tables + (autocomplete-result tables) + ;; pending tables... + (autocomplete-loading)))) + +(defn get-views-candidates + "Return views candidates autocomplete list." + [& {:keys [db sql prefix-1 buffer-name point]}] + (if-let [views (if (not prefix-1) + ;; something# + (get-views db) + (if (is-owner? db prefix-1) + ;; [owner].# + (get-views db prefix-1) + ;; owners still pending or + ;; unknown?.# case + (list)))] + (autocomplete-result views) + ;; pending views... + (autocomplete-loading))) + +(defn get-packages-candidates + "Return packages candidates autocomplete list." + [& {:keys [db sql buffer-name point]}] + (if-let [packages (get-packages db)] + (autocomplete-result packages) + ;; pending packages... + (autocomplete-loading))) + +(defn match-alias? + "Check if prefix (`probable-alias`) is alias for `table` in this `sql`." + [sql owner table probable-alias] + (let [sql (s/lower-case sql) + owner (if owner + (str (s/lower-case owner) "\\.") + "\\s+(\\w+\\.)?") + table (s/lower-case table) + probable-alias (s/lower-case probable-alias) + alias-pattern (re-pattern + (str owner table "(\\s+as)?" + "\\s+" probable-alias))] + (not (nil? (re-find alias-pattern sql))))) + +(defn get-all-tables + "Get all tables for all owners/schemas." + [db] + (or (get-tables db nil true) + (flatten + (mapv #(get-tables db % true) + (distinct (get-owners db true)))))) + +(def select-re + (re-pattern (str "(?i)\\s*SELECT\\s+(.*\\s+)?FROM\\s+(\\S+)"))) + +(defn select-sql? + "If `sql` is SELECT query, return a table name used in FROM clause. + Otherwise return nil." + [sql] + (nth (re-find select-re sql) 2)) + +(def insert-re + (re-pattern (str "(?i)\\s*INSERT\\s+INTO\\s+(\\S+)\\s+"))) + +(defn insert-sql? + "If `sql` is INSERT query, return a table name used to insert new records. + Otherwise return nil." + [sql] + (second (re-find insert-re sql))) + +(def update-re + (re-pattern (str "(?i)\\s*UPDATE\\s(\\S+)\\s+\n*SET.*"))) + +(defn update-sql? + "If `sql` is UPDATE query, return a table name used to modify the existing + records. Otherwise return nil." + [sql] + (second (re-find update-re sql))) + +(defn get-colomns-candidates + "Return colomns candidates autocomplete list." + [& {:keys [db sql prefix-1 prefix-2 + buffer-name point]}] + ;; Possible cases: + ;; 1. [owner|schema.]table.# + ;; 2. SELECT alias.# FROM [owner|schema.]table AS alias + ;; 3. SELECT complex-alias.# FROM (SELECT...) AS complex-alias + ;; 4. INSERT INTO table (field1, .#) values (123, 'text') + ;; 5. UPDATE table SET field1 = 123, .# = 'text' WHERE id = 1 + ;; + ;; In any case, consider `prefix-1` as table or alias + ;; and optional `prefix-2` as owner or schema. + ;; When no any prefix at all, check for 4 (INSERT) or 5 (UPDATE) case. + (let [owner prefix-2 + tables-list (concat + (if owner + (get-tables db owner) + ;; In case of queries like + ;; "SELECT u.# FROM custom.Users as u" + ;; when "custom" is not the current + ;; schema, the full DB structure tree + ;; sould be built to obtain overall + ;; tables list for all owners/schemas. + (if (get-namespace db) + ;; Database has namespaces + (if (not (get-owners db)) + ;; Not received owners list yet - + ;; pending... + (do + (future (get-all-tables db)) + nil) + ;; Owners list is already here - + ;; force tables list receiving! + (get-all-tables db)) + ;; Database hasn't namespaces - + ;; no owners needed + (get-tables db))) + (get-views db))] + (if (not (and tables-list + (not-empty (filter not-empty tables-list)))) + ;; no tables yet + ;; pending tables... + (autocomplete-loading) + ;; Tables list loaded: + (if (not prefix-1) + (let [insert-or-update-table (or (select-sql? sql) + (insert-sql? sql) + (update-sql? sql))] + (cond + (and (not-empty insert-or-update-table) + (in? tables-list insert-or-update-table + :case-sensitive false)) + ;; SELECT # FROM table + ;; or + ;; INSERT INTO table (field1, .#) values (123, 'text') + ;; or + ;; UPDATE table SET field1 = 123, .# = 'text' WHERE id = 1 + (autocomplete-result + (get-colomns db insert-or-update-table true)) + ;; SELECT or other queries types + :else (autocomplete-nothing))) + (if (in? tables-list prefix-1 :case-sensitive false) + ;; table.# + (let [table prefix-1 + ;; force columns-cache obtaining... + columns-list (get-colomns db table true)] + ;; ok - columns + (autocomplete-result columns-list)) + (let [sql (clean-sql sql) + table-alias (first + (filter + (fn [table] + (match-alias? sql owner table prefix-1)) + tables-list))] + (if table-alias + ;; table-alias.# + (autocomplete-result (get-colomns db table-alias true)) + ;; Check "SELECT t.# FROM (SELECT ... ) AS t" case. + (let [pattern (re-pattern (str "\\(.+\\)(\\s|\\s(as)\\s)" + prefix-1)) + complex-alias (first (re-find pattern sql)) + complex-alias (when complex-alias + (subs complex-alias 1 + (.lastIndexOf complex-alias ")")))] + (if complex-alias + (let [{:keys [success result]} (c/query-meta db complex-alias)] + (if success + ;; complex-alias.# + (autocomplete-result (mapv :name result)) + ;; Can't execute "blah blah" to get metadata in + ;; "SELECT t.# FROM (blah blah) AS t" case. + (autocomplete-nothing))) + ;; unknown?.# case + ;; nothing to complete + (autocomplete-nothing)))))))))) + +(defn get-entity-type + "Determine DB entity type, whether it is a `:view`, `:type`, + `:package`, `:namespace` or `:procedure`." + [db entity-name] + (when-let [sql (and entity-name + (select-db-meta-script db :entity-type + :entity-name entity-name))] + (when-let [found-type (db->value db sql)] + (-> (.split found-type " ") + first + s/lower-case + keyword)))) + +(defn get-entity-type-fmt [db entity-name] + (clomacs/format-result (get-entity-type db entity-name))) + +(def creation-headers + {:oracle {:view (fn [db view] + (format "CREATE OR REPLACE VIEW %%s\n(%s)\nAS\n%%s" + (s/join ", " + (map #(-> % :name s/lower-case) + (:result + (c/query-meta db view)))))) + :package (fn [db _] "CREATE OR REPLACE %2$s\n")}}) + +(defn add-creation-header [db entity-type entity-name sql] + (let [db-type (get-db-type db)] + (if-let [header-creator (get-in creation-headers [db-type entity-type])] + (let [header-format (header-creator db entity-name)] + (format header-format entity-name sql)) + sql))) + +(defn get-entity-description + "Get DB entity creation SQL. + Database entity types: + - `:table` + - `:view` + - `:package` + - `:function` + - `:procedure` + - `:standard-function`." + [& {:keys [db + connection-name + prefix + entity-name + result-file]}] + (let [sql-object (or prefix entity-name) + db-type (get-db-type db)] + (if-let [type (get-entity-type db sql-object)] + (if (and prefix (= :namespace type)) + ;; Omit prefix if it's a `:namespace`. + (get-entity-description :db db + :connection-name connection-name + :prefix nil + :entity-name entity-name + :result-file result-file) + (if-let [entity-obtainig-sql (select-db-meta-script + db + type + :entity-name sql-object)] + (if-let [entity-sql (s/join + "" + (db->column + db + entity-obtainig-sql + :row-fn (fn [row] + (mapv #(if (is-clob? %) + (clob-to-string %) + %) + row)) + :column-name + (case (get-db-type db) + :mysql (case type + :function "create function" + :procedure "create procedure" + :table "create table" + nil) + nil)))] + (c/complete (o/unify-str + (add-creation-header + db + type + sql-object + (o/format-sql-if-required entity-sql))) + :mode (if (and (= type :standard-function) + (= db-type :mysql)) + 'rst-mode + 'sql-mode) + :connection-name connection-name + :db db + :result-file result-file + :goto-symbol (when prefix entity-name)) + (c/complete (format "Can't find %s named %s." + (name type) sql-object) + :result-file result-file)) + (c/complete (format (str "Script for obtaining DB entity of type %s " + "was not added for this database type.") + (name type)) + :result-file result-file))) + (c/complete (format "Can't determine type of %s." sql-object) + :result-file result-file)))) + +(defn print-table-meta [db table-name] + (let [result-map (c/table-meta db table-name) + success (:success result-map) + result-data (:result result-map)] + (if success + (do (println (format "Table \"%s\" description:" table-name)) + (println) + (o/print-maps result-data true)) + (println result-data)) + success)) + +(defn describe-table [& {:keys [db + connection-name + table + owner + result-file + add-outside-borders]}] + (with-open [out (io/writer result-file)] + (binding [*out* out + o/*add-outside-borders* add-outside-borders] + (when (print-table-meta db (if owner (str owner "." table) table)) + (when-let [sql (select-db-meta-script db :constraints + :owner owner + :table table)] + (println) + (println "Constraints:") + (println) + (o/print-table (second (c/eval-sql-core :db db + :sql sql + :fetch-size 0 + :max-rows 0))))))) + (c/complete + nil + :display-result true + :connection-name connection-name + :db db + :result-file result-file))