;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Michael Mauger <mmaug@yahoo.com>
-;; Version: 2.3
+;; Version: 2.4
;; Keywords: comm languages processes
;; URL: http://savannah.gnu.org/cgi-bin/viewcvs/emacs/emacs/lisp/progmodes/sql.el
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SqlMode
;; (defcustom my-sql-xyz-login-params '(user password server database)
;; "Login parameters to needed to connect to XyzDB."
-;; :type '(repeat (choice
-;; (const user)
-;; (const password)
-;; (const server)
-;; (const database)
-;; (const port)))
+;; :type 'sql-login-params
;; :group 'SQL)
;;
;; (sql-set-product-feature 'xyz
:group 'SQL
:safe 'numberp)
+;; Login parameter type
+
+(define-widget 'sql-login-params 'lazy
+ "Widget definition of the login parameters list"
+ :tag "Login Parameters"
+ :type '(repeat (choice
+ (const user)
+ (const password)
+ (choice :tag "server"
+ (const server)
+ (list :tag "file"
+ (const :format "" server)
+ (const :format "" :file)
+ regexp)
+ (list :tag "completion"
+ (const :format "" server)
+ (const :format "" :completion)
+ (restricted-sexp
+ :match-alternatives (listp symbolp))))
+ (choice :tag "database"
+ (const database)
+ (list :tag "file"
+ (const :format "" database)
+ (const :format "" :file)
+ regexp)
+ (list :tag "completion"
+ (const :format "" database)
+ (const :format "" :completion)
+ (restricted-sexp
+ :match-alternatives (listp symbolp))))
+ (const port))))
+
;; SQL Product support
(defvar sql-interactive-product nil
(defcustom sql-oracle-login-params '(user password database)
"List of login parameters needed to connect to Oracle."
- :type '(repeat (choice
- (const user)
- (const password)
- (const server)
- (const database)
- (const port)))
+ :type 'sql-login-params
:version "24.1"
:group 'SQL)
;; Customization for SQLite
-(defcustom sql-sqlite-program "sqlite"
+(defcustom sql-sqlite-program "sqlite3"
"Command to start SQLite.
Starts `sql-interactive-mode' after doing some setup."
:version "20.8"
:group 'SQL)
-(defcustom sql-sqlite-login-params '(database)
+(defcustom sql-sqlite-login-params '((database :file ".*\\.db"))
"List of login parameters needed to connect to SQLite."
- :type '(repeat (choice
- (const user)
- (const password)
- (const server)
- (const database)
- (const port)))
+ :type 'sql-login-params
:version "24.1"
:group 'SQL)
(defcustom sql-mysql-login-params '(user password database server)
"List of login parameters needed to connect to MySql."
- :type '(repeat (choice
- (const user)
- (const password)
- (const server)
- (const database)
- (const port)))
+ :type 'sql-login-params
:version "24.1"
:group 'SQL)
(defcustom sql-solid-login-params '(user password server)
"List of login parameters needed to connect to Solid."
- :type '(repeat (choice
- (const user)
- (const password)
- (const server)
- (const database)
- (const port)))
+ :type 'sql-login-params
:version "24.1"
:group 'SQL)
(defcustom sql-sybase-login-params '(server user password database)
"List of login parameters needed to connect to Sybase."
- :type '(repeat (choice
- (const user)
- (const password)
- (const server)
- (const database)
- (const port)))
+ :type 'sql-login-params
:version "24.1"
:group 'SQL)
(defcustom sql-informix-login-params '(database)
"List of login parameters needed to connect to Informix."
- :type '(repeat (choice
- (const user)
- (const password)
- (const server)
- (const database)
- (const port)))
+ :type 'sql-login-params
:version "24.1"
:group 'SQL)
(defcustom sql-ingres-login-params '(database)
"List of login parameters needed to connect to Ingres."
- :type '(repeat (choice
- (const user)
- (const password)
- (const server)
- (const database)
- (const port)))
+ :type 'sql-login-params
:version "24.1"
:group 'SQL)
(defcustom sql-ms-login-params '(user password server database)
"List of login parameters needed to connect to Microsoft."
- :type '(repeat (choice
- (const user)
- (const password)
- (const server)
- (const database)
- (const port)))
+ :type 'sql-login-params
:version "24.1"
:group 'SQL)
(defcustom sql-postgres-login-params '(user database server)
"List of login parameters needed to connect to Postgres."
- :type '(repeat (choice
- (const user)
- (const password)
- (const server)
- (const database)
- (const port)))
+ :type 'sql-login-params
:version "24.1"
:group 'SQL)
(defcustom sql-interbase-login-params '(user password database)
"List of login parameters needed to connect to Interbase."
- :type '(repeat (choice
- (const user)
- (const password)
- (const server)
- (const database)
- (const port)))
+ :type 'sql-login-params
:version "24.1"
:group 'SQL)
(defcustom sql-db2-login-params nil
"List of login parameters needed to connect to DB2."
- :type '(repeat (choice
- (const user)
- (const password)
- (const server)
- (const database)
- (const port)))
+ :type 'sql-login-params
:version "24.1"
:group 'SQL)
(defcustom sql-linter-login-params '(user password database server)
"Login parameters to needed to connect to Linter."
- :type '(repeat (choice
- (const user)
- (const password)
- (const server)
- (const database)
- (const port)))
+ :type 'sql-login-params
:version "24.1"
:group 'SQL)
(append old-val keywords)
(append keywords old-val))))))
+(defun sql-for-each-login (login-params body)
+ "Iterates through login parameters and returns a list of results."
+
+ (delq nil
+ (mapcar
+ (lambda (param)
+ (let ((token (or (and (listp param) (car param)) param))
+ (type (or (and (listp param) (nth 1 param)) nil))
+ (arg (or (and (listp param) (nth 2 param)) nil)))
+
+ (funcall body token type arg)))
+ login-params)))
+
\f
;;; Functions to switch highlighting
"Read a password using PROMPT. Optional DEFAULT is password to start with."
(read-passwd prompt nil default))
+(defun sql-get-login-ext (prompt last-value history-var type arg)
+ "Prompt user with extended login parameters.
+
+If TYPE is nil, then the user is simply prompted for a string
+value.
+
+If TYPE is `:file', then the user is prompted for a file
+name that must match the regexp pattern specified in the ARG
+argument.
+
+If TYPE is `:completion', then the user is prompted for a string
+specified by ARG. (ARG is used as the PREDICATE argument to
+`completing-read'.)"
+ (cond
+ ((eq type nil)
+ (read-from-minibuffer prompt last-value nil nil history-var))
+
+ ((eq type :file)
+ (let ((use-dialog-box nil))
+ (expand-file-name
+ (read-file-name prompt
+ (file-name-directory last-value) nil t
+ (file-name-nondirectory last-value)
+ (if arg
+ `(lambda (f)
+ (string-match (concat "\\<" ,arg "\\>")
+ (file-name-nondirectory f)))
+ nil)))))
+
+ ((eq type :completion)
+ (completing-read prompt arg nil t last-value history-var))))
+
(defun sql-get-login (&rest what)
"Get username, password and database from the user.
`database'. The members of WHAT are processed in the order in
which they are provided.
+The tokens for `database' and `server' may also be lists to
+control or limit the values that can be supplied. These can be
+of the form:
+
+ \(database :file \".+\\\\.EXT\")
+ \(database :completion FUNCTION)
+
+The `server' token supports the same forms.
+
In order to ask the user for username, password and database, call the
function like this: (sql-get-login 'user 'password 'database)."
(interactive)
- (while what
- (cond
- ((eq (car what) 'user) ; user
- (setq sql-user
- (read-from-minibuffer "User: " sql-user nil nil
- 'sql-user-history)))
- ((eq (car what) 'password) ; password
- (setq sql-password
- (sql-read-passwd "Password: " sql-password)))
-
- ((eq (car what) 'server) ; server
- (setq sql-server
- (read-from-minibuffer "Server: " sql-server nil nil
- 'sql-server-history)))
- ((eq (car what) 'port) ; port
- (setq sql-port
- (read-from-minibuffer "Port: " sql-port nil nil
- 'sql-port-history)))
- ((eq (car what) 'database) ; database
- (setq sql-database
- (read-from-minibuffer "Database: " sql-database nil nil
- 'sql-database-history))))
-
- (setq what (cdr what))))
+ (mapcar
+ (lambda (w)
+ (let ((token (or (and (listp w) (car w)) w))
+ (type (or (and (listp w) (nth 1 w)) nil))
+ (arg (or (and (listp w) (nth 2 w)) nil)))
+
+ (cond
+ ((eq token 'user) ; user
+ (setq sql-user
+ (read-from-minibuffer "User: " sql-user nil nil
+ 'sql-user-history)))
+
+ ((eq token 'password) ; password
+ (setq sql-password
+ (sql-read-passwd "Password: " sql-password)))
+
+ ((eq token 'server) ; server
+ (setq sql-server
+ (sql-get-login-ext "Server: " sql-server
+ 'sql-server-history type arg)))
+
+ ((eq token 'database) ; database
+ (setq sql-database
+ (sql-get-login-ext "Database: " sql-database
+ 'sql-database-history type arg)))
+
+ ((eq token 'port) ; port
+ (setq sql-port
+ (read-number "Port: " sql-port))))))
+ what))
(defun sql-find-sqli-buffer ()
"Returns the current default SQLi buffer or nil.
(let ((name ""))
- ;; Try using the :sqli-login setting
- (when (string= "" (or name ""))
- (setq name
- (apply 'concat
- (apply 'append nil
- (mapcar
- (lambda (v)
- (cond
- ((eq v 'user) (list "/" sql-user))
- ((eq v 'server) (list "." sql-server))
- ((eq v 'database) (list "@" sql-database))
- ((eq v 'port) (list ":" sql-port))
-
- ((eq v 'password) nil)
- (t nil)))
- (sql-get-product-feature sql-product :sqli-login))))))
-
- ;; Default: username/server format
- (when (string= "" (or name ""))
- (setq name
- (concat " "
- (if (string= "" sql-user)
- (if (string= "" (user-login-name))
- ()
- (concat (user-login-name) "/"))
- (concat sql-user "/"))
- (if (string= "" sql-database)
- (if (string= "" sql-server)
- (system-name)
- sql-server)
- sql-database))))
-
- ;; Return the final string; prefixed by the connection name
+ ;; Build a name using the :sqli-login setting
+ (setq name
+ (apply 'concat
+ (apply 'append nil
+ (sql-for-each-login
+ (sql-get-product-feature sql-product :sqli-login)
+ (lambda (token type arg)
+ (cond
+ ((eq token 'user) (list "/" sql-user))
+ ((eq token 'port) (list ":" sql-port))
+ ((eq token 'server)
+ (list "." (if (eq type :file)
+ (file-name-nondirectory sql-server)
+ sql-server)))
+ ((eq token 'database)
+ (list "@" (if (eq type :file)
+ (file-name-nondirectory sql-database)
+ sql-database)))
+
+ ((eq token 'password) nil)
+ (t nil)))))))
+
+
+ ;; If there's a connection, use it and the name thus far
(if sql-connection
(format "<%s>%s" sql-connection (or name ""))
- (substring (or name " ") 1))))
+
+ ;; If there is no name, try to create something meaningful
+ (if (string= "" (or name ""))
+ (concat
+ (if (string= "" sql-user)
+ (if (string= "" (user-login-name))
+ ()
+ (concat (user-login-name) "/"))
+ (concat sql-user "/"))
+ (if (string= "" sql-database)
+ (if (string= "" sql-server)
+ (system-name)
+ sql-server)
+ sql-database))
+
+ ;; We've got a name, go with it (without the first punctuation char)
+ (substring name 1)))))
(defun sql-rename-buffer ()
"Rename a SQLi buffer."
\f
-;;; Entry functions for different SQL interpreters.
-
-;;;###autoload
-(defun sql-product-interactive (&optional product)
- "Run PRODUCT interpreter as an inferior process.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer `*SQL*'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive "P")
-
- (setq product
- (cond
- ((equal product '(4)) ; Universal arg, prompt for product
- (intern (completing-read "SQL product: "
- (mapcar (lambda (info) (symbol-name (car info)))
- sql-product-alist)
- nil 'require-match
- (or (and sql-product (symbol-name sql-product)) "ansi"))))
- ((and product ; Product specified
- (symbolp product)) product)
- (t sql-product))) ; Default to sql-product
-
- (if product
- (when (sql-get-product-feature product :sqli-comint-func)
- (if (and sql-buffer
- (buffer-live-p sql-buffer)
- (comint-check-proc sql-buffer))
- (pop-to-buffer sql-buffer)
-
- ;; Is the current buffer in sql-mode and
- ;; there is a buffer local setting of sql-buffer
- (let* ((start-buffer
- (and (derived-mode-p 'sql-mode)
- (current-buffer)))
- (start-sql-buffer
- (and start-buffer
- (let (found)
- (dolist (var (buffer-local-variables))
- (and (consp var)
- (eq (car var) 'sql-buffer)
- (buffer-live-p (cdr var))
- (get-buffer-process (cdr var))
- (setq found (cdr var))))
- found)))
- new-sqli-buffer)
-
- ;; Get credentials.
- (apply 'sql-get-login (sql-get-product-feature product :sqli-login))
-
- ;; Connect to database.
- (message "Login...")
- (funcall (sql-get-product-feature product :sqli-comint-func)
- product
- (sql-get-product-feature product :sqli-options))
-
- ;; Set SQLi mode.
- (setq sql-interactive-product product
- new-sqli-buffer (current-buffer)
- sql-buffer new-sqli-buffer)
- (sql-interactive-mode)
-
- ;; Set `sql-buffer' in the start buffer
- (when (and start-buffer (not start-sql-buffer))
- (with-current-buffer start-buffer
- (setq sql-buffer new-sqli-buffer)))
-
- ;; All done.
- (message "Login...done")
- (pop-to-buffer sql-buffer))))
- (message "No default SQL product defined. Set `sql-product'.")))
-
-(defun sql-comint (product params)
- "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)))
- (set-buffer
- (apply 'make-comint "SQL" program nil params))))
+;;; Connection handling
;;;###autoload
(defun sql-connect (connection)
(t (car v))))
(cdr connect-set)))
;; the remaining params (w/o the connection params)
- (rem-params (delq nil
- (mapcar
- (lambda (l)
- (unless (member l set-params)
- l))
- login-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))
(message "Connection <%s> already exists" name)
(setq connect
(append (list name)
- (delq nil
- (mapcar
- (lambda (param)
- (cond
- ((eq param 'product) `(sql-product (quote ,sql-product)))
- ((eq param 'user) `(sql-user ,sql-user))
- ((eq param 'database) `(sql-database ,sql-database))
- ((eq param 'server) `(sql-server ,sql-server))
- ((eq param 'port) `(sql-port ,sql-port))))
- (append (list 'product) login)))))
+ (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)))
sql-connection-alist)
tail))
+\f
+
+;;; Entry functions for different SQL interpreters.
+
+;;;###autoload
+(defun sql-product-interactive (&optional product)
+ "Run PRODUCT interpreter as an inferior process.
+
+If buffer `*SQL*' exists but no process is running, make a new process.
+If buffer exists and a process is running, just switch to buffer `*SQL*'.
+
+\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
+ (interactive "P")
+
+ (setq product
+ (cond
+ ((equal product '(4)) ; Universal arg, prompt for product
+ (intern (completing-read "SQL product: "
+ (mapcar (lambda (info) (symbol-name (car info)))
+ sql-product-alist)
+ nil 'require-match
+ (or (and sql-product (symbol-name sql-product)) "ansi"))))
+ ((and product ; Product specified
+ (symbolp product)) product)
+ (t sql-product))) ; Default to sql-product
+
+ (if product
+ (when (sql-get-product-feature product :sqli-comint-func)
+ (if (and sql-buffer
+ (buffer-live-p sql-buffer)
+ (comint-check-proc sql-buffer))
+ (pop-to-buffer sql-buffer)
+
+ ;; Is the current buffer in sql-mode and
+ ;; there is a buffer local setting of sql-buffer
+ (let* ((start-buffer
+ (and (derived-mode-p 'sql-mode)
+ (current-buffer)))
+ (start-sql-buffer
+ (and start-buffer
+ (let (found)
+ (dolist (var (buffer-local-variables))
+ (and (consp var)
+ (eq (car var) 'sql-buffer)
+ (buffer-live-p (cdr var))
+ (get-buffer-process (cdr var))
+ (setq found (cdr var))))
+ found)))
+ new-sqli-buffer)
+
+ ;; Get credentials.
+ (apply 'sql-get-login (sql-get-product-feature product :sqli-login))
+
+ ;; Connect to database.
+ (message "Login...")
+ (funcall (sql-get-product-feature product :sqli-comint-func)
+ product
+ (sql-get-product-feature product :sqli-options))
+
+ ;; Set SQLi mode.
+ (setq sql-interactive-product product
+ new-sqli-buffer (current-buffer)
+ sql-buffer new-sqli-buffer)
+ (sql-interactive-mode)
+
+ ;; Set `sql-buffer' in the start buffer
+ (when (and start-buffer (not start-sql-buffer))
+ (with-current-buffer start-buffer
+ (setq sql-buffer new-sqli-buffer)))
+
+ ;; All done.
+ (message "Login...done")
+ (pop-to-buffer sql-buffer))))
+ (message "No default SQL product defined. Set `sql-product'.")))
+
+(defun sql-comint (product params)
+ "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)))
+ (set-buffer
+ (apply 'make-comint "SQL" program nil params))))
+
;;;###autoload
(defun sql-oracle ()
"Run sqlplus by Oracle as an inferior process.
;; make-comint.
(let ((params))
(if (not (string= "" sql-database))
- (setq params (append (list sql-database) params)))
+ (setq params (append (list (expand-file-name sql-database))
+ params)))
(setq params (append options params))
(sql-comint product params)))
projects / emacs.git / commitdiff