+;;; Connection handling
+
+;;;###autoload
+(defun sql-connect (connection)
+ "Connect to an interactive session using CONNECTION settings.
+
+See `sql-connection-alist' to see how to define connections and
+their settings.
+
+The user will not be prompted for any login parameters if a value
+is specified in the connection settings."
+
+ ;; Prompt for the connection from those defined in the alist
+ (interactive
+ (if sql-connection-alist
+ (list
+ (let ((completion-ignore-case t))
+ (completing-read "Connection: "
+ (mapcar (lambda (c) (car c))
+ sql-connection-alist)
+ nil t nil nil '(()))))
+ nil))
+
+ ;; Are there connections defined
+ (if sql-connection-alist
+ ;; Was one selected
+ (when connection
+ ;; Get connection settings
+ (let ((connect-set (assoc connection sql-connection-alist)))
+ ;; Settings are defined
+ (if connect-set
+ ;; Set the desired parameters
+ (eval `(let*
+ (,@(cdr connect-set)
+ ;; :sqli-login params variable
+ (param-var (sql-get-product-feature sql-product
+ :sqli-login nil t))
+ ;; :sqli-login params value
+ (login-params (sql-get-product-feature sql-product
+ :sqli-login))
+ ;; which params are in the connection
+ (set-params (mapcar
+ (lambda (v)
+ (cond
+ ((eq (car v) 'sql-user) 'user)
+ ((eq (car v) 'sql-password) 'password)
+ ((eq (car v) 'sql-server) 'server)
+ ((eq (car v) 'sql-database) 'database)
+ ((eq (car v) 'sql-port) 'port)
+ (t (car v))))
+ (cdr connect-set)))
+ ;; the remaining params (w/o the connection params)
+ (rem-params (sql-for-each-login
+ login-params
+ (lambda (token type arg)
+ (unless (member token set-params)
+ (if (or type arg)
+ (list token type arg)
+ token)))))
+ ;; Remember the connection
+ (sql-connection connection))
+
+ ;; Set the remaining parameters and start the
+ ;; interactive session
+ (eval `(let ((,param-var ',rem-params))
+ (sql-product-interactive sql-product)))))
+ (message "SQL Connection <%s> does not exist" connection)
+ nil)))
+ (message "No SQL Connections defined")
+ nil))
+
+(defun sql-save-connection (name)
+ "Captures the connection information of the current SQLi session.
+
+The information is appended to `sql-connection-alist' and
+optionally is saved to the user's init file."
+
+ (interactive "sNew connection name: ")
+
+ (if sql-connection
+ (message "This session was started by a connection; it's already been saved.")
+
+ (let ((login (sql-get-product-feature sql-product :sqli-login))
+ (alist sql-connection-alist)
+ connect)
+
+ ;; Remove the existing connection if the user says so
+ (when (and (assoc name alist)
+ (yes-or-no-p (format "Replace connection definition <%s>? " name)))
+ (setq alist (assq-delete-all name alist)))
+
+ ;; Add the new connection if it doesn't exist
+ (if (assoc name alist)
+ (message "Connection <%s> already exists" name)
+ (setq connect
+ (append (list name)
+ (sql-for-each-login
+ `(product ,@login)
+ (lambda (token type arg)
+ (cond
+ ((eq token 'product) `(sql-product ',sql-product))
+ ((eq token 'user) `(sql-user ,sql-user))
+ ((eq token 'database) `(sql-database ,sql-database))
+ ((eq token 'server) `(sql-server ,sql-server))
+ ((eq token 'port) `(sql-port ,sql-port)))))))
+
+ (setq alist (append alist (list connect)))
+
+ ;; confirm whether we want to save the connections
+ (if (yes-or-no-p "Save the connections for future sessions? ")
+ (customize-save-variable 'sql-connection-alist alist)
+ (customize-set-variable 'sql-connection-alist alist))))))
+
+(defun sql-connection-menu-filter (tail)
+ "Generates menu entries for using each connection."
+ (append
+ (mapcar
+ (lambda (conn)
+ (vector
+ (format "Connection <%s>" (car conn))
+ (list 'sql-connect (car conn))
+ t))
+ sql-connection-alist)
+ tail))
+
+\f
+