From: Andreas Gerler Date: Tue, 22 Jan 2019 14:14:24 +0000 (+0100) Subject: Update ejc-sql. X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=8d32838442481118c2a26f18b9e1e86553575980;p=emacsconfig.git Update ejc-sql. Signed-off-by: Andreas Gerler --- diff --git a/elpa/ejc-sql-20181111.2343/ejc-autocomplete.el b/elpa/ejc-sql-20181111.2343/ejc-autocomplete.el deleted file mode 100644 index 9c830050..00000000 --- a/elpa/ejc-sql-20181111.2343/ejc-autocomplete.el +++ /dev/null @@ -1,269 +0,0 @@ -;;; ejc-autocomplete.el -- SQL completitions at point (the part of ejc-sql). - -;;; Copyright © 2013-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: - -(require 'dash) -(require 'auto-complete) -(require 'ejc-lib) -(require 'ejc-interaction) -(require 'ejc-doc) -(require 'ejc-format) - -(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) - -(defcustom ejc-use-flx nil - "Non-nil enables `flx' fuzzy matching engine autocompletion." - :group 'ejc-sql - :type 'boolean) - -(defcustom ejc-flx-threshold 3 - "The minimum number of typed chars required to use `flx' for autocompletion." - :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-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)))) - -(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")) - -(defun ejc-not-nil-str (s) - (not (equal s "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 - ejc-db - (apply - 'buffer-substring - (ejc-get-sql-boundaries-at-point)) - prefix-1 - prefix-2)) - (pending (car result)) - (candidates-cache (cdr result))) - (if (ejc-not-nil-str pending) - (message "Receiving database structure...") - 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-colomns-candidates () - (ejc-candidates 'ejc-get-colomns-candidates)) - -(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-ansi-sql-words () - (unless (or (ejc-return-point) (ejc-get-prefix-word)) - (progn - (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))) - nil)) - -(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)) - -(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-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))) - -;;;###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-owners) - (add-to-list 'ac-sources 'ac-source-ejc-tables) - (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 (functionp 'flx-flex-match) - (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) - -(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-autocomplete) - -;;; ejc-autocomplete.el ends here diff --git a/elpa/ejc-sql-20181111.2343/ejc-direx.el b/elpa/ejc-sql-20181111.2343/ejc-direx.el deleted file mode 100644 index d59d201f..00000000 --- a/elpa/ejc-sql-20181111.2343/ejc-direx.el +++ /dev/null @@ -1,196 +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) - ("colomn" . 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). - (let ((schemas (ejc-get-cached-owners-list ejc-db t))) - (-map #'schema-item schemas)))) - -(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-20181111.2343/ejc-doc.el b/elpa/ejc-sql-20181111.2343/ejc-doc.el deleted file mode 100644 index 7c99ab69..00000000 --- a/elpa/ejc-sql-20181111.2343/ejc-doc.el +++ /dev/null @@ -1,75 +0,0 @@ -;;; ejc-doc.el -- SQL quick hints documentation. - -;; Copyright © wikipedia.org -;; Creative Commons Attribution-ShareAlike license - -;;; Code: - -(require 'dash) - -(defconst ejc-sql-doc (make-hash-table :test 'eq)) - -(defun ejc-fill-doc (&rest args) - (-reduce (lambda (key val) - (puthash key val ejc-sql-doc)) - args)) - -(defvar ejc-doc-created-p nil) - -(defun ejc-create-doc () - (ejc-fill-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 - ;") - (setq ejc-doc-created-p t)) - -(provide 'ejc-doc) - -;;; ejc-doc.el ends here diff --git a/elpa/ejc-sql-20181111.2343/ejc-format.el b/elpa/ejc-sql-20181111.2343/ejc-format.el deleted file mode 100644 index b7fb04a1..00000000 --- a/elpa/ejc-sql-20181111.2343/ejc-format.el +++ /dev/null @@ -1,235 +0,0 @@ -;;; ejc-format.el -- SQL formatting library (the part of ejc-sql). - -;;; Copyright © 2012-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: - -(require 'cua-base) -(require 'ejc-lib) -(require 'subr-x) - -(defvar ejc-sql-separator "/" - "The char with purpose to separate the SQL statement both other.") - -(defun ejc-sql-separator-re () - (format "^\\s-*%s\\s-*" ejc-sql-separator)) - -(defun ejc-get-sql-boundaries-at-point () - "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." - (save-excursion - (let* ((beg (progn - (if (re-search-backward (ejc-sql-separator-re) nil t nil) - (forward-char) - (beginning-of-buffer)) - (point))) - (end (progn - (if (re-search-forward (ejc-sql-separator-re) nil t nil) - (backward-char) - (end-of-buffer)) - (point)))) - (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 (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) - (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) - (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)))) - -(defun ejc-get-sql-at-point () - "Return SQL around the point." - (ejc--in-sql-boundaries beg end - (let ((sql (ejc-strip-text-properties (buffer-substring beg end)))) - sql))) - -(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 () - (interactive) - (ejc--in-sql-boundaries - beg end - (ejc-format-sql beg end))) - -(defun ejc-pretty-print-sql-at-point () - "Pretty-print SQL bounded by the `ejc-sql-separator' or/and buffer -boundaries." - (interactive) - (ejc--in-sql-boundaries - beg end - (let ((result (ejc-pretty-print (buffer-substring beg end) :hibernate))) - (delete-region beg end) - (insert result)))) - -(defun ejc-pretty-print-sql-region (beg end) - "Pretty-print SQL bounded by the selection area." - (interactive "r") - (let ((result (ejc-pretty-print (buffer-substring beg end) :hibernate))) - (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) - (interactive) - (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-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))) - -(defun ejc-flash-this-sql () - "Select (mark) SQL around the point." - (interactive) - (ejc--in-sql-boundaries - beg end - (ejc-flash-region beg end))) - -(provide 'ejc-format) - -;;; ejc-format.el ends here diff --git a/elpa/ejc-sql-20181111.2343/ejc-interaction.el b/elpa/ejc-sql-20181111.2343/ejc-interaction.el deleted file mode 100644 index 124f1a04..00000000 --- a/elpa/ejc-sql-20181111.2343/ejc-interaction.el +++ /dev/null @@ -1,241 +0,0 @@ -;;; ejc-interaction.el -- ejc-sql interact with Clojure. -*- lexical-binding: t -*- - -;;; Copyright © 2013-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: - -(require 'ejc-lib) -(require 'ejc-format) -(require 'clomacs) - -(clomacs-create-httpd-start ejc-httpd-start - :lib-prefix "ejc" - :lib-name "ejc-sql") - -(clomacs-create-httpd-stop ejc-httpd-stop - :lib-prefix "ejc" - :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 cemerick.pomegranate) - -(clomacs-defun ejc-require - clojure.core/require - :lib-name "ejc-sql") - -(clomacs-defun ejc-import - clojure.core/import - :lib-name "ejc-sql") - -(defun ejc-connect-to-db (conn-struct) - (ejc-require `'cemerick.pomegranate) - (ejc-add-classpath (alist-get :classpath conn-struct)) - (if-let ((classname (alist-get :classname conn-struct))) - (ejc-import (read classname))) - (ejc-sql-set-db conn-struct) - (setq-local ejc-connection-struct conn-struct)) - -(defun ejc-get-sql-from-string (sql) - (let* ((sql (replace-regexp-in-string ejc-clear-sql-regexp "" sql)) - (sql (replace-regexp-in-string "\"" "'" sql))) - sql)) - -(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--eval-sql-get-column - eval-sql-internal-get-column - :lib-name "ejc-sql" - :return-type :list - :namespace ejc-sql.connect - :doc "Get `sql', return list.") - -(defalias 'ejc--eval-get-list 'ejc--eval-sql-get-column) - -(clomacs-defun ejc-get-table-meta - ejc-sql.connect/get-table-meta - :lib-name "ejc-sql" - :namespace ejc-sql.connect) - -(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-pretty-print - pretty-print - :lib-name "ejc-sql" - :namespace ejc-sql.output - :return-value :stdout) - -(clomacs-defun ejc-set-rows-limit - set-rows-limit - :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-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-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-invalidate-cache-inner - invalidate-cache - :lib-name "ejc-sql" - :namespace ejc-sql.structure - :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 :boolean) - -(defun ejc-invalidate-cache () - "Clean current connection cache (database owners and tables list)." - (interactive) - (ejc-invalidate-cache-inner ejc-connection-struct)) - -(clomacs-defun ejc-get-cache - get-cache - :lib-name "ejc-sql" - :namespace ejc-sql.structure) - -(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) - -(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) - (sql-highlight-product) - (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-20181111.2343/ejc-lib.el b/elpa/ejc-sql-20181111.2343/ejc-lib.el deleted file mode 100644 index 845e66f0..00000000 --- a/elpa/ejc-sql-20181111.2343/ejc-lib.el +++ /dev/null @@ -1,50 +0,0 @@ -;;; ejc-lib.el -- ejc-sql shared objects (the part of ejc-sql). - -;;; Copyright © 2013-2016 - 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: - -(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-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) - -(provide 'ejc-lib) - -;;; ejc-lib.el ends here diff --git a/elpa/ejc-sql-20181111.2343/ejc-result-mode.el b/elpa/ejc-sql-20181111.2343/ejc-result-mode.el deleted file mode 100644 index 4aa05772..00000000 --- a/elpa/ejc-sql-20181111.2343/ejc-result-mode.el +++ /dev/null @@ -1,42 +0,0 @@ -;;; ejc-result-mode.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: - -(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))) - -(defun ejc-result-mode () - (interactive) - (kill-all-local-variables) - (setq view-read-only t) - (setq truncate-lines t) - (setq major-mode 'ejc-result-mode - mode-name "SQL-Result") - (setq font-lock-defaults '(ejc-result-font-lock-keywords))) - -(provide 'ejc-result-mode) - -;;; ejc-result-mode.el ends here diff --git a/elpa/ejc-sql-20181111.2343/ejc-sql-autoloads.el b/elpa/ejc-sql-20181111.2343/ejc-sql-autoloads.el deleted file mode 100644 index f20e684a..00000000 --- a/elpa/ejc-sql-20181111.2343/ejc-sql-autoloads.el +++ /dev/null @@ -1,139 +0,0 @@ -;;; ejc-sql-autoloads.el --- automatically extracted autoloads -;; -;;; 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-owners-candidates "ejc-autocomplete" "\ - - -\(fn)" nil nil) - -(autoload 'ejc-tables-candidates "ejc-autocomplete" "\ - - -\(fn)" nil nil) - -(autoload 'ejc-colomns-candidates "ejc-autocomplete" "\ - - -\(fn)" nil nil) - -(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# - -\(fn)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ejc-autocomplete" '("ejc-" "ac-"))) - -;;;*** - -;;;### (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" "\ - - -\(fn)" t nil) - -(autoload 'ejc-direx:switch-to-buffer "ejc-direx" "\ - - -\(fn)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ejc-direx" '("ejc-direx:" "direx"))) - -;;;*** - -;;;### (autoloads nil "ejc-doc" "ejc-doc.el" (0 0 0 0)) -;;; Generated autoloads from ejc-doc.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ejc-doc" '("ejc-"))) - -;;;*** - -;;;### (autoloads nil "ejc-format" "ejc-format.el" (0 0 0 0)) -;;; Generated autoloads from ejc-format.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ejc-format" '("ejc-"))) - -;;;*** - -;;;### (autoloads nil "ejc-interaction" "ejc-interaction.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from ejc-interaction.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ejc-interaction" '("ejc-"))) - -;;;*** - -;;;### (autoloads nil "ejc-lib" "ejc-lib.el" (0 0 0 0)) -;;; Generated autoloads from ejc-lib.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ejc-lib" '("ejc-"))) - -;;;*** - -;;;### (autoloads nil "ejc-result-mode" "ejc-result-mode.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from ejc-result-mode.el - -(if (fboundp 'register-definition-prefixes) (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. - -\(fn &optional ARG)" t nil) - -(autoload 'ejc-create-menu "ejc-sql" "\ - - -\(fn)" nil 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. - -\(fn)" t nil) - -(if (fboundp 'register-definition-prefixes) (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-20181111.2343/ejc-sql-pkg.el b/elpa/ejc-sql-20181111.2343/ejc-sql-pkg.el deleted file mode 100644 index 020b3b8f..00000000 --- a/elpa/ejc-sql-20181111.2343/ejc-sql-pkg.el +++ /dev/null @@ -1,17 +0,0 @@ -(define-package "ejc-sql" "20181111.2343" "Emacs SQL client uses Clojure JDBC." - '((emacs "25.1") - (clomacs "0.0.3") - (dash "2.12.1") - (auto-complete "1.5.1") - (spinner "1.7.1") - (direx "1.0.0")) - :keywords - '("sql" "jdbc") - :authors - '(("Kostafey" . "kostafey@gmail.com")) - :maintainer - '("Kostafey" . "kostafey@gmail.com") - :url "https://github.com/kostafey/ejc-sql") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/ejc-sql-20181111.2343/ejc-sql.el b/elpa/ejc-sql-20181111.2343/ejc-sql.el deleted file mode 100644 index 7de87065..00000000 --- a/elpa/ejc-sql-20181111.2343/ejc-sql.el +++ /dev/null @@ -1,612 +0,0 @@ -;;; ejc-sql.el --- Emacs SQL client uses Clojure JDBC. -*- lexical-binding: t -*- - -;;; Copyright © 2012-2018 - Kostafey - -;; Author: Kostafey -;; URL: https://github.com/kostafey/ejc-sql -;; Keywords: sql, jdbc -;; Version: 0.0.1 -;; Package-Requires: ((emacs "25.1")(clomacs "0.0.3")(dash "2.12.1")(auto-complete "1.5.1")(spinner "1.7.1")(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 'ejc-lib) -(require 'ejc-direx) -(require 'ejc-format) -(require 'ejc-interaction) -(require 'ejc-result-mode) -(require 'ejc-autocomplete) - -(defvar-local ejc-db nil - "JDBC connection info for current SQL buffer.") - -(defvar ejc-connections nil - "List of existing configured jdbc connections") - -(defvar ejc-results-buffer nil - "The results buffer.") - -(defvar ejc-results-buffer-name "*ejc-sql-output*" - "The results buffer name.") - -(defvar ejc-result-file-path nil - "The results file path. Refreshed by any finished SQL evaluation.") - -(defvar ejc-current-buffer-query nil - "Current SQL edit buffer lanched query.") - -(defvar ejc-temp-editor-buffer-name "*ejc-sql-editor*" - "The buffer for conveniently edit ad-hoc SQL scripts.") - -(defvar ejc-temp-editor-file (expand-file-name "~/tmp/ejc-sql-editor.sql")) - -(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) - -(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-h t") 'ejc-describe-table) -(define-key ejc-sql-mode-keymap (kbd "C-h T") '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) - -(defvar ejc-command-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "") #'ejc-show-last-result) - (define-key map (kbd "t") #'ejc-show-tables-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 "p") #'ejc-pretty-print-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-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)))) - (run-hooks 'ejc-sql-minor-mode-hook)) - -;;;###autoload -(define-minor-mode ejc-sql-mode - "Toggle ejc-sql mode." - :lighter " ejc" - :keymap ejc-sql-mode-keymap - :group 'ejc - :global nil - ;; :after-hook (ejc-create-menu) - (if ejc-sql-mode - (progn - (ejc-ac-setup) - (ejc-create-menu) - (ejc-refresh-font-lock)) - (progn - ;; (global-unset-key [menu-bar ejc-menu]) - (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 - classpath - separator - ;; ---------- - ;; 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 :classpath classpath) - (cons :separator separator) - (cons :classname classname))) - new-connection)) - ejc-connections))) - -(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)) - -(defvar ejc-product-assoc - '((sqlserver . ms))) - -(defun ejc-configure-sql-buffer (product-name) - (unless (org-src-edit-buffer-p) - (sql-mode)) - (sql-set-product (or (cdr (assoc-string product-name ejc-product-assoc)) - (car (assoc-string product-name sql-product-alist)) - "ansi")) - (auto-complete-mode t) - (auto-fill-mode t) - (ejc-sql-mode) - (ejc-sql-mode t)) - -(defun ejc-load-conn-statistics () - "Load connection usage statistics to `ejc-conn-statistics' var." - (condition-case nil - (let ((dir (file-name-directory ejc-conn-statistics-file))) - (if (not (file-accessible-directory-p dir)) - (make-directory dir)) - (load-file ejc-conn-statistics-file)) - (error - (with-temp-file ejc-conn-statistics-file - (insert "(setq ejc-conn-statistics (list))")) - (load-file ejc-conn-statistics-file))) - ejc-conn-statistics) - -(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)))) - (with-temp-file ejc-conn-statistics-file - (insert "(setq ejc-conn-statistics '") - (prin1 ejc-conn-statistics (current-buffer)) - (insert ")"))) - -;;;###autoload -(defun ejc-connect (connection-name) - "Connect to selected db." - (interactive - (list - (ido-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))))) - (let ((db (cdr (ejc-find-connection connection-name)))) - (ejc-update-conn-statistics connection-name) - (ejc-configure-sql-buffer (or (alist-get :subprotocol db) - (alist-get :dbtype db))) - (setq-local ejc-connection-name connection-name) - (setq-local ejc-db db) - (message "Connection started...") - (ejc-connect-to-db db) - (when (ejc-validate-connection :db ejc-db - :timeout ejc-connection-validate-timeout) - (setq mode-name (format "%s->[%s]" mode-name connection-name)) - (message "Connected.")))) - -;;;###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-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)))) - -(defun ejc-get-prompt-symbol-under-point (msg) - (let ((sql-symbol (if mark-active - (buffer-substring (mark) (point)) - (ejc-get-word-at-point (point)))) - (enable-recursive-minibuffers t) - val) - (setq val (completing-read - (if sql-symbol - (format "%s (default %s): " msg sql-symbol) - (format "%s: " msg)) - obarray)) - (list (if (equal val "") - sql-symbol - val)))) - -(defun ejc-check-connection () - (unless (ejc-buffer-connected-p) - (error "Run M-x ejc-connect first!"))) - -(cl-defun ejc-eval-sql-and-log (db sql - &key start-time rows-limit append sync) - (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 - db - prepared-sql - :start-time start-time - :rows-limit rows-limit - :append append - :sync sync)))) - -(defun ejc-message-query-done (start-time result) - (message - "%s SQL query at %s. Exec time %.03f" - (case result - (: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)))) - -(cl-defun ejc-complete-query (result-file-path &key start-time result) - (setq ejc-result-file-path result-file-path) - (with-current-buffer ejc-current-buffer-query - (spinner-stop)) - (ejc-show-last-result nil :result-file-path ejc-result-file-path) - (if (and start-time result) - (ejc-message-query-done start-time result)) - 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) - (if (and (clomacs-get-connection "ejc-sql") - (ejc--is-query-running-p)) - (let ((start-time (ejc--cancel-query))) - (with-current-buffer ejc-current-buffer-query - (spinner-stop)) - (ejc-message-query-done start-time :terminated)) - (keyboard-quit))) - -(defun ejc-describe-table (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) - (let* ((owner (car (split-string table-name "\\."))) - (table (cadr (split-string table-name "\\.")))) - (when (not table) - (setq table owner) - (setq owner nil)) - (ejc-get-table-meta ejc-db table-name) - (let ((sql (ejc-select-db-meta-script ejc-db :constraints - :owner owner - :table table))) - (when (ejc-not-nil-str sql) - (ejc-write-result-file (concat "\n" - "Constraints:\n" - "------------\n") - :append t) - (ejc-eval-sql-and-log ejc-db sql :append t))))) - -(defun ejc-describe-entity (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-show-last-result - (let ((entity-result - ;; Try to get entity source code. - (ejc-eval-sql-and-log - ejc-db - (ejc-select-db-meta-script ejc-db :entity - :entity-name entity-name)))) - (if (not (equal entity-result "nil")) - ;; Show entity text. - ;; Assume there is no entity and view with the same names. - entity-result - ;; No entity with such name. - ;; Try to get view source code. - (ejc-eval-sql-and-log - ejc-db - (ejc-select-db-meta-script ejc-db :view - :entity-name entity-name)))))) - -(cl-defun ejc-eval-user-sql (sql &key rows-limit sync) - "Evaluate SQL by user: reload and show query results buffer, update log." - (message "Processing SQL query...") - (ejc-eval-sql-and-log ejc-db - sql - :rows-limit rows-limit - :start-time (current-time) - :sync sync)) - -(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))) - -(cl-defun ejc-eval-user-sql-at-point (&key sync) - "Evaluate SQL bounded by the `ejc-sql-separator' or/and buffer -boundaries." - (interactive) - (ejc-check-connection) - (ejc-flash-this-sql) - (ejc-eval-user-sql (ejc-get-sql-at-point) :sync sync)) - -(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)) - -(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))) - -(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))) - -(defun ejc-show-procedures-list (&optional owner) - "Output procedures list." - (interactive) - (ejc-eval-user-sql (ejc-select-db-meta-script ejc-db :procedures - :owner owner))) - -;;----------------------------------------------------------------------------- -;; results buffer -;; -(defun ejc-create-output-buffer () - (set-buffer (get-buffer-create ejc-results-buffer-name)) - (setq ejc-results-buffer (current-buffer)) - (ejc-result-mode) - ejc-results-buffer) - -(defun ejc-get-buffer-or-create (buffer-or-name create-buffer-fn) - "Return buffer passed in `buffer-or-name' parameter. -If this buffer is not exists or it was killed - create buffer via -`create-buffer-fn' function (this function must return buffer)." - (let ((buf (if (bufferp buffer-or-name) - buffer-or-name - (get-buffer buffer-or-name)))) - (if (and buf (buffer-live-p buf)) - buf - (apply create-buffer-fn nil)))) - -(defun ejc-get-output-buffer () - (if (and ejc-results-buffer (buffer-live-p ejc-results-buffer)) - ejc-results-buffer - (ejc-create-output-buffer))) - -(cl-defun ejc-show-last-result - (&optional result - &key - (result-file-path ejc-result-file-path)) - "Popup buffer with last SQL execution result output." - (interactive) - (let ((output-buffer (ejc-get-output-buffer)) - (old-split split-width-threshold)) - (set-buffer output-buffer) - (if (or result result-file-path) - (progn - (read-only-mode -1) - (erase-buffer) - (if (and result (not result-file-path)) - ;; result only - (insert result) - ;; result-file-path only - (insert-file-contents result-file-path)))) - (read-only-mode 1) - (beginning-of-buffer) - (setq split-width-threshold nil) - (display-buffer output-buffer) - (setq split-width-threshold old-split))) - -(defun ejc-switch-to-sql-editor-buffer () - "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." - (interactive) - (if (get-buffer ejc-temp-editor-buffer-name) - (switch-to-buffer ejc-temp-editor-buffer-name) - (progn - (unless (file-exists-p - (file-name-directory ejc-temp-editor-file)) - (make-directory (file-name-directory ejc-temp-editor-file) t)) - (find-file ejc-temp-editor-file) - (rename-buffer ejc-temp-editor-buffer-name) - (ejc-configure-sql-buffer "ansi")))) - -(defun ejc-open-log () - (interactive) - (find-file-read-only (ejc-get-log-file-path)) - (end-of-buffer)) - -(provide 'ejc-sql) - -;;; ejc-sql.el ends here diff --git a/elpa/ejc-sql-20181111.2343/project.clj b/elpa/ejc-sql-20181111.2343/project.clj deleted file mode 100644 index f5f550a1..00000000 --- a/elpa/ejc-sql-20181111.2343/project.clj +++ /dev/null @@ -1,14 +0,0 @@ -(defproject ejc-sql "0.0.1-SNAPSHOT" - :description "Interact with database via java/clojure libs to run SQL/JPQL 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/clojure-contrib "1.2.0"] - [org.clojure/java.jdbc "0.7.8"] - [org.apache.openjpa/openjpa-all "2.2.2"] - [org.hibernate/hibernate-core "5.2.3.Final"] - [com.cemerick/pomegranate "0.3.0"] - [org.apache.commons/commons-lang3 "3.2.1"] - [org.apache.httpcomponents/httpclient "4.5.5"] - [clomacs "0.0.3-SNAPSHOT"]]) diff --git a/elpa/ejc-sql-20181111.2343/src/ejc_sql/connect.clj b/elpa/ejc-sql-20181111.2343/src/ejc_sql/connect.clj deleted file mode 100644 index 11abcbd0..00000000 --- a/elpa/ejc-sql-20181111.2343/src/ejc_sql/connect.clj +++ /dev/null @@ -1,259 +0,0 @@ -;;; connect.clj -- Core clojure functions for ejc-sql emacs extension. - -;;; Copyright © 2013-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. */ - -(ns ejc-sql.connect - (:use [clojure.java.io] - [ejc-sql.lib] - [clomacs]) - (:require [clojure.java.jdbc :as j] - [clojure.contrib.java-utils] - [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 clean-sql [sql] - (-> sql - (s/replace #"(--).*\n" "") - (s/replace #"( )|( \t)|\t" " ") - (s/replace "^\n" "") - trim)) - -(def dml-set - #{"SELECT" - "INSERT" - "UPDATE" - "DELETE"}) - -(def ignore-set #{\( \[}) - -(defn determine-dml [sql] - "Determine if current SQL is Data Manipulation Language (DML) case." - (let [sql (clean-sql sql) - pos (loop [pos 0] - (if (ignore-set (get sql pos)) - (recur (inc pos)) - pos))] - (or - (dml-set (.toUpperCase (subs sql pos (+ 6 pos)))) - (#{"SHOW"} (.toUpperCase (subs sql pos (+ 4 pos))))))) - -(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 clob-to-string [clob] - "Turn an Oracle Clob into a String" - (with-open [rdr (java.io.BufferedReader. (.getCharacterStream clob))] - (apply str (line-seq rdr)))) - -(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-row [row] - "Check all data in row if it's a CLOB and convert CLOB to string." - (loop [acc {} - rest-keys (keys row)] - (if rest-keys - (let [k (first rest-keys) - v (row k)] - (recur (assoc acc k (if (is-clob? v) - (clob-to-string v) - v)) - (next rest-keys))) - acc))) - -(defn is-query-running? [] - (let [stmt (:stmt @current-query)] - (and (not (nil? stmt)) - (not (.isClosed stmt))))) - -(defn cancel-query [] - "Terminate current (long) running query. Aimed to cancel SELECT queries. -Unsafe for INSERT/UPDATE/CREATE/ALTER queries." - (future - (if (is-query-running?) - (let [conn (:conn @current-query) - runner (:runner @current-query)] - (try - (.rollback conn) - (finally - (.close conn))) - (if (and - (not (nil? runner)) - (not (future-done? runner)) - (not (future-cancelled? runner))) - (future-cancel runner))))) - (:start-time @current-query)) - -(defn validate-connection [& {:keys [db timeout] - :or {db @ejc-sql.connect/db - timeout 5}}] - (.isValid (j/get-connection db) timeout)) - -(defn get-separator-re [separator] - "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%'" - (String/format "%s(?=(([^('|\")]*('|\")){2})*[^('|\")]*$)" - (into-array separator))) - -(defn eval-sql-core - "The core SQL evaluation function." - [& {:keys [db sql] - :or {db @ejc-sql.connect/db}}] - (set-db db) - (java.util.Locale/setDefault (java.util.Locale. "UK")) - (let [statement-separator (or (:separator db) ";")] - (last - (for [sql-part (seq (.split (handle-special-cases db sql) - (get-separator-re statement-separator)))] - (try - (let [sql-query-word (determine-dml sql-part)] - (if (and sql-query-word (or (.equals sql-query-word "SELECT") - (.equals sql-query-word "SHOW"))) - (list :result-set - (with-open [conn (j/get-connection db)] - (let [stmt (j/prepare-statement conn sql-part)] - (swap! current-query assoc - :stmt stmt - :conn conn) - (j/query db stmt - {:as-arrays? false - :row-fn clob-to-string-row})))) - (list :message - (str "Records affected: " - (first (j/execute! db (list sql-part))))))) - (catch SQLException e - (list :message - (str "Error: "(.getMessage e))))))))) - -(clomacs-defn complete-query ejc-complete-query - :doc "Show file contents with SQL query evaluation results.") - -(defn- eval-user-sql [db sql & {:keys [rows-limit append]}] - (let [clear-sql (.trim sql)] - (o/log-sql (str clear-sql "\n")) - (let [[result-type result] (eval-sql-core - :db db - :sql clear-sql)] - (complete-query - (o/write-result-file (if (= result-type :result-set) - (o/print-table result rows-limit) - result) - :append append) - :start-time (:start-time @current-query) - :result (if (and - (not (= result-type :result-set)) - (= (s/lower-case (subs result 0 (min 5 (count result)))) - "error")) - (if (.contains (s/lower-case result) - "closed connection") - :terminated - :error) - :done))))) - -(defn eval-sql-and-log-print - "Write SQL to log file, evaluate it and print result." - [db sql & {:keys [rows-limit append start-time sync] - :or {append false - sync false}}] - (letfn [(run-query [] - (eval-user-sql db sql - :rows-limit rows-limit - :append append))] - (if sync - (run-query) - (swap! current-query assoc - :runner (future (run-query)) - :start-time start-time)))) - -(defn eval-sql-internal-get-column [db sql] - (let [[result-type result] (eval-sql-core :db db - :sql sql)] - (if (= result-type :result-set) - (-> result rest flatten) - result))) - -(defn query-meta [db sql] - "Get metadata for `sql` result dataset." - (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))) - -(defn get-table-meta - "Discribe table." - [db table-name] - (let [result-map (table-meta db table-name) - success (:success result-map) - result-data (:result result-map) - head (str "Table \"" table-name "\" description:\n") - head-length (dec (.length head))] - (complete-query - (o/write-result-file - (if success - (str head - (ejc-sql.lib/simple-join head-length "-") "\n" - (o/print-table result-data)) - result-data))))) diff --git a/elpa/ejc-sql-20181111.2343/src/ejc_sql/jpa.clj b/elpa/ejc-sql-20181111.2343/src/ejc_sql/jpa.clj deleted file mode 100644 index f7ce3eba..00000000 --- a/elpa/ejc-sql-20181111.2343/src/ejc_sql/jpa.clj +++ /dev/null @@ -1,48 +0,0 @@ -(ns ejc-sql.jpa - (:require [cemerick.pomegranate :as pom]) - (:use [clojure.java.io] - [ejc-sql.lib] - [ejc-sql.output]) - (:import [javax.persistence Persistence - EntityManager - TypedQuery] - [org.apache.commons.lang3.builder - ReflectionToStringBuilder - ToStringStyle])) - -(def em) - -(defn connect [{:keys [connection-name - persistent-xml-url - domain-objects-url - jdbc-driver-url]}] - (pom/add-classpath persistent-xml-url) - (pom/add-classpath domain-objects-url) - (pom/add-classpath jdbc-driver-url) - (def em (-> (Persistence/createEntityManagerFactory connection-name) - (.createEntityManager)))) - -(defn connect-plain [connection-name - persistent-xml-url - domain-objects-url - jdbc-driver-url] - (connect - {:connection-name connection-name - :persistent-xml-url persistent-xml-url - :domain-objects-url domain-objects-url - :jdbc-driver-url jdbc-driver-url})) - -(defn eval-jpql [jpql] - (-> em (.createQuery jpql) (.getResultList) (.toArray))) - -(defn row-to-str [row] - (if (not (array? row)) - (ReflectionToStringBuilder/toString - row ToStringStyle/SHORT_PREFIX_STYLE) - (list (str row)))) - -(defn eval-jpql-print [jpql] - (print - (format-output (map row-to-str (eval-jpql jpql)) - :as-arrays? true, :add-headers? false))) - diff --git a/elpa/ejc-sql-20181111.2343/src/ejc_sql/lib.clj b/elpa/ejc-sql-20181111.2343/src/ejc_sql/lib.clj deleted file mode 100644 index d0cd8dbb..00000000 --- a/elpa/ejc-sql-20181111.2343/src/ejc_sql/lib.clj +++ /dev/null @@ -1,91 +0,0 @@ -;;; lib.clj -- Misc clojure functions for ejc-sql emacs extension. - -;;; Copyright © 2013-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. */ - -(ns ejc-sql.lib - (:import (java.io File)) - (:require [clojure.string :as s] - [clojure.reflect :refer [resolve-class]])) - -(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}}] - (if (and elm seq) - (if (not case-sensitive) - (in? (mapv s/lower-case seq) (s/lower-case elm)) - (some #(= elm %) seq)))) - -(defn get->in [obj path & {:keys [case-sensitive] :or {case-sensitive false}}] - "Case insensitive `get-in` for last key in sequence." - (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 array? [x] - (-> x .getClass .isArray)) - -(defn trim [s] - (if (instance? java.lang.String s) - (.trim s) - s)) - -(defn filter-data [rs] - (map #(map trim %) rs)) - -(defn get-rs-data [rs] - (map vals rs)) - -(defn get-rs-headers [rs] - (for [[k _] (first rs)] - (subs (str k) 1))) - -(defn transpose [m] - (apply mapv vector m)) - -(defn find-longest-list - "Returns the list of the longest lengths per column." - [lst] - (map #(apply max %) (transpose lst))) - -(defn simple-join [n s] - (clojure.string/join - (for [x (range 0 n)] s))) - -(defn str-length [s] - (.length (str s))) - -(defn get-rs-lengths [rs] - (map #(map str-length %) rs)) - -(defn get-absolute-file-path [relative-file-path] - (-> (java.io.File. relative-file-path) .getAbsolutePath)) - -(defn class-exists? [c] - (resolve-class (.getContextClassLoader (Thread/currentThread)) c)) diff --git a/elpa/ejc-sql-20181111.2343/src/ejc_sql/output.clj b/elpa/ejc-sql-20181111.2343/src/ejc_sql/output.clj deleted file mode 100644 index 3e9ed5bd..00000000 --- a/elpa/ejc-sql-20181111.2343/src/ejc_sql/output.clj +++ /dev/null @@ -1,168 +0,0 @@ -;;; output.clj -- Output & formatting clojure functions for ejc-sql. - -;;; Copyright © 2013, 2016 - 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.contrib.java-utils - [clojure.string :as s]) - (:import (java.io File) - (java.lang.reflect Method) - (java.util.Date) - (java.text.SimpleDateFormat) - (org.apache.openjpa.lib.jdbc SQLFormatter) - (org.hibernate.engine.jdbc.internal BasicFormatterImpl))) - -(def result-file-name - "SQL evaluation results file name." - "ejc-sql-result.txt") - -(defn get-result-file-path [] - (.getAbsolutePath - (File. - (File. (System/getProperty "java.io.tmpdir")) - result-file-name))) - -(defn get-log-dir [] - (file (if windows? - (System/getenv "AppData") - "/var/log/") - "ejc-sql")) - -(defn get-log-file [] - (file (get-log-dir) - (str (.format (new java.text.SimpleDateFormat - "yyyy-MM-dd") - (new java.util.Date)) ".log"))) - -(defn print-log-file-path [] - (print (.getAbsolutePath (get-log-file)))) - -(defn log-sql [sql] - (let [log-file (get-log-file) - 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)] - (if 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 rows-limit - "Limit number of records to output." - (atom 1000)) - -(defn set-rows-limit [val] - "Set limit for number of records to output. When nil no limit." - (reset! rows-limit val)) - -(defn fmap [f m] - (reduce (fn [altered-map [k v]] (assoc altered-map k (f v))) {} m)) - -(defn rotate-table [data] - "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" - (let [first-row (first data) - keys (map #(if (keyword? %) (name %) (str %)) - (first first-row)) - values (rest first-row)] - (into [] (map - (fn [v] - (into {} - (map #(identity - [%1 (if (keyword? %2) (name %2) %2)]) - keys v))) - values)))) - -(defn print-table - "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 limit] - (when (seq rows) - (let [row-limit (or limit @rows-limit) - [rows msg] (if (and row-limit - (> row-limit 0) - (> (count rows) row-limit)) - [(take row-limit rows) - (format "Too many rows. Only %s from %s is shown.\n\n" - row-limit (count rows))] - [rows ""]) - [rows ks rotated] (if (and (= (count rows) 1) - (> (count (first rows)) 1)) - (let [r (rotate-table rows)] - [r (keys (first r)) true]) - [rows ks false]) - rows (map (fn [row] - (fmap (fn [v] - (if (string? v) - (clojure.string/replace v "\n" " ") - v)) - row)) - rows) - widths (map - (fn [k] - (apply max (count (name k)) (map #(count (str (get % k))) rows))) - ks) - headers (map name ks) - spacers (map #(apply str (repeat % "-")) widths) - ;; TODO: #(str "%" % "d") for numbers - fmts (map #(str "%-" % "s") widths) - fmt-row (fn [leader divider trailer row] - (str leader - (apply str (interpose divider - (for [[col fmt] (map vector (map #(get row %) ks) fmts)] - (format fmt (str col))))) - trailer)) - result (new StringBuffer "") - ;; TODO: cahnge to #(println %) when async output ready - out #(.append result (str % "\n"))] - (out (fmt-row "" " | " "" (zipmap ks headers))) - (if (not rotated) - (out (fmt-row "" "-+-" "" (zipmap ks spacers)))) - (doseq [row rows] - (out (fmt-row "" " | " "" row))) - (str msg (.toString result))))) - ([rows limit] (print-table (keys (first rows)) rows limit)) - ([rows] (print-table (keys (first rows)) rows @rows-limit))) - -(defn pretty-print [sql formatter] - (if (= formatter :jpa) - (print (.prettyPrint (SQLFormatter.) sql)) - ;; :hibernate - (print (.format (BasicFormatterImpl.) sql)))) - -(defn write-result-file [text & {:keys [append] - :or {append false}}] - (let [result-file-path (get-result-file-path)] - (spit result-file-path text :append append) - (s/replace result-file-path #"\\" "/"))) - -(defn clear-result-file [] - (write-result-file "")) diff --git a/elpa/ejc-sql-20181111.2343/src/ejc_sql/structure.clj b/elpa/ejc-sql-20181111.2343/src/ejc_sql/structure.clj deleted file mode 100644 index 4e47b6d9..00000000 --- a/elpa/ejc-sql-20181111.2343/src/ejc_sql/structure.clj +++ /dev/null @@ -1,513 +0,0 @@ -;;; structure.clj -- Receive database stucture and keep it in cache. - -;;; Copyright © 2016-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. */ - -(ns ejc-sql.structure - (:use [ejc-sql.lib]) - (:require - [clojure.java.jdbc :as j] - [clojure.string :as s] - [ejc-sql.connect :as c])) - -(def cache (atom {})) - -(defn- db->column [db sql] - "Execute `sql`, return first column of result set as result list." - (if sql - (rest - (map first - (j/query db (list sql) {:as-arrays? true}))))) - -(defn- db->>column [db sql] - "Execute `sql`, return last column of result set as result list." - (if sql - (rest - (map last - (j/query db (list sql) {:as-arrays? true}))))) - -(defn- db->value [db sql] - "Execute `sql`, return first value of first column of result set as result." - (first (db->column db sql))) - -(defn get-ms-sql-server-version [db] - (-> - (filter not-empty - (.split - (db->value db "SELECT @@VERSION AS 'SQL Server Version'") - " ")) - (nth 3) - Integer/parseInt)) - -(def default-queries - {:owners (fn [& _] - (str " SELECT schema_owner \n" - " FROM information_schema.schemata \n")) - :schemas (fn [& _] - (str " SELECT schema_name \n" - " FROM information_schema.schemata \n")) - :tables (fn [& {:keys [schema]}] - (str " SELECT table_name \n" - " FROM information_schema.tables \n" - (if schema - (str " WHERE table_schema = '" schema "'") - "") - " ORDER BY table_name \n")) - :all-tables (fn [& _] - (str "SELECT s.schema_owner, s.schema_name, t.table_name \n" - "FROM information_schema.schemata AS s, \n" - " information_schema.tables AS t \n" - "WHERE t.table_schema = s.schema_name \n")) - :columns (fn [& {:keys [table]}] - (str " SELECT column_name \n" - " FROM information_schema.columns \n" - " WHERE table_name = '" table "' \n" - " ORDER BY column_name \n"))}) - -(def queries - { - ;;-------- - :oracle - ;;-------- - {:entity (fn [& {:keys [entity-name]}] - (str " SELECT text \n" - " FROM all_source \n" - " WHERE UPPER(name) = '" - (s/upper-case entity-name) "' \n")) - :view (fn [& {:keys [entity-name]}] - (str "SELECT text \n" - "FROM all_views \n" - "WHERE UPPER(view_name) = '" - (s/upper-case entity-name) "' \n")) - :types (fn [& _] "SELECT * FROM USER_TYPES") - :owners (fn [& _] (str " SELECT DISTINCT(owner) \n" - " FROM ALL_OBJECTS \n" - " ORDER BY owner \n")) - :tables (fn [& {:keys [owner]}] - (str " SELECT table_name, owner \n" - " FROM all_tables \n" - (if owner - (str " WHERE UPPER(owner) = '" - (s/upper-case owner)"'")) - " ORDER BY table_name")) - :all-tables (fn [& _] - (str " SELECT owner, table_name \n" - " FROM all_tables \n" - " WHERE owner NOT IN ('SYS', 'SYSTEM') \n" - " ORDER BY owner")) - :columns (fn [& {:keys [table]}] - (str " SELECT column_name \n" - " FROM ALL_TAB_COLUMNS \n" - " WHERE UPPER(table_name) = '" - (s/upper-case table)"'")) - :constraints (fn [& {:keys [owner table]}] - (cond - (and owner table) - (str " SELECT * FROM all_constraints \n" - " WHERE owner = "owner" \n" - " AND table_name = '"table"' \n") - table - (str " SELECT * FROM all_constraints \n" - " WHERE table_name = '"table"' \n") - :else - "SELECT * FROM user_constraints")) - :procedures (fn [& {:keys [owner]}] - (str " SELECT object_name, procedure_name \n" - " FROM all_procedures \n" - (if owner - (str " WHERE owner = '" owner "'") - ""))) - :objects (fn [& _] - (str "SELECT * FROM all_objects WHERE object_type IN " - "('FUNCTION','PROCEDURE','PACKAGE')"))} - ;;-------- - :informix - ;;-------- - {:owners nil - :tables (fn [& _] - (str " SELECT TRIM(t.tabname) as tablesList \n" - " FROM systables AS t \n" - " WHERE t.tabtype = 'T' \n" - " AND t.tabid >= 100 \n" - " ORDER BY t.tabname; \n")) - :columns (fn [& {:keys [table]}] - (str " SELECT TRIM(c.colname) AS column_name \n" - " FROM systables AS t, syscolumns AS c \n" - " WHERE t.tabid = c.tabid \n" - " AND t.tabtype = 'T' \n" - " AND t.tabid >= 100 \n" - " AND TRIM(t.tabname) = '" table "' \n" - " ORDER BY c.colno; \n"))} - ;;------- - :mysql - ;;------- - {:owners (fn [& _] - (str " SELECT schema_name \n" - " FROM information_schema.schemata \n")) - :tables (default-queries :tables) - :all-tables (fn [& _] - (str "SELECT s.schema_name, t.table_name \n" - "FROM information_schema.schemata AS s, \n" - " information_schema.tables AS t \n" - "WHERE t.table_schema = s.schema_name \n")) - :columns (default-queries :columns)} - ;;-------- - :h2 - ;;-------- - {:tables (fn [& _] ((default-queries :tables) :schema "PUBLIC")) - :all-tables (fn [& _] - (str "SELECT s.schema_owner, s.schema_name, t.table_name \n" - "FROM information_schema.schemata AS s, \n" - " information_schema.tables AS t \n" - "WHERE t.table_schema = s.schema_name \n" - " AND LCASE(s.schema_name) != 'information_schema' \n")) - :columns (default-queries :columns)} - ;;------- - :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]}] - (str "SELECT type_desc AS constraint_type, \n" - " name \n" - "FROM sys.objects \n" - "WHERE type_desc LIKE '%CONSTRAINT' \n" - " AND OBJECT_NAME(parent_object_id)='" table "'")) - :entity (fn [& {:keys [db entity-name]}] - (if (> (get-ms-sql-server-version db) 2000) - (str - "SELECT definition \n" - "FROM sys.objects o \n" - "JOIN sys.sql_modules m ON m.object_id = o.object_id \n" - "WHERE o.object_id = object_id('" entity-name "') \n") - (str - "SELECT c.text \n" - "FROM sysobjects o \n" - "JOIN syscomments c ON c.id = o.id \n" - "WHERE o.name = '" entity-name "' \n")))} - ;;------- - :postgresql - ;;------- - {:owners (default-queries :owners) - :tables (default-queries :tables) - :all-tables (default-queries :all-tables) - :columns (default-queries :columns)}}) - -(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 - (second (.split - (let [props-list (.split connection-uri ";")] - (first - (filter - (fn [prop] - (= - "user" - (.toLowerCase (first (.split prop "="))))) - props-list))) "=")))))) - -(defn get-db-type [db] - (let [{:keys [subprotocol connection-uri dbtype]} db] - (keyword - (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))))))) - -(defn- get? [obj & [force?]] - (if (and obj (or force? (realized? obj))) - @obj)) - -(defn get-this-owner [db & [owner]] - "Return current owner/schema." - (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 (> (get-ms-sql-server-version db) 2000) - ;; 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 [db meta-type & - {:keys [owner - table - entity-name]}] - "Return SQL request to obtain some database structure info." - (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 - :entity-name entity-name - :db-name (get-db-name db)))] - sql)) - -(defn get-namespace [db] - "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`" - (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-owners [db & [force?]] - "Return owners list from cache if already received from DB, -check if receiveing process is not running, then start it." - (let [namespace (get-namespace db)] - (if namespace - (do - (if (not (get-in @cache [db namespace])) - (swap! cache assoc-in [db namespace] - (future ((fn [db] - (let [sql (select-db-meta-script - db namespace)] - (sort (db->column db sql)))) db)))) - (get? (get-in @cache [db namespace]) force?)) - (list)))) - -(defn get-tables [db & [owner_ force?]] - "Return tables list for this owner from cache if already received from DB, -check if receiveing process is not running, then start it." - (let [owner (get-this-owner db owner_)] - (if (not (get->in @cache [db :tables owner])) - (swap! cache assoc-in [db :tables owner] - (future ((fn [db owner] - (let [sql (select-db-meta-script db :tables - :owner owner)] - (db->column db sql))) - db owner)))) - (if owner_ - (get? (get->in @cache [db :tables owner]) force?) - (do (if (not (get-in @cache [db :all-tables])) - (swap! cache assoc-in [db :all-tables] - (future ((fn [db] - (let [sql (select-db-meta-script - db :all-tables)] - (sort (db->>column db sql)))) - db)))) - (get? (get-in @cache [db :all-tables]) force?))))) - -(defn get-colomns [db table force?] - "Return colomns list for this table from cache if already received from DB, -check if receiveing process is not running, then start it." - (if (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 (db->column db sql)))) - db table)))) - (get? (get->in @cache [db :colomns table]) - force?)) - -(defn is-owner? [db prefix] - (in? (get-owners db) prefix :case-sensitive false)) - -(defn get-owners-candidates [db sql prefix-1 & _] - "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." - (let [owners (get-owners db)] - (if prefix-1 - ;; Assume schema|table.# is not applicable. - ;; So, return empty list. - (list "nil") - (if owners - (cons "nil" owners) - ;; pending owners... - (list "t"))))) - -(defn get-tables-candidates [db sql prefix-1 & _] - "Return tables candidates autocomplete list." - (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 - (cons "nil" tables) - ;; pending tables... - (list "t")))) - -(defn match-alias? [sql owner table probable-alias] - "Check if prefix (`probable-alias`) is alias for `table` in this `sql`." - (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 [db] - "Get all tables for all owners/schemas." - (flatten - (mapv #(get-tables db % true) - (get-owners db true)))) - -(defn get-colomns-candidates [db sql prefix-1 & [prefix-2]] - "Return colomns candidates autocomplete list." - ;; Possible cases: - ;; 1. [owner|schema.]table.# - ;; 2. SELECT alias.# FROM [owner|schema.]table AS alias - ;; 3. SELECT complex-alias.# FROM (SELECT...) AS complex-alias - ;; - ;; In any case consider `prefix-1` as table or alias - ;; and optional `prefix-2` as owner or schema - (if (not prefix-1) - ;; TODO: cases for: - ;; INSERT INTO table (field1, #) values (123, 'text') - ;; UPDATE table SET field1 = 123, # = 'text' WHERE id = 1 - (list "nil") - (let [owner prefix-2 - tables-list (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)))] - (if (and tables-list - (not-empty (filter not-empty tables-list))) - (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 - (cons "nil" columns-list)) - (let [sql (c/clean-sql sql) - table-alias (first - (filter - (fn [table] - (match-alias? sql owner table prefix-1)) - tables-list))] - (if table-alias - ;; table-alias.# - (cons "nil" (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.# - (cons "nil" (mapv :name result)) - ;; Can't execute "blah blah" to get metadata in - ;; "SELECT t.# FROM (blah blah) AS t" case. - (list "nil"))) - ;; unknown?.# case - ;; nothing to complete - (list "nil")))))) - ;; no tables yet - ;; pending tables... - (list "t"))))) - -(defn get-cache [] - "Output actual cache." - @cache) - -(defn invalidate-cache [db] - "Clean your current connection cache (database owners and tables list)." - (swap! cache assoc-in [db] nil)) diff --git a/elpa/ejc-sql-20190121.1043/ejc-autocomplete.el b/elpa/ejc-sql-20190121.1043/ejc-autocomplete.el new file mode 100644 index 00000000..6b06177e --- /dev/null +++ b/elpa/ejc-sql-20190121.1043/ejc-autocomplete.el @@ -0,0 +1,203 @@ +;;; ejc-autocomplete.el -- SQL completitions at point (the part of ejc-sql). + +;;; Copyright © 2013-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: + +(require 'dash) +(require 'auto-complete) +(require 'ejc-lib) +(require 'ejc-interaction) +(require 'ejc-doc) +(require 'ejc-format) +(require 'ejc-flx) + +(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) + +(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)))) + +(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")) + +(defun ejc-not-nil-str (s) + (not (equal s "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 + ejc-db + (apply + 'buffer-substring + (ejc-get-sql-boundaries-at-point)) + prefix-1 + prefix-2)) + (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-colomns-candidates () + (ejc-candidates 'ejc-get-colomns-candidates)) + +(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-ansi-sql-words () + (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 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)) + +(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-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))) + +;;;###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-owners) + (add-to-list 'ac-sources 'ac-source-ejc-tables) + (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-20190121.1043/ejc-direx.el b/elpa/ejc-sql-20190121.1043/ejc-direx.el new file mode 100644 index 00000000..d59d201f --- /dev/null +++ b/elpa/ejc-sql-20190121.1043/ejc-direx.el @@ -0,0 +1,196 @@ +;;; 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) + ("colomn" . 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). + (let ((schemas (ejc-get-cached-owners-list ejc-db t))) + (-map #'schema-item schemas)))) + +(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-20190121.1043/ejc-doc.el b/elpa/ejc-sql-20190121.1043/ejc-doc.el new file mode 100644 index 00000000..7c99ab69 --- /dev/null +++ b/elpa/ejc-sql-20190121.1043/ejc-doc.el @@ -0,0 +1,75 @@ +;;; ejc-doc.el -- SQL quick hints documentation. + +;; Copyright © wikipedia.org +;; Creative Commons Attribution-ShareAlike license + +;;; Code: + +(require 'dash) + +(defconst ejc-sql-doc (make-hash-table :test 'eq)) + +(defun ejc-fill-doc (&rest args) + (-reduce (lambda (key val) + (puthash key val ejc-sql-doc)) + args)) + +(defvar ejc-doc-created-p nil) + +(defun ejc-create-doc () + (ejc-fill-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 + ;") + (setq ejc-doc-created-p t)) + +(provide 'ejc-doc) + +;;; ejc-doc.el ends here diff --git a/elpa/ejc-sql-20190121.1043/ejc-flx.el b/elpa/ejc-sql-20190121.1043/ejc-flx.el new file mode 100644 index 00000000..2bb98a38 --- /dev/null +++ b/elpa/ejc-sql-20190121.1043/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-20190121.1043/ejc-format.el b/elpa/ejc-sql-20190121.1043/ejc-format.el new file mode 100644 index 00000000..70b35c1f --- /dev/null +++ b/elpa/ejc-sql-20190121.1043/ejc-format.el @@ -0,0 +1,276 @@ +;;; 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) + +(defvar ejc-sql-separator "/" + "The char with purpose to separate the SQL statement both other.") + +(defun ejc-sql-separator-re () + (format "^\\s-*%s\\s-*" 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) + (forward-char) + (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) + (backward-char) + (end-of-buffer)) + (if (equal (string (preceding-char)) "\n") + (backward-char 1)) + (let ((sep-len (length ejc-sql-separator))) + (if (equal (buffer-substring (- (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) + (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) + (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))) + +(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 () + (interactive) + (ejc--in-sql-boundaries + beg end + (ejc-format-sql beg end))) + +(defun ejc-pretty-print-sql-at-point () + "Pretty-print SQL bounded by the `ejc-sql-separator' or/and buffer +boundaries." + (interactive) + (ejc--in-sql-boundaries + beg end + (let ((result (ejc-pretty-print (buffer-substring beg end) :hibernate))) + (delete-region beg end) + (insert result)))) + +(defun ejc-pretty-print-sql-region (beg end) + "Pretty-print SQL bounded by the selection area." + (interactive "r") + (let ((result (ejc-pretty-print (buffer-substring beg end) :hibernate))) + (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) + (interactive) + (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-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))) + +(provide 'ejc-format) + +;;; ejc-format.el ends here diff --git a/elpa/ejc-sql-20190121.1043/ejc-interaction.el b/elpa/ejc-sql-20190121.1043/ejc-interaction.el new file mode 100644 index 00000000..3f1fb529 --- /dev/null +++ b/elpa/ejc-sql-20190121.1043/ejc-interaction.el @@ -0,0 +1,244 @@ +;;; ejc-interaction.el -- ejc-sql interact with Clojure. -*- lexical-binding: t -*- + +;;; Copyright © 2013-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: + +(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 cemerick.pomegranate) + +(clomacs-defun ejc-require + clojure.core/require + :lib-name "ejc-sql") + +(clomacs-defun ejc-import + clojure.core/import + :lib-name "ejc-sql") + +(defun ejc-connect-to-db (conn-struct) + (ejc-require `'cemerick.pomegranate) + (ejc-add-classpath (alist-get :classpath conn-struct)) + (if-let ((classname (alist-get :classname conn-struct))) + (ejc-import (read classname))) + (ejc-sql-set-db conn-struct) + (setq-local ejc-connection-struct conn-struct)) + +(defun ejc-get-sql-from-string (sql) + (let* ((sql (replace-regexp-in-string ejc-clear-sql-regexp "" sql)) + (sql (replace-regexp-in-string "\"" "'" sql))) + sql)) + +(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--eval-sql-get-column + eval-sql-internal-get-column + :lib-name "ejc-sql" + :return-type :list + :namespace ejc-sql.connect + :doc "Get `sql', return list.") + +(defalias 'ejc--eval-get-list 'ejc--eval-sql-get-column) + +(clomacs-defun ejc-get-table-meta + ejc-sql.connect/get-table-meta + :lib-name "ejc-sql" + :namespace ejc-sql.connect) + +(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-pretty-print + pretty-print + :lib-name "ejc-sql" + :namespace ejc-sql.output + :return-value :stdout) + +(clomacs-defun ejc-set-rows-limit + set-rows-limit + :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-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-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-invalidate-cache-inner + invalidate-cache + :lib-name "ejc-sql" + :namespace ejc-sql.structure + :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 :boolean) + +(defun ejc-invalidate-cache () + "Clean current connection cache (database owners and tables list)." + (interactive) + (ejc-invalidate-cache-inner ejc-connection-struct)) + +(clomacs-defun ejc-get-cache + get-cache + :lib-name "ejc-sql" + :namespace ejc-sql.structure) + +(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) + +(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) + (sql-highlight-product) + (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-20190121.1043/ejc-lib.el b/elpa/ejc-sql-20190121.1043/ejc-lib.el new file mode 100644 index 00000000..845e66f0 --- /dev/null +++ b/elpa/ejc-sql-20190121.1043/ejc-lib.el @@ -0,0 +1,50 @@ +;;; ejc-lib.el -- ejc-sql shared objects (the part of ejc-sql). + +;;; Copyright © 2013-2016 - 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: + +(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-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) + +(provide 'ejc-lib) + +;;; ejc-lib.el ends here diff --git a/elpa/ejc-sql-20190121.1043/ejc-result-mode.el b/elpa/ejc-sql-20190121.1043/ejc-result-mode.el new file mode 100644 index 00000000..4aa05772 --- /dev/null +++ b/elpa/ejc-sql-20190121.1043/ejc-result-mode.el @@ -0,0 +1,42 @@ +;;; ejc-result-mode.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: + +(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))) + +(defun ejc-result-mode () + (interactive) + (kill-all-local-variables) + (setq view-read-only t) + (setq truncate-lines t) + (setq major-mode 'ejc-result-mode + mode-name "SQL-Result") + (setq font-lock-defaults '(ejc-result-font-lock-keywords))) + +(provide 'ejc-result-mode) + +;;; ejc-result-mode.el ends here diff --git a/elpa/ejc-sql-20190121.1043/ejc-sql-autoloads.el b/elpa/ejc-sql-20190121.1043/ejc-sql-autoloads.el new file mode 100644 index 00000000..7bab6a44 --- /dev/null +++ b/elpa/ejc-sql-20190121.1043/ejc-sql-autoloads.el @@ -0,0 +1,151 @@ +;;; ejc-sql-autoloads.el --- automatically extracted autoloads +;; +;;; 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-owners-candidates "ejc-autocomplete" "\ + + +\(fn)" nil nil) + +(autoload 'ejc-tables-candidates "ejc-autocomplete" "\ + + +\(fn)" nil nil) + +(autoload 'ejc-colomns-candidates "ejc-autocomplete" "\ + + +\(fn)" nil nil) + +(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# + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ejc-autocomplete" '("ejc-" "ac-"))) + +;;;*** + +;;;### (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" "\ + + +\(fn)" t nil) + +(autoload 'ejc-direx:switch-to-buffer "ejc-direx" "\ + + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ejc-direx" '("ejc-direx:" "direx"))) + +;;;*** + +;;;### (autoloads nil "ejc-doc" "ejc-doc.el" (0 0 0 0)) +;;; Generated autoloads from ejc-doc.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ejc-doc" '("ejc-"))) + +;;;*** + +;;;### (autoloads nil "ejc-flx" "ejc-flx.el" (0 0 0 0)) +;;; Generated autoloads from ejc-flx.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ejc-flx" '("ejc-"))) + +;;;*** + +;;;### (autoloads nil "ejc-format" "ejc-format.el" (0 0 0 0)) +;;; Generated autoloads from ejc-format.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ejc-format" '("ejc-"))) + +;;;*** + +;;;### (autoloads nil "ejc-interaction" "ejc-interaction.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from ejc-interaction.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ejc-interaction" '("ejc-"))) + +;;;*** + +;;;### (autoloads nil "ejc-lib" "ejc-lib.el" (0 0 0 0)) +;;; Generated autoloads from ejc-lib.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ejc-lib" '("ejc-"))) + +;;;*** + +;;;### (autoloads nil "ejc-result-mode" "ejc-result-mode.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from ejc-result-mode.el + +(if (fboundp 'register-definition-prefixes) (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. + +\(fn &optional ARG)" t nil) + +(autoload 'ejc-create-menu "ejc-sql" "\ + + +\(fn)" nil 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. + +\(fn)" t nil) + +(autoload 'ejc-version "ejc-sql" "\ +Get the ejc-sql version as string. + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (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-20190121.1043/ejc-sql-pkg.el b/elpa/ejc-sql-20190121.1043/ejc-sql-pkg.el new file mode 100644 index 00000000..bc818d77 --- /dev/null +++ b/elpa/ejc-sql-20190121.1043/ejc-sql-pkg.el @@ -0,0 +1,17 @@ +(define-package "ejc-sql" "20190121.1043" "Emacs SQL client uses Clojure JDBC." + '((emacs "25.1") + (clomacs "0.0.3") + (dash "2.12.1") + (auto-complete "1.5.1") + (spinner "1.7.1") + (direx "1.0.0")) + :keywords + '("sql" "jdbc") + :authors + '(("Kostafey" . "kostafey@gmail.com")) + :maintainer + '("Kostafey" . "kostafey@gmail.com") + :url "https://github.com/kostafey/ejc-sql") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/ejc-sql-20190121.1043/ejc-sql.el b/elpa/ejc-sql-20190121.1043/ejc-sql.el new file mode 100644 index 00000000..8b7a9a9c --- /dev/null +++ b/elpa/ejc-sql-20190121.1043/ejc-sql.el @@ -0,0 +1,703 @@ +;;; ejc-sql.el --- Emacs SQL client uses Clojure JDBC. -*- lexical-binding: t -*- + +;;; Copyright © 2012-2019 - Kostafey + +;; Author: Kostafey +;; URL: https://github.com/kostafey/ejc-sql +;; Keywords: sql, jdbc +;; Version: 0.0.1 +;; Package-Requires: ((emacs "25.1")(clomacs "0.0.3")(dash "2.12.1")(auto-complete "1.5.1")(spinner "1.7.1")(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 'ejc-lib) +(require 'ejc-direx) +(require 'ejc-format) +(require 'ejc-interaction) +(require 'ejc-result-mode) +(require 'ejc-autocomplete) + +(defvar-local ejc-db nil + "JDBC connection info for current SQL buffer.") + +(defvar ejc-connections nil + "List of existing configured jdbc connections") + +(defvar ejc-results-buffer nil + "The results buffer.") + +(defvar ejc-results-buffer-name "*ejc-sql-output*" + "The results buffer name.") + +(defvar ejc-result-file-path nil + "The results file path. Refreshed by any finished SQL evaluation.") + +(defvar ejc-current-buffer-query nil + "Current SQL edit buffer lanched query.") + +(defvar ejc-temp-editor-buffer-name "*ejc-sql-editor*" + "The buffer for conveniently edit ad-hoc SQL scripts.") + +(defvar ejc-temp-editor-file (expand-file-name "~/tmp/ejc-sql-editor.sql")) + +(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-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) + +(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-h t") 'ejc-describe-table) +(define-key ejc-sql-mode-keymap (kbd "C-h T") '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) + +(defvar ejc-command-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "") #'ejc-show-last-result) + (define-key map (kbd "t") #'ejc-show-tables-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 "p") #'ejc-pretty-print-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-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)))) + (run-hooks 'ejc-sql-minor-mode-hook)) + +;;;###autoload +(define-minor-mode ejc-sql-mode + "Toggle ejc-sql mode." + :lighter " ejc" + :keymap ejc-sql-mode-keymap + :group 'ejc + :global nil + ;; :after-hook (ejc-create-menu) + (if ejc-sql-mode + (progn + (ejc-ac-setup) + (ejc-create-menu) + (ejc-refresh-font-lock)) + (progn + ;; (global-unset-key [menu-bar ejc-menu]) + (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 + classpath + separator + ;; ---------- + ;; 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 :classpath (file-truename classpath)) + (cons :separator separator) + (cons :classname classname))) + new-connection)) + ejc-connections))) + +(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)) + +(defvar ejc-product-assoc + '((sqlserver . ms) + (oracle:sid . oracle))) + +(defun ejc-configure-sql-buffer (product-name) + (unless (or (derived-mode-p 'org-mode) (org-src-edit-buffer-p)) + (sql-mode)) + (sql-set-product (or (cdr (assoc-string product-name ejc-product-assoc)) + (car (assoc-string product-name sql-product-alist)) + "ansi")) + (auto-complete-mode t) + (auto-fill-mode t) + (unless (derived-mode-p 'org-mode) + (ejc-sql-mode t))) + +(defun ejc-load-conn-statistics () + "Load connection usage statistics to `ejc-conn-statistics' var." + (condition-case nil + (let ((dir (file-name-directory ejc-conn-statistics-file))) + (if (not (file-accessible-directory-p dir)) + (make-directory dir)) + (load-file ejc-conn-statistics-file)) + (error + (with-temp-file ejc-conn-statistics-file + (insert "(setq ejc-conn-statistics (list))")) + (load-file ejc-conn-statistics-file))) + ejc-conn-statistics) + +(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)))) + (with-temp-file ejc-conn-statistics-file + (insert "(setq ejc-conn-statistics '") + (prin1 ejc-conn-statistics (current-buffer)) + (insert ")"))) + +(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))) + +(defun ejc-add-connection (product-name connection-name db) + "Add ejc connection information to current buffer. +Prepare buffer to operate as `ejc-sql-mode' buffer." + (ejc-configure-sql-buffer product-name) + (setq-local ejc-connection-name connection-name) + (setq-local ejc-db db) + (ejc-set-mode-name connection-name)) + +(defun ejc-get-result-file-path () + (or ejc-result-file-path + (setq ejc-result-file-path + (ejc--get-result-file-path)))) + +(defun ejc-eval-org-snippet (body params) + "Used to eval SQL code in `org-mode' code snippets." + (let* ((beg (save-excursion + (goto-char (nth 5 (org-babel-get-src-block-info))) + (end-of-line) + (right-char 1) + (point))) + (end (save-excursion + (goto-char beg) + (+ beg (length body) (skip-chars-forward "\t "))))) + (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-get-product-name (db) + (or (alist-get :subprotocol db) + (alist-get :dbtype db))) + +(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) + (product-name (ejc-get-product-name db))) + (apply orig-fun args) + (ejc-add-connection product-name connection-name db)) + (apply orig-fun args))) + +;;;###autoload +(defun ejc-connect (connection-name) + "Connect to selected db." + (interactive + (list + (ido-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))))) + (let* ((db (cdr (ejc-find-connection connection-name))) + (product-name (ejc-get-product-name db))) + (ejc-update-conn-statistics connection-name) + (ejc-configure-sql-buffer product-name) + (when (derived-mode-p 'org-mode) + (defalias 'org-babel-execute:sql 'ejc-eval-org-snippet) + (advice-add 'org-edit-special :around #'ejc-org-edit-special)) + (setq-local ejc-connection-name connection-name) + (setq-local ejc-db db) + (message "Connection started...") + (ejc-connect-to-db db) + (when (ejc-validate-connection :db ejc-db + :timeout ejc-connection-validate-timeout) + (ejc-set-mode-name connection-name) + (message "Connected.")))) + +;;;###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-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)))) + +(defun ejc-get-prompt-symbol-under-point (msg) + (let ((sql-symbol (if mark-active + (buffer-substring (mark) (point)) + (ejc-get-word-at-point (point)))) + (enable-recursive-minibuffers t) + val) + (setq val (completing-read + (if sql-symbol + (format "%s (default %s): " msg sql-symbol) + (format "%s: " msg)) + obarray)) + (list (if (equal val "") + sql-symbol + val)))) + +(defun ejc-check-connection () + (unless (ejc-buffer-connected-p) + (error "Run M-x ejc-connect first!"))) + +(cl-defun ejc-eval-sql-and-log (db + sql + &key + start-time + rows-limit + append + sync + display-result) + (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 + db + prepared-sql + :start-time start-time + :rows-limit rows-limit + :append append + :sync sync + :display-result display-result)))) + +(defun ejc-message-query-done (start-time result) + (message + "%s SQL query at %s. Exec time %.03f" + (case result + (: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." + (with-current-buffer ejc-current-buffer-query + (spinner-stop))) + +(cl-defun ejc-complete-query (result-file-path + &key + start-time + result + display-result) + (if result-file-path + (setq ejc-result-file-path result-file-path)) + (ejc-spinner-stop) + (if display-result + (ejc-show-last-result)) + (if (and start-time result) + (ejc-message-query-done start-time result)) + 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) + (if (and (clomacs-get-connection "ejc-sql") + (ejc--is-query-running-p)) + (let ((start-time (ejc--cancel-query))) + (ejc-spinner-stop) + (ejc-message-query-done start-time :terminated)) + (keyboard-quit))) + +(defun ejc-describe-table (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) + (let* ((owner (car (split-string table-name "\\."))) + (table (cadr (split-string table-name "\\.")))) + (when (not table) + (setq table owner) + (setq owner nil)) + (ejc-get-table-meta ejc-db table-name) + (let ((sql (ejc-select-db-meta-script ejc-db :constraints + :owner owner + :table table))) + (when (ejc-not-nil-str sql) + (ejc-write-result-file (concat "\n" + "Constraints:\n" + "------------\n") + :append t) + (ejc-eval-sql-and-log ejc-db sql :append t))))) + +(defun ejc-describe-entity (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-show-last-result + (let ((entity-result + ;; Try to get entity source code. + (ejc-eval-sql-and-log + ejc-db + (ejc-select-db-meta-script ejc-db :entity + :entity-name entity-name)))) + (if (not (equal entity-result "nil")) + ;; Show entity text. + ;; Assume there is no entity and view with the same names. + entity-result + ;; No entity with such name. + ;; Try to get view source code. + (ejc-eval-sql-and-log + ejc-db + (ejc-select-db-meta-script ejc-db :view + :entity-name entity-name)))))) + +(cl-defun ejc-eval-user-sql (sql &key rows-limit sync display-result) + "Evaluate SQL by user: reload and show query results buffer, update log." + (message "Processing SQL query...") + (ejc-eval-sql-and-log ejc-db + sql + :rows-limit rows-limit + :start-time (current-time) + :sync sync + :display-result display-result)) + +(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))) + +(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)) + +(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 + :display-result t)) + +(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))) + +(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))) + +(defun ejc-show-procedures-list (&optional owner) + "Output procedures list." + (interactive) + (ejc-eval-user-sql (ejc-select-db-meta-script ejc-db :procedures + :owner owner))) + +;;----------------------------------------------------------------------------- +;; results buffer +;; +(defun ejc-create-output-buffer () + (set-buffer (get-buffer-create ejc-results-buffer-name)) + (setq ejc-results-buffer (current-buffer)) + (ejc-result-mode) + ejc-results-buffer) + +(defun ejc-get-buffer-or-create (buffer-or-name create-buffer-fn) + "Return buffer passed in `buffer-or-name' parameter. +If this buffer is not exists or it was killed - create buffer via +`create-buffer-fn' function (this function must return buffer)." + (let ((buf (if (bufferp buffer-or-name) + buffer-or-name + (get-buffer buffer-or-name)))) + (if (and buf (buffer-live-p buf)) + buf + (apply create-buffer-fn nil)))) + +(defun ejc-get-output-buffer () + (if (and ejc-results-buffer (buffer-live-p ejc-results-buffer)) + ejc-results-buffer + (ejc-create-output-buffer))) + +(cl-defun ejc-show-last-result (&optional result) + "Popup buffer with last SQL execution result output." + (interactive) + (let ((output-buffer (ejc-get-output-buffer)) + (old-split split-width-threshold)) + (set-buffer output-buffer) + (read-only-mode -1) + (erase-buffer) + (if result + (insert result) + (insert-file-contents (ejc-get-result-file-path))) + (read-only-mode 1) + (beginning-of-buffer) + (setq split-width-threshold nil) + (display-buffer output-buffer) + (setq split-width-threshold old-split))) + +(defun ejc-switch-to-sql-editor-buffer () + "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." + (interactive) + (if (get-buffer ejc-temp-editor-buffer-name) + (switch-to-buffer ejc-temp-editor-buffer-name) + (progn + (unless (file-exists-p + (file-name-directory ejc-temp-editor-file)) + (make-directory (file-name-directory ejc-temp-editor-file) t)) + (find-file ejc-temp-editor-file) + (rename-buffer ejc-temp-editor-buffer-name) + (ejc-configure-sql-buffer "ansi")))) + +(defun ejc-open-log () + (interactive) + (find-file-read-only (ejc-get-log-file-path)) + (end-of-buffer)) + +;;;###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-20190121.1043/project.clj b/elpa/ejc-sql-20190121.1043/project.clj new file mode 100644 index 00000000..b2115745 --- /dev/null +++ b/elpa/ejc-sql-20190121.1043/project.clj @@ -0,0 +1,14 @@ +(defproject ejc-sql "0.0.1-SNAPSHOT" + :description "Interact with database via java/clojure libs to run SQL/JPQL 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/clojure-contrib "1.2.0"] + [org.clojars.kostafey/java.jdbc "0.7.9-SNAPSHOT"] + [org.apache.openjpa/openjpa-all "2.2.2"] + [org.hibernate/hibernate-core "5.2.3.Final"] + [com.cemerick/pomegranate "0.3.0"] + [org.apache.commons/commons-lang3 "3.2.1"] + [org.apache.httpcomponents/httpclient "4.5.5"] + [clomacs "0.0.3-SNAPSHOT"]]) diff --git a/elpa/ejc-sql-20190121.1043/snippets/sql-mode/begin.snippet b/elpa/ejc-sql-20190121.1043/snippets/sql-mode/begin.snippet new file mode 100644 index 00000000..346dff8b --- /dev/null +++ b/elpa/ejc-sql-20190121.1043/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-20190121.1043/snippets/sql-mode/delete.yasnippet b/elpa/ejc-sql-20190121.1043/snippets/sql-mode/delete.yasnippet new file mode 100644 index 00000000..27cc2af9 --- /dev/null +++ b/elpa/ejc-sql-20190121.1043/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-20190121.1043/snippets/sql-mode/insert.yasnippet b/elpa/ejc-sql-20190121.1043/snippets/sql-mode/insert.yasnippet new file mode 100644 index 00000000..b38c3ebb --- /dev/null +++ b/elpa/ejc-sql-20190121.1043/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-20190121.1043/snippets/sql-mode/select.yasnippet b/elpa/ejc-sql-20190121.1043/snippets/sql-mode/select.yasnippet new file mode 100644 index 00000000..4e5fe935 --- /dev/null +++ b/elpa/ejc-sql-20190121.1043/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-20190121.1043/snippets/sql-mode/update.yasnippet b/elpa/ejc-sql-20190121.1043/snippets/sql-mode/update.yasnippet new file mode 100644 index 00000000..5f15e73f --- /dev/null +++ b/elpa/ejc-sql-20190121.1043/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-20190121.1043/snippets/sql-mode/where.yasnippet b/elpa/ejc-sql-20190121.1043/snippets/sql-mode/where.yasnippet new file mode 100644 index 00000000..13d87f2f --- /dev/null +++ b/elpa/ejc-sql-20190121.1043/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-20190121.1043/src/ejc_sql/connect.clj b/elpa/ejc-sql-20190121.1043/src/ejc_sql/connect.clj new file mode 100644 index 00000000..e8ba755e --- /dev/null +++ b/elpa/ejc-sql-20190121.1043/src/ejc_sql/connect.clj @@ -0,0 +1,285 @@ +;;; connect.clj -- Core clojure functions for ejc-sql emacs extension. + +;;; Copyright © 2013-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. */ + +(ns ejc-sql.connect + (:use [clojure.java.io] + [ejc-sql.lib] + [clomacs]) + (:require [clojure.java.jdbc :as j] + [clojure.contrib.java-utils] + [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 clean-sql [sql] + (-> sql + (s/replace #"(--).*\n" "") + (s/replace #"( )|( \t)|\t" " ") + (s/replace "^\n" "") + trim)) + +(def dml-set + #{"SELECT" + "INSERT" + "UPDATE" + "DELETE"}) + +(def ignore-set #{\( \[}) + +(defn determine-dml [sql] + "Determine if current SQL is Data Manipulation Language (DML) case." + (let [sql (clean-sql sql) + pos (loop [pos 0] + (if (ignore-set (get sql pos)) + (recur (inc pos)) + pos))] + (or + (dml-set (.toUpperCase (subs sql pos (+ 6 pos)))) + (#{"SHOW"} (.toUpperCase (subs sql pos (+ 4 pos))))))) + +(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 clob-to-string [clob] + "Turn an Oracle Clob into a String" + (with-open [rdr (java.io.BufferedReader. (.getCharacterStream clob))] + (apply str (line-seq rdr)))) + +(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-row [row] + "Check all data in row if it's a CLOB and convert CLOB to string." + (loop [acc {} + rest-keys (keys row)] + (if rest-keys + (let [k (first rest-keys) + v (row k)] + (recur (assoc acc k (if (is-clob? v) + (clob-to-string v) + v)) + (next rest-keys))) + acc))) + +(defn is-query-running? [] + (let [stmt (:stmt @current-query)] + (and (not (nil? stmt)) + (not (.isClosed stmt))))) + +(defn cancel-query [] + "Terminate current (long) running query. Aimed to cancel SELECT queries. +Unsafe for INSERT/UPDATE/CREATE/ALTER queries." + (future + (if (is-query-running?) + (let [conn (:conn @current-query) + runner (:runner @current-query)] + (try + (.rollback conn) + (finally + (.close conn))) + (if (and + (not (nil? runner)) + (not (future-done? runner)) + (not (future-cancelled? runner))) + (future-cancel runner))))) + (:start-time @current-query)) + +(defn validate-connection [& {:keys [db timeout] + :or {db @ejc-sql.connect/db + timeout 5}}] + (.isValid (j/get-connection db) timeout)) + +(defn get-separator-re [separator] + "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%'" + (String/format + "%s(? result rest flatten) + result))) + +(defn query-meta [db sql] + "Get metadata for `sql` result dataset." + (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))) + +(defn get-table-meta + "Describe table." + [db table-name] + (let [result-map (table-meta db table-name) + success (:success result-map) + result-data (:result result-map) + head (str "Table \"" table-name "\" description:\n") + head-length (dec (.length head))] + (complete-query + (o/write-result-file + (if success + (str head + (ejc-sql.lib/simple-join head-length "-") "\n" + (o/print-table result-data)) + result-data)) + :display-result true))) diff --git a/elpa/ejc-sql-20190121.1043/src/ejc_sql/jpa.clj b/elpa/ejc-sql-20190121.1043/src/ejc_sql/jpa.clj new file mode 100644 index 00000000..f7ce3eba --- /dev/null +++ b/elpa/ejc-sql-20190121.1043/src/ejc_sql/jpa.clj @@ -0,0 +1,48 @@ +(ns ejc-sql.jpa + (:require [cemerick.pomegranate :as pom]) + (:use [clojure.java.io] + [ejc-sql.lib] + [ejc-sql.output]) + (:import [javax.persistence Persistence + EntityManager + TypedQuery] + [org.apache.commons.lang3.builder + ReflectionToStringBuilder + ToStringStyle])) + +(def em) + +(defn connect [{:keys [connection-name + persistent-xml-url + domain-objects-url + jdbc-driver-url]}] + (pom/add-classpath persistent-xml-url) + (pom/add-classpath domain-objects-url) + (pom/add-classpath jdbc-driver-url) + (def em (-> (Persistence/createEntityManagerFactory connection-name) + (.createEntityManager)))) + +(defn connect-plain [connection-name + persistent-xml-url + domain-objects-url + jdbc-driver-url] + (connect + {:connection-name connection-name + :persistent-xml-url persistent-xml-url + :domain-objects-url domain-objects-url + :jdbc-driver-url jdbc-driver-url})) + +(defn eval-jpql [jpql] + (-> em (.createQuery jpql) (.getResultList) (.toArray))) + +(defn row-to-str [row] + (if (not (array? row)) + (ReflectionToStringBuilder/toString + row ToStringStyle/SHORT_PREFIX_STYLE) + (list (str row)))) + +(defn eval-jpql-print [jpql] + (print + (format-output (map row-to-str (eval-jpql jpql)) + :as-arrays? true, :add-headers? false))) + diff --git a/elpa/ejc-sql-20190121.1043/src/ejc_sql/lib.clj b/elpa/ejc-sql-20190121.1043/src/ejc_sql/lib.clj new file mode 100644 index 00000000..d0cd8dbb --- /dev/null +++ b/elpa/ejc-sql-20190121.1043/src/ejc_sql/lib.clj @@ -0,0 +1,91 @@ +;;; lib.clj -- Misc clojure functions for ejc-sql emacs extension. + +;;; Copyright © 2013-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. */ + +(ns ejc-sql.lib + (:import (java.io File)) + (:require [clojure.string :as s] + [clojure.reflect :refer [resolve-class]])) + +(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}}] + (if (and elm seq) + (if (not case-sensitive) + (in? (mapv s/lower-case seq) (s/lower-case elm)) + (some #(= elm %) seq)))) + +(defn get->in [obj path & {:keys [case-sensitive] :or {case-sensitive false}}] + "Case insensitive `get-in` for last key in sequence." + (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 array? [x] + (-> x .getClass .isArray)) + +(defn trim [s] + (if (instance? java.lang.String s) + (.trim s) + s)) + +(defn filter-data [rs] + (map #(map trim %) rs)) + +(defn get-rs-data [rs] + (map vals rs)) + +(defn get-rs-headers [rs] + (for [[k _] (first rs)] + (subs (str k) 1))) + +(defn transpose [m] + (apply mapv vector m)) + +(defn find-longest-list + "Returns the list of the longest lengths per column." + [lst] + (map #(apply max %) (transpose lst))) + +(defn simple-join [n s] + (clojure.string/join + (for [x (range 0 n)] s))) + +(defn str-length [s] + (.length (str s))) + +(defn get-rs-lengths [rs] + (map #(map str-length %) rs)) + +(defn get-absolute-file-path [relative-file-path] + (-> (java.io.File. relative-file-path) .getAbsolutePath)) + +(defn class-exists? [c] + (resolve-class (.getContextClassLoader (Thread/currentThread)) c)) diff --git a/elpa/ejc-sql-20190121.1043/src/ejc_sql/output.clj b/elpa/ejc-sql-20190121.1043/src/ejc_sql/output.clj new file mode 100644 index 00000000..1ade3ae4 --- /dev/null +++ b/elpa/ejc-sql-20190121.1043/src/ejc_sql/output.clj @@ -0,0 +1,170 @@ +;;; output.clj -- Output & formatting clojure functions for ejc-sql. + +;;; Copyright © 2013, 2016 - 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.contrib.java-utils + [clojure.string :as s]) + (:import (java.io File) + (java.lang.reflect Method) + (java.util.Date) + (java.text.SimpleDateFormat) + (org.apache.openjpa.lib.jdbc SQLFormatter) + (org.hibernate.engine.jdbc.internal BasicFormatterImpl))) + +(def result-file-name + "SQL evaluation results file name." + "ejc-sql-result.txt") + +(defn get-result-file-path [] + (s/replace + (.getAbsolutePath + (File. + (File. (System/getProperty "java.io.tmpdir")) + result-file-name)) + #"\\" "/")) + +(defn get-log-dir [] + (file (if windows? + (System/getenv "AppData") + "/var/log/") + "ejc-sql")) + +(defn get-log-file [] + (file (get-log-dir) + (str (.format (new java.text.SimpleDateFormat + "yyyy-MM-dd") + (new java.util.Date)) ".log"))) + +(defn print-log-file-path [] + (print (.getAbsolutePath (get-log-file)))) + +(defn log-sql [sql] + (let [log-file (get-log-file) + 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)] + (if 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 rows-limit + "Limit number of records to output." + (atom 1000)) + +(defn set-rows-limit [val] + "Set limit for number of records to output. When nil no limit." + (reset! rows-limit val)) + +(defn fmap [f m] + (reduce (fn [altered-map [k v]] (assoc altered-map k (f v))) {} m)) + +(defn rotate-table [data] + "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" + (let [first-row (first data) + keys (map #(if (keyword? %) (name %) (str %)) + (first first-row)) + values (rest first-row)] + (into [] (map + (fn [v] + (into {} + (map #(identity + [%1 (if (keyword? %2) (name %2) %2)]) + keys v))) + values)))) + +(defn print-table + "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 limit] + (when (seq rows) + (let [row-limit (or limit @rows-limit) + [rows msg] (if (and row-limit + (> row-limit 0) + (> (count rows) row-limit)) + [(take row-limit rows) + (format "Too many rows. Only %s from %s is shown.\n\n" + row-limit (count rows))] + [rows ""]) + [rows ks rotated] (if (and (= (count rows) 1) + (> (count (first rows)) 1)) + (let [r (rotate-table rows)] + [r (keys (first r)) true]) + [rows ks false]) + rows (map (fn [row] + (fmap (fn [v] + (if (string? v) + (clojure.string/replace v "\n" " ") + v)) + row)) + rows) + widths (map + (fn [k] + (apply max (count (name k)) (map #(count (str (get % k))) rows))) + ks) + headers (map name ks) + spacers (map #(apply str (repeat % "-")) widths) + ;; TODO: #(str "%" % "d") for numbers + fmts (map #(str "%-" % "s") widths) + fmt-row (fn [leader divider trailer row] + (str leader + (apply str (interpose divider + (for [[col fmt] (map vector (map #(get row %) ks) fmts)] + (format fmt (str col))))) + trailer)) + result (new StringBuffer "") + ;; TODO: cahnge to #(println %) when async output ready + out #(.append result (str % "\n"))] + (out (fmt-row "" " | " "" (zipmap ks headers))) + (if (not rotated) + (out (fmt-row "" "-+-" "" (zipmap ks spacers)))) + (doseq [row rows] + (out (fmt-row "" " | " "" row))) + (str msg (.toString result))))) + ([rows limit] (print-table (keys (first rows)) rows limit)) + ([rows] (print-table (keys (first rows)) rows @rows-limit))) + +(defn pretty-print [sql formatter] + (if (= formatter :jpa) + (print (.prettyPrint (SQLFormatter.) sql)) + ;; :hibernate + (print (.format (BasicFormatterImpl.) sql)))) + +(defn write-result-file [text & {:keys [append] + :or {append false}}] + (let [result-file-path (get-result-file-path)] + (spit result-file-path text :append append) + result-file-path)) + +(defn clear-result-file [] + (write-result-file "")) diff --git a/elpa/ejc-sql-20190121.1043/src/ejc_sql/structure.clj b/elpa/ejc-sql-20190121.1043/src/ejc_sql/structure.clj new file mode 100644 index 00000000..79f7c512 --- /dev/null +++ b/elpa/ejc-sql-20190121.1043/src/ejc_sql/structure.clj @@ -0,0 +1,556 @@ +;;; 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]) + (:require + [clojure.java.jdbc :as j] + [clojure.string :as s] + [ejc-sql.connect :as c])) + +(def cache (atom {})) + +(defn- db->column [db sql] + "Execute `sql`, return first column of result set as result list." + (if sql + (rest + (map first + (j/query db (list sql) {:as-arrays? true}))))) + +(defn- db->>column [db sql] + "Execute `sql`, return last column of result set as result list." + (if sql + (rest + (map last + (j/query db (list sql) {:as-arrays? true}))))) + +(defn- db->value [db sql] + "Execute `sql`, return first value of first column of result set as result." + (first (db->column db sql))) + +(defn get-ms-sql-server-version [db] + (-> + (filter not-empty + (.split + (db->value db "SELECT @@VERSION AS 'SQL Server Version'") + " ")) + (nth 3) + Integer/parseInt)) + +(def default-queries + {:owners (fn [& _] + (str " SELECT schema_owner \n" + " FROM information_schema.schemata \n")) + :schemas (fn [& _] + (str " SELECT schema_name \n" + " FROM information_schema.schemata \n")) + :tables (fn [& {:keys [schema]}] + (str " SELECT table_name \n" + " FROM information_schema.tables \n" + (if schema + (str " WHERE table_schema = '" schema "'") + "") + " ORDER BY table_name \n")) + :all-tables (fn [& _] + (str "SELECT s.schema_owner, s.schema_name, t.table_name \n" + "FROM information_schema.schemata AS s, \n" + " information_schema.tables AS t \n" + "WHERE t.table_schema = s.schema_name \n")) + :columns (fn [& {:keys [table]}] + (str " SELECT column_name \n" + " FROM information_schema.columns \n" + " WHERE table_name = '" table "' \n" + " ORDER BY column_name \n"))}) + +(def queries + { + ;;-------- + :oracle + ;;-------- + {:entity (fn [& {:keys [entity-name]}] + (str " SELECT text \n" + " FROM all_source \n" + " WHERE UPPER(name) = '" + (s/upper-case entity-name) "' \n")) + :view (fn [& {:keys [entity-name]}] + (str "SELECT text \n" + "FROM all_views \n" + "WHERE UPPER(view_name) = '" + (s/upper-case entity-name) "' \n")) + :types (fn [& _] "SELECT * FROM USER_TYPES") + :owners (fn [& _] (str " SELECT DISTINCT(owner) \n" + " FROM ALL_OBJECTS \n" + " ORDER BY owner \n")) + :tables (fn [& {:keys [owner]}] + (str " SELECT table_name, owner \n" + " FROM all_tables \n" + (if owner + (str " WHERE UPPER(owner) = '" + (s/upper-case owner)"'")) + " ORDER BY table_name")) + :all-tables (fn [& _] + (str " SELECT owner, table_name \n" + " FROM all_tables \n" + " WHERE owner NOT IN ('SYS', 'SYSTEM') \n" + " ORDER BY owner")) + :columns (fn [& {:keys [table]}] + (str " SELECT column_name \n" + " FROM ALL_TAB_COLUMNS \n" + " WHERE UPPER(table_name) = '" + (s/upper-case table)"'")) + :constraints (fn [& {:keys [owner table]}] + (cond + (and owner table) + (str " SELECT * FROM all_constraints \n" + " WHERE owner = "owner" \n" + " AND table_name = '"table"' \n") + table + (str " SELECT * FROM all_constraints \n" + " WHERE table_name = '"table"' \n") + :else + "SELECT * FROM user_constraints")) + :procedures (fn [& {:keys [owner]}] + (str " SELECT object_name, procedure_name \n" + " FROM all_procedures \n" + (if owner + (str " WHERE owner = '" owner "'") + ""))) + :objects (fn [& _] + (str "SELECT * FROM all_objects WHERE object_type IN " + "('FUNCTION','PROCEDURE','PACKAGE')"))} + ;;-------- + :informix + ;;-------- + {:owners nil + :tables (fn [& _] + (str " SELECT TRIM(t.tabname) as tablesList \n" + " FROM systables AS t \n" + " WHERE t.tabtype = 'T' \n" + " AND t.tabid >= 100 \n" + " ORDER BY t.tabname; \n")) + :columns (fn [& {:keys [table]}] + (str " SELECT TRIM(c.colname) AS column_name \n" + " FROM systables AS t, syscolumns AS c \n" + " WHERE t.tabid = c.tabid \n" + " AND t.tabtype = 'T' \n" + " AND t.tabid >= 100 \n" + " AND TRIM(t.tabname) = '" table "' \n" + " ORDER BY c.colno; \n"))} + ;;------- + :mysql + ;;------- + {:owners (fn [& _] + (str " SELECT schema_name \n" + " FROM information_schema.schemata \n")) + :tables (default-queries :tables) + :all-tables (fn [& _] + (str "SELECT s.schema_name, t.table_name \n" + "FROM information_schema.schemata AS s, \n" + " information_schema.tables AS t \n" + "WHERE t.table_schema = s.schema_name \n")) + :columns (default-queries :columns)} + ;;-------- + :h2 + ;;-------- + {:tables (fn [& _] ((default-queries :tables) :schema "PUBLIC")) + :all-tables (fn [& _] + (str "SELECT s.schema_owner, s.schema_name, t.table_name \n" + "FROM information_schema.schemata AS s, \n" + " information_schema.tables AS t \n" + "WHERE t.table_schema = s.schema_name \n" + " AND LCASE(s.schema_name) != 'information_schema' \n")) + :columns (default-queries :columns)} + ;;------- + :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]}] + (str "SELECT type_desc AS constraint_type, \n" + " name \n" + "FROM sys.objects \n" + "WHERE type_desc LIKE '%CONSTRAINT' \n" + " AND OBJECT_NAME(parent_object_id)='" table "'")) + :entity (fn [& {:keys [db entity-name]}] + (if (> (get-ms-sql-server-version db) 2000) + (str + "SELECT definition \n" + "FROM sys.objects o \n" + "JOIN sys.sql_modules m ON m.object_id = o.object_id \n" + "WHERE o.object_id = object_id('" entity-name "') \n") + (str + "SELECT c.text \n" + "FROM sysobjects o \n" + "JOIN syscomments c ON c.id = o.id \n" + "WHERE o.name = '" entity-name "' \n")))} + ;;------- + :postgresql + ;;------- + {:owners (default-queries :owners) + :tables (default-queries :tables) + :all-tables (default-queries :all-tables) + :columns (default-queries :columns)}}) + +(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 + (second (.split + (let [props-list (.split connection-uri ";")] + (first + (filter + (fn [prop] + (= + "user" + (.toLowerCase (first (.split prop "="))))) + props-list))) "=")))))) + +(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?]] + (if (and obj (or force? (realized? obj))) + @obj)) + +(defn get-this-owner [db & [owner]] + "Return current owner/schema." + (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 (> (get-ms-sql-server-version db) 2000) + ;; 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 [db meta-type & + {:keys [owner + table + entity-name]}] + "Return SQL request to obtain some database structure info." + (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 + :entity-name entity-name + :db-name (get-db-name db)))] + sql)) + +(defn get-namespace [db] + "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`" + (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-owners [db & [force?]] + "Return owners list from cache if already received from DB, +check if receiveing process is not running, then start it." + (let [namespace (get-namespace db)] + (if namespace + (do + (if (not (get-in @cache [db namespace])) + (swap! cache assoc-in [db namespace] + (future ((fn [db] + (let [sql (select-db-meta-script + db namespace)] + (sort (db->column db sql)))) db)))) + (get? (get-in @cache [db namespace]) force?)) + (list)))) + +(defn get-tables [db & [owner_ force?]] + "Return tables list for this owner from cache if already received from DB, +check if receiveing process is not running, then start it." + (let [owner (get-this-owner db owner_)] + (if (not (get->in @cache [db :tables owner])) + (swap! cache assoc-in [db :tables owner] + (future ((fn [db owner] + (let [sql (select-db-meta-script db :tables + :owner owner)] + (db->column db sql))) + db owner)))) + (if owner_ + (get? (get->in @cache [db :tables owner]) force?) + (do (if (not (get-in @cache [db :all-tables])) + (swap! cache assoc-in [db :all-tables] + (future ((fn [db] + (let [sql (select-db-meta-script + db :all-tables)] + (sort (db->>column db sql)))) + db)))) + (get? (get-in @cache [db :all-tables]) force?))))) + +(defn get-colomns [db table force?] + "Return colomns list for this table from cache if already received from DB, +check if receiveing process is not running, then start it." + (if (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 (db->column db sql)))) + db table)))) + (get? (get->in @cache [db :colomns table]) + force?)) + +(defn is-owner? [db prefix] + (in? (get-owners db) prefix :case-sensitive false)) + +(defn autocomplete-loading [] + "Not loaded tables yet. Output pending db structure data..." + (list "t")) + +(defn autocomplete-result [result] + "Output autocomplete result." + (cons "nil" result)) + +(defn autocomplete-nothing [] + "Output autocomplete nothing." + (list "nil")) + +(defn get-owners-candidates [db sql prefix-1 & _] + "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." + (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))))) + +(defn get-tables-candidates [db sql prefix-1 & _] + "Return tables candidates autocomplete list." + (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 match-alias? [sql owner table probable-alias] + "Check if prefix (`probable-alias`) is alias for `table` in this `sql`." + (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 [db] + "Get all tables for all owners/schemas." + (flatten + (mapv #(get-tables db % true) + (get-owners db true)))) + +(def insert-re + (re-pattern (str "(?i)\\s*INSERT\\s+INTO\\s+(\\S+)\\s+"))) + +(defn insert-sql? [sql] + "If `sql` is INSERT query, return a table name used to insert new records. +Otherwise return nil." + (second (re-find insert-re sql))) + +(def update-re + (re-pattern (str "(?i)\\s*UPDATE\\s(\\S+)\\s+\n*SET.*"))) + +(defn update-sql? [sql] + "If `sql` is UPDATE query, return a table name used to modify the existing +records. Otherwise return nil." + (second (re-find update-re sql))) + +(defn get-colomns-candidates [db sql prefix-1 & [prefix-2]] + "Return colomns candidates autocomplete list." + ;; 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 (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)))] + (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 (insert-sql? sql) + (update-sql? sql))] + (cond + (and (not-empty insert-or-update-table) + (in? tables-list insert-or-update-table + :case-sensitive false)) + ;; 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 (c/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-cache [] + "Output actual cache." + @cache) + +(defn invalidate-cache [db] + "Clean your current connection cache (database owners and tables list)." + (swap! cache assoc-in [db] nil)) diff --git a/elpa/ejc-sql-readme.txt b/elpa/ejc-sql-readme.txt deleted file mode 100644 index 4875dd4d..00000000 --- a/elpa/ejc-sql-readme.txt +++ /dev/null @@ -1,4 +0,0 @@ -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.