[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master c5a31f8 1/7: * lisp/progmodes/sql.el: Version 3.6
|
From: |
Michael Mauger |
|
Subject: |
[Emacs-diffs] master c5a31f8 1/7: * lisp/progmodes/sql.el: Version 3.6 |
|
Date: |
Sun, 6 Aug 2017 20:59:15 -0400 (EDT) |
branch: master
commit c5a31f8292c94d19b80a3dbe0b3026693cc1090e
Author: Michael R. Mauger <address@hidden>
Commit: Michael R. Mauger <address@hidden>
* lisp/progmodes/sql.el: Version 3.6
(sql-login-params): Added :must-match for completition of
`server' and `database' login parameters.
(sql-sqlite-login-params, sql-postgres-login-params): Set
:must-match to `confirm'.
(sql-get-login-ext): Use :must-match value to control
`read-file-name' or `completing-read'.
(sql-connect): Added optional BUF-NAME parameter; Reworked
connection variable processing; Pass buffer name to
`sql-product-interactive'.
(sql-product-interactive): Pass buffer name along.
(sql-comint): Add optional BUF-NAME and calculate reasonable default.
(sql-comint-oracle, sql-sybase-comint, sql-comint-informix)
(sql-comint-sqlite, sql-comint-mysql, sql-comint-solid)
(sql-comint-ingres, sql-comint-ms, sql-comint-postgres)
(sql-comint-interbase, sql-comint-db2, sql-comint-linter)
(sql-comint-vertica): Add optional BUF-NAME, pass to
`sql-comint'.
(sql-oracle--list-oracle-name): New function.
(sql-oracle-list-all): Use it.
(sql-oracle-completion-object): Enhanced.
---
lisp/progmodes/sql.el | 215 +++++++++++++++++++++++++++++---------------------
1 file changed, 127 insertions(+), 88 deletions(-)
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 68ca372..b176e52 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -4,7 +4,7 @@
;; Author: Alex Schroeder <address@hidden>
;; Maintainer: Michael Mauger <address@hidden>
-;; Version: 3.5
+;; Version: 3.6
;; Keywords: comm languages processes
;; URL: http://savannah.gnu.org/projects/emacs/
@@ -156,7 +156,7 @@
;; (sql-set-product-feature 'xyz
;; :sqli-options 'my-sql-xyz-options))
-;; (defun my-sql-comint-xyz (product options)
+;; (defun my-sql-comint-xyz (product options &optional buf-name)
;; "Connect ti XyzDB in a comint buffer."
;;
;; ;; Do something with `sql-user', `sql-password',
@@ -172,7 +172,7 @@
;; (if (not (string= "" sql-server))
;; (list "-S" sql-server))
;; options)))
-;; (sql-comint product params)))
+;; (sql-comint product params buf-name)))
;;
;; (sql-set-product-feature 'xyz
;; :sqli-comint-func 'my-sql-comint-xyz)
@@ -220,6 +220,7 @@
;; incorrectly enabled by default
;; Roman Scherer <address@hidden> -- Connection documentation
;; Mark Wilkinson <address@hidden> -- file-local variables ignored
+;; Simen Heggestøyl <address@hidden> -- Postgres database completion
;;
@@ -317,6 +318,7 @@ file. Since that is a plaintext file, this could be
dangerous."
(list :tag "completion"
(const :format "" server)
(const :format "" :completion)
+ (const :format "" :must-match)
(restricted-sexp
:match-alternatives (listp stringp))))
(choice :tag "database"
@@ -332,9 +334,10 @@ file. Since that is a plaintext file, this could be
dangerous."
regexp)
(list :tag "completion"
(const :format "" database)
- (const :format "" :completion)
- (restricted-sexp
- :match-alternatives (listp stringp))))
+ (const :format "" :completion)
+ (const :format "" :must-match)
+ (restricted-sexp
+ :match-alternatives (listp stringp))))
(const port)))
;; SQL Product support
@@ -936,7 +939,8 @@ Starts `sql-interactive-mode' after doing some setup."
:version "20.8"
:group 'SQL)
-(defcustom sql-sqlite-login-params '((database :file nil))
+(defcustom sql-sqlite-login-params '((database :file nil
+ :must-match confirm))
"List of login parameters needed to connect to SQLite."
:type 'sql-login-params
:version "26.1"
@@ -1079,7 +1083,8 @@ add your name with a \"-U\" prefix (such as \"-Umark\")
to the list."
`((user :default ,(user-login-name))
(database :default ,(user-login-name)
:completion ,(completion-table-dynamic
- (lambda (_) (sql-postgres-list-databases))))
+ (lambda (_) (sql-postgres-list-databases)))
+ :must-match confirm)
server)
"List of login parameters needed to connect to Postgres."
:type 'sql-login-params
@@ -2957,7 +2962,9 @@ value. (The property value is used as the PREDICATE
argument to
((plist-member plist :file)
(let ((file-name
(read-file-name prompt
- (file-name-directory last-value) default 'confirm
+ (file-name-directory last-value)
+ default
+ (plist-get plist :must-match)
(file-name-nondirectory last-value)
(when (plist-get plist :file)
`(lambda (f)
@@ -2971,8 +2978,13 @@ value. (The property value is used as the PREDICATE
argument to
(expand-file-name file-name))))
((plist-member plist :completion)
- (completing-read prompt-def (plist-get plist :completion) nil t
- last-value history-var default))
+ (completing-read prompt-def
+ (plist-get plist :completion)
+ nil
+ (plist-get plist :must-match)
+ last-value
+ history-var
+ default))
((plist-get plist :number)
(read-number prompt (or default last-value 0)))
@@ -4034,7 +4046,7 @@ Sentinels will always get the two parameters PROCESS and
EVENT."
nil t initial 'sql-connection-history default)))
;;;###autoload
-(defun sql-connect (connection &optional new-name)
+(defun sql-connect (connection &optional buf-name)
"Connect to an interactive session using CONNECTION settings.
See `sql-connection-alist' to see how to define connections and
@@ -4046,7 +4058,7 @@ is specified in the connection settings."
;; Prompt for the connection from those defined in the alist
(interactive
(if sql-connection-alist
- (list (sql-read-connection "Connection: " nil '(nil))
+ (list (sql-read-connection "Connection: ")
current-prefix-arg)
(user-error "No SQL Connections defined")))
@@ -4055,16 +4067,16 @@ is specified in the connection settings."
;; Was one selected
(when connection
;; Get connection settings
- (let ((connect-set (assoc-string connection sql-connection-alist t)))
+ (let ((connect-set (cdr (assoc-string connection sql-connection-alist
t))))
;; Settings are defined
(if connect-set
;; Set the desired parameters
- (let (param-var login-params set-params rem-params)
+ (let (param-var login-params set-vars rem-vars)
;; Set the parameters and start the interactive session
- (mapc
- (lambda (vv)
- (set-default (car vv) (eval (cadr vv))))
- (cdr connect-set))
+ (dolist (vv connect-set)
+ (let ((var (car vv))
+ (val (cadr vv)))
+ (set-default var (eval val))))
(setq-default sql-connection connection)
;; :sqli-login params variable
@@ -4072,32 +4084,33 @@ is specified in the connection settings."
(sql-get-product-feature sql-product :sqli-login nil t))
;; :sqli-login params value
- (setq login-params
- (sql-get-product-feature sql-product :sqli-login))
+ (setq login-params (symbol-value param-var))
- ;; Params in the connection
- (setq set-params
+ ;; Params set in the connection
+ (setq set-vars
(mapcar
(lambda (v)
- (pcase (car v)
- (`sql-user 'user)
- (`sql-password 'password)
- (`sql-server 'server)
- (`sql-database 'database)
- (`sql-port 'port)
- (s s)))
- (cdr connect-set)))
+ (pcase (car v)
+ (`sql-user 'user)
+ (`sql-password 'password)
+ (`sql-server 'server)
+ (`sql-database 'database)
+ (`sql-port 'port)
+ (s s)))
+ connect-set))
;; the remaining params (w/o the connection params)
- (setq rem-params
+ (setq rem-vars
(sql-for-each-login login-params
- (lambda (token plist)
- (unless (member token set-params)
- (if plist (cons token plist) token)))))
+ (lambda (var vals)
+ (unless (member var set-vars)
+ (if vals (cons var vals) var)))))
;; Start the SQLi session with revised list of login parameters
- (eval `(let ((,param-var ',rem-params))
- (sql-product-interactive ',sql-product ',new-name))))
+ (eval `(let ((,param-var ',rem-vars))
+ (sql-product-interactive
+ ',sql-product
+ ',(or buf-name (format "<%s>" connection))))))
(user-error "SQL Connection <%s> does not exist" connection)
nil)))
@@ -4241,7 +4254,10 @@ the call to \\[sql-product-interactive] with
default-directory)))
(funcall (sql-get-product-feature product :sqli-comint-func)
product
- (sql-get-product-feature product :sqli-options)))
+ (sql-get-product-feature product :sqli-options)
+ (if (and new-name (string-prefix-p "SQL" new-name t))
+ new-name
+ (concat "SQL: " new-name))))
;; Set SQLi mode.
(let ((sql-interactive-product product))
@@ -4249,8 +4265,6 @@ the call to \\[sql-product-interactive] with
;; Set the new buffer name
(setq new-sqli-buffer (current-buffer))
- (when new-name
- (sql-rename-buffer new-name))
(set (make-local-variable 'sql-buffer)
(buffer-name new-sqli-buffer))
@@ -4284,29 +4298,41 @@ the call to \\[sql-product-interactive] with
(current-buffer)))))
(user-error "No default SQL product defined. Set `sql-product'.")))
-(defun sql-comint (product params)
+(defun sql-comint (product params &optional buf-name)
"Set up a comint buffer to run the SQL processor.
PRODUCT is the SQL product. PARAMS is a list of strings which are
-passed as command line arguments."
- (let ((program (sql-get-product-feature product :sqli-program))
- (buf-name "SQL"))
+passed as command line arguments. BUF-NAME is the name of the new
+buffer. If nil, a name is chosen for it."
+
+ (let ((program (sql-get-product-feature product :sqli-program)))
;; Make sure we can find the program. `executable-find' does not
;; work for remote hosts; we suppress the check there.
(unless (or (file-remote-p default-directory)
(executable-find program))
(error "Unable to locate SQL program `%s'" program))
+
;; Make sure buffer name is unique.
- (when (sql-buffer-live-p (format "*%s*" buf-name))
- (setq buf-name (format "SQL-%s" product))
- (when (sql-buffer-live-p (format "*%s*" buf-name))
- (let ((i 1))
- (while (sql-buffer-live-p
- (format "*%s*"
- (setq buf-name (format "SQL-%s%d" product i))))
- (setq i (1+ i))))))
- (set-buffer
- (apply #'make-comint buf-name program nil params))))
+ ;; if not specified, try *SQL* then *SQL-product*, then *SQL-product1*,
...
+ ;; otherwise, use *buf-name*
+ (if buf-name
+ (unless (string-match-p "\\`[*].*[*]\\'" buf-name)
+ (setq buf-name (concat "*" buf-name "*")))
+ (setq buf-name "*SQL*")
+ (when (sql-buffer-live-p buf-name)
+ (setq buf-name (format "*SQL-%s*" product)))
+ (let ((i 1))
+ (while (sql-buffer-live-p buf-name)
+ (setq buf-name (format "*SQL-%s%d*" product i)
+ i (1+ i)))))
+ (set-text-properties 0 (length buf-name) nil buf-name)
+
+ ;; Start the command interpreter in the buffer
+ ;; PROC-NAME is BUF-NAME without enclosing asterisks
+ (let ((proc-name (replace-regexp-in-string "\\`[*]\\(.*\\)[*]\\'" "\\1"
buf-name)))
+ (set-buffer
+ (apply #'make-comint-in-buffer
+ proc-name buf-name program nil params)))))
;;;###autoload
(defun sql-oracle (&optional buffer)
@@ -4340,7 +4366,7 @@ The default comes from `process-coding-system-alist' and
(interactive "P")
(sql-product-interactive 'oracle buffer))
-(defun sql-comint-oracle (product options)
+(defun sql-comint-oracle (product options &optional buf-name)
"Create comint buffer and connect to Oracle."
;; Produce user/address@hidden construct. Password without user
;; is meaningless; database without user/password is meaningless,
@@ -4357,7 +4383,7 @@ The default comes from `process-coding-system-alist' and
(if parameter
(setq parameter (append options (list parameter)))
(setq parameter options))
- (sql-comint product parameter)
+ (sql-comint product parameter buf-name)
;; Set process coding system to agree with the interpreter
(setq nlslang (or (getenv "NLS_LANG") "")
coding (dolist (cs
@@ -4454,20 +4480,25 @@ The default comes from `process-coding-system-alist' and
;; Restore the changed settings
(sql-redirect sqlbuf saved-settings))
+(defun sql-oracle--list-object-name (obj-name)
+ (format "CASE WHEN REGEXP_LIKE (%s, q'/^[A-Z0-9_#$]+$/','c') THEN %s ELSE
'\"'|| %s ||'\"' END "
+ obj-name obj-name obj-name))
+
(defun sql-oracle-list-all (sqlbuf outbuf enhanced _table-name)
;; Query from USER_OBJECTS or ALL_OBJECTS
(let ((settings (sql-oracle-save-settings sqlbuf))
(simple-sql
(concat
"SELECT INITCAP(x.object_type) AS SQL_EL_TYPE "
- ", x.object_name AS SQL_EL_NAME "
+ ", " (sql-oracle--list-object-name "x.object_name") " AS SQL_EL_NAME
"
"FROM user_objects x "
"WHERE x.object_type NOT LIKE '%% BODY' "
"ORDER BY 2, 1;"))
(enhanced-sql
(concat
"SELECT INITCAP(x.object_type) AS SQL_EL_TYPE "
- ", x.owner ||'.'|| x.object_name AS SQL_EL_NAME "
+ ", " (sql-oracle--list-object-name "x.owner")
+ " ||'.'|| " (sql-oracle--list-object-name "x.object_name") " AS
SQL_EL_NAME "
"FROM all_objects x "
"WHERE x.object_type NOT LIKE '%% BODY' "
"AND x.owner <> 'SYS' "
@@ -4524,9 +4555,15 @@ See the distinct values in ALL_OBJECTS.OBJECT_TYPE for
possible values."
(concat
"SELECT CHR(1)||"
(if schema
- (format "owner||'.'||object_name AS o FROM all_objects WHERE owner =
%s AND "
- (sql-str-literal (upcase schema)))
- "object_name AS o FROM user_objects WHERE ")
+ (concat "CASE WHEN REGEXP_LIKE (owner, q'/^[A-Z0-9_#$]+$/','c') THEN
owner ELSE '\"'|| owner ||'\"' END "
+ "||'.'||"
+ "CASE WHEN REGEXP_LIKE (object_name, q'/^[A-Z0-9_#$]+$/','c')
THEN object_name ELSE '\"'|| object_name ||'\"' END "
+ " AS o FROM all_objects "
+ (format "WHERE owner = %s AND "
+ (sql-str-literal (if (string-match
"^[\"]\\(.+\\)[\"]$" schema)
+ (match-string 1 schema) (upcase
schema)))))
+ (concat "CASE WHEN REGEXP_LIKE (object_name, q'/^[A-Z0-9_#$]+$/','c')
THEN object_name ELSE '\"'|| object_name ||'\"' END "
+ " AS o FROM user_objects WHERE "))
"temporary = 'N' AND generated = 'N' AND secondary = 'N' AND "
"object_type IN ("
(mapconcat (function sql-str-literal) sql-oracle-completion-types ",")
@@ -4566,7 +4603,7 @@ The default comes from `process-coding-system-alist' and
(interactive "P")
(sql-product-interactive 'sybase buffer))
-(defun sql-comint-sybase (product options)
+(defun sql-comint-sybase (product options &optional buf-name)
"Create comint buffer and connect to Sybase."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
@@ -4581,7 +4618,7 @@ The default comes from `process-coding-system-alist' and
(if (not (string= "" sql-server))
(list "-S" sql-server))
options)))
- (sql-comint product params)))
+ (sql-comint product params buf-name)))
@@ -4615,7 +4652,7 @@ The default comes from `process-coding-system-alist' and
(interactive "P")
(sql-product-interactive 'informix buffer))
-(defun sql-comint-informix (product options)
+(defun sql-comint-informix (product options &optional buf-name)
"Create comint buffer and connect to Informix."
;; username and password are ignored.
(let ((db (if (string= "" sql-database)
@@ -4623,7 +4660,7 @@ The default comes from `process-coding-system-alist' and
(if (string= "" sql-server)
sql-database
(concat sql-database "@" sql-server)))))
- (sql-comint product (append `(,db "-") options))))
+ (sql-comint product (append `(,db "-") options) buf-name)))
@@ -4661,7 +4698,7 @@ The default comes from `process-coding-system-alist' and
(interactive "P")
(sql-product-interactive 'sqlite buffer))
-(defun sql-comint-sqlite (product options)
+(defun sql-comint-sqlite (product options &optional buf-name)
"Create comint buffer and connect to SQLite."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
@@ -4669,7 +4706,7 @@ The default comes from `process-coding-system-alist' and
(append options
(if (not (string= "" sql-database))
`(,(expand-file-name sql-database))))))
- (sql-comint product params)))
+ (sql-comint product params buf-name)))
(defun sql-sqlite-completion-object (sqlbuf _schema)
(sql-redirect-value sqlbuf ".tables" "\\sw\\(?:\\sw\\|\\s_\\)*" 0))
@@ -4710,7 +4747,7 @@ The default comes from `process-coding-system-alist' and
(interactive "P")
(sql-product-interactive 'mysql buffer))
-(defun sql-comint-mysql (product options)
+(defun sql-comint-mysql (product options &optional buf-name)
"Create comint buffer and connect to MySQL."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
@@ -4727,7 +4764,7 @@ The default comes from `process-coding-system-alist' and
(list (concat "--host=" sql-server)))
(if (not (string= "" sql-database))
(list sql-database)))))
- (sql-comint product params)))
+ (sql-comint product params buf-name)))
@@ -4762,7 +4799,7 @@ The default comes from `process-coding-system-alist' and
(interactive "P")
(sql-product-interactive 'solid buffer))
-(defun sql-comint-solid (product options)
+(defun sql-comint-solid (product options &optional buf-name)
"Create comint buffer and connect to Solid."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
@@ -4775,7 +4812,7 @@ The default comes from `process-coding-system-alist' and
(string= "" sql-password)))
(list sql-user sql-password))
options)))
- (sql-comint product params)))
+ (sql-comint product params buf-name)))
@@ -4809,14 +4846,15 @@ The default comes from `process-coding-system-alist' and
(interactive "P")
(sql-product-interactive 'ingres buffer))
-(defun sql-comint-ingres (product options)
+(defun sql-comint-ingres (product options &optional buf-name)
"Create comint buffer and connect to Ingres."
;; username and password are ignored.
(sql-comint product
- (append (if (string= "" sql-database)
- nil
- (list sql-database))
- options)))
+ (append (if (string= "" sql-database)
+ nil
+ (list sql-database))
+ options)
+ buf-name))
@@ -4852,7 +4890,7 @@ The default comes from `process-coding-system-alist' and
(interactive "P")
(sql-product-interactive 'ms buffer))
-(defun sql-comint-ms (product options)
+(defun sql-comint-ms (product options &optional buf-name)
"Create comint buffer and connect to Microsoft SQL Server."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
@@ -4875,7 +4913,7 @@ The default comes from `process-coding-system-alist' and
;; If -P is passed to ISQL as the last argument without a
;; password, it's considered null.
`(,@params "-P"))))
- (sql-comint product params)))
+ (sql-comint product params buf-name)))
@@ -4916,7 +4954,7 @@ Try to set `comint-output-filter-functions' like this:
(interactive "P")
(sql-product-interactive 'postgres buffer))
-(defun sql-comint-postgres (product options)
+(defun sql-comint-postgres (product options &optional buf-name)
"Create comint buffer and connect to Postgres."
;; username and password are ignored. Mark Stosberg suggests to add
;; the database at the end. Jason Beegan suggests using --pset and
@@ -4934,7 +4972,7 @@ Try to set `comint-output-filter-functions' like this:
options
(if (not (string= "" sql-database))
(list sql-database)))))
- (sql-comint product params)))
+ (sql-comint product params buf-name)))
(defun sql-postgres-completion-object (sqlbuf schema)
(sql-redirect sqlbuf "\\t on")
@@ -5004,7 +5042,7 @@ The default comes from `process-coding-system-alist' and
(interactive "P")
(sql-product-interactive 'interbase buffer))
-(defun sql-comint-interbase (product options)
+(defun sql-comint-interbase (product options &optional buf-name)
"Create comint buffer and connect to Interbase."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
@@ -5017,7 +5055,7 @@ The default comes from `process-coding-system-alist' and
(if (not (string= "" sql-user))
(list "-u" sql-user))
options)))
- (sql-comint product params)))
+ (sql-comint product params buf-name)))
@@ -5056,11 +5094,11 @@ The default comes from `process-coding-system-alist' and
(interactive "P")
(sql-product-interactive 'db2 buffer))
-(defun sql-comint-db2 (product options)
+(defun sql-comint-db2 (product options &optional buf-name)
"Create comint buffer and connect to DB2."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
- (sql-comint product options))
+ (sql-comint product options buf-name))
;;;###autoload
(defun sql-linter (&optional buffer)
@@ -5094,7 +5132,7 @@ buffer.
(interactive "P")
(sql-product-interactive 'linter buffer))
-(defun sql-comint-linter (product options)
+(defun sql-comint-linter (product options &optional buf-name)
"Create comint buffer and connect to Linter."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
@@ -5109,7 +5147,7 @@ buffer.
options)))
(cl-letf (((getenv "LINTER_MBX")
(unless (string= "" sql-database) sql-database)))
- (sql-comint product params))))
+ (sql-comint product params buf-name))))
@@ -5132,7 +5170,7 @@ The default value disables the internal pager."
:type 'sql-login-params
:group 'SQL)
-(defun sql-comint-vertica (product options)
+(defun sql-comint-vertica (product options &optional buf-name)
"Create comint buffer and connect to Vertica."
(sql-comint product
(nconc
@@ -5144,7 +5182,8 @@ The default value disables the internal pager."
(list "-w" sql-password))
(and (not (string= "" sql-user))
(list "-U" sql-user))
- options)))
+ options)
+ buf-name))
;;;###autoload
(defun sql-vertica (&optional buffer)
- [Emacs-diffs] master updated (c2f1830 -> 6e2c092), Michael Mauger, 2017/08/06
- [Emacs-diffs] master c5a31f8 1/7: * lisp/progmodes/sql.el: Version 3.6,
Michael Mauger <=
- [Emacs-diffs] master 776635c 3/7: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Michael Mauger, 2017/08/06
- [Emacs-diffs] master 7f62a4a 4/7: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Michael Mauger, 2017/08/06
- [Emacs-diffs] master eb27fc4 5/7: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Michael Mauger, 2017/08/06
- [Emacs-diffs] master 77083e2 2/7: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Michael Mauger, 2017/08/06
- [Emacs-diffs] master 6e2c092 7/7: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Michael Mauger, 2017/08/06
- [Emacs-diffs] master df1a712 6/7: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Michael Mauger, 2017/08/06