* 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.

1 files 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 <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/
 
@@ -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 <roman.scherer@nugg.ad> -- Connection documentation
 ;; Mark Wilkinson <wilkinsonmr@gmail.com> -- file-local variables ignored
+;; Simen Heggestøyl <simenheg@gmail.com> -- 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)