From c5a31f8292c94d19b80a3dbe0b3026693cc1090e Mon Sep 17 00:00:00 2001 From: "Michael R. Mauger" Date: Mon, 20 Mar 2017 23:26:53 -0400 Subject: [PATCH] * 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 68ca37207ef..b176e52950c 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -4,7 +4,7 @@ ;; Author: Alex Schroeder ;; Maintainer: Michael Mauger -;; 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 -- Connection documentation ;; Mark Wilkinson -- file-local variables ignored +;; Simen Heggestøyl -- 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/password@database 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) -- 2.39.5