;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Michael Mauger <michael@mauger.com>
-;; Version: 3.5
+;; Version: 3.6
;; Keywords: comm languages processes
;; URL: http://savannah.gnu.org/projects/emacs/
;; (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',
;; (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)
;; incorrectly enabled by default
;; Roman Scherer <roman.scherer@nugg.ad> -- Connection documentation
;; Mark Wilkinson <wilkinsonmr@gmail.com> -- file-local variables ignored
+;; Simen Heggestøyl <simenheg@gmail.com> -- Postgres database completion
;;
\f
(list :tag "completion"
(const :format "" server)
(const :format "" :completion)
+ (const :format "" :must-match)
(restricted-sexp
:match-alternatives (listp stringp))))
(choice :tag "database"
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
: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"
`((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
((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)
(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)))
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
;; 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")))
;; 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
(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)))
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))
;; 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))
(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)
(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,
(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
;; 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' "
(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 ",")
(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.
(if (not (string= "" sql-server))
(list "-S" sql-server))
options)))
- (sql-comint product params)))
+ (sql-comint product params buf-name)))
\f
(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)
(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)))
\f
(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.
(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))
(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.
(list (concat "--host=" sql-server)))
(if (not (string= "" sql-database))
(list sql-database)))))
- (sql-comint product params)))
+ (sql-comint product params buf-name)))
\f
(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.
(string= "" sql-password)))
(list sql-user sql-password))
options)))
- (sql-comint product params)))
+ (sql-comint product params buf-name)))
\f
(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))
\f
(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.
;; 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)))
\f
(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
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")
(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.
(if (not (string= "" sql-user))
(list "-u" sql-user))
options)))
- (sql-comint product params)))
+ (sql-comint product params buf-name)))
\f
(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)
(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.
options)))
(cl-letf (((getenv "LINTER_MBX")
(unless (string= "" sql-database) sql-database)))
- (sql-comint product params))))
+ (sql-comint product params buf-name))))
\f
: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
(list "-w" sql-password))
(and (not (string= "" sql-user))
(list "-U" sql-user))
- options)))
+ options)
+ buf-name))
;;;###autoload
(defun sql-vertica (&optional buffer)
projects / emacs.git / commitdiff