Mercurial > emacs
changeset 110424:03a492f2d1ce
SQL Mode, Version 2.8 - sql-list-all and sql-list-table functions.
* progmodes/sql.el: Version 2.8
(sql-login-params): Updated widget structure; changes still
needed.
(sql-product-alist): Add :list-all and :list-table features for
SQLite, Postgres and MySQL products.
(sql-redirect): Handle default value.
(sql-execute, sql-execute-feature): New functions.
(sql-read-table-name): New function.
(sql-list-all, sql-list-table): New functions. User API
(sql-mode-map, sql-interactive-mode-map): Add key definitions
for above functions.
(sql-mode-menu, sql-interactive-mode-menu): Add menu definitions
for above functions.
(sql-postgres-login-params): Add user and database defaults.
(sql-buffer-live-p): Bug fix.
(sql-product-history); New variable.
(sql-read-product): New function. Use it.
(sql-set-product, sql-product-interactive): Use it.
(sql-connection-history): New variable.
(sql-read-connection): New function. Use it.
(sql-connect): New function.
(sql-for-each-login): Redesign function interface.
(sql-make-alternate-buffer-name, sql-save-connection): Use it.
(sql-get-login-ext, sql-get-login): Use it. Handle default values.
(sql-comint): Check for program. Existing live buffer.
(sql-comint-postgres): Add port parameter.
| author | Michael Mauger <mmaug@yahoo.com> |
|---|---|
| date | Sat, 18 Sep 2010 22:11:18 -0400 |
| parents | 6c2baabc9d98 |
| children | cd99c4421df9 |
| files | etc/NEWS lisp/ChangeLog lisp/progmodes/sql.el |
| diffstat | 3 files changed, 373 insertions(+), 166 deletions(-) [+] |
line wrap: on
line diff
--- a/etc/NEWS Sun Sep 19 02:05:26 2010 +0200 +++ b/etc/NEWS Sat Sep 18 22:11:18 2010 -0400 @@ -320,9 +320,11 @@ *** `sql-dialect' is a synonym for `sql-product'. -*** Added ability to login with a port on MySQL. +*** Added ability to login with a port on MySQL and Postgres. The custom variable `sql-port' can be specified for connection to -MySQL servers. +MySQL or Postgres servers. By default, the port is not listed in +either login parameter, but will be added to the command line if set +to a non-zero value. *** Dynamic selection of product in an SQL interactive session. If you use `sql-product-interactive' to start an SQL interactive @@ -349,22 +351,34 @@ which is a list of the parameters to be prompted for before a connection is established. -By default, the value of the parameter is simply prompted for. For -`server' and `database', they can be specified in a list as shown -below: +The lists consist of the following five tokens: `user', `password', +`database', `server', and `port'. The order in which they appear is +the order in which they are prompted. The tokens symbols can be +replaced by a sublist starting with the token and followed by a plist +which control the prompting for values. The tokens `user', +`database', and `server' each can take a property of :default which +specifies the value to be used if no value is entered. The +`database', `server', and `port' tokens handle the :completion +property which restricts the entry to either one of the values in the +list or to one of the values returned by the function provided as the +property value. The `database' and `server' tokens also accept the +:file property whose value is a regexp to identify useful file names. - (server :file ARG) - (database :file ARG) - (server :completion ARG) - (database :completion ARG) + (user :default DEF) + (database :default DEF + :file FILEPAT + :completion COMPLETE) + (server :default DEF + :file FILEPAT + :completion COMPLETE) -The ARG when :file is specified is a regexp that will match valid file -names (without the directory portion). Generally these strings will -be of the form ".+\.SUF" where SUF is the desired file suffix. +The FILEPAT when :file is specified is a regexp that will match valid +file names (without the directory portion). Generally these strings +will be of the form ".+\.SUF" where SUF is the desired file suffix. -When :completion is specified, the ARG corresponds to the PREDICATE -argument to the `completing-read' function (a list of possible values -or a function returning such a list). +When :completion is specified, the COMPLETE corresponds to the +PREDICATE argument to the `completing-read' function (a list of +possible values or a function returning such a list). *** Added `sql-connection-alist' to record login parameter values. An alist for recording different username, database and server @@ -404,6 +418,26 @@ `sql-save-connection' will gather the login params specified for the session and save them as a new connection. +*** List database objects and details. +Once a SQL interactive session has been started, you can get a list of +the objects in the database and see details of those objects. The +objects shown and the details available are product specific. + +**** List all objects. +Using `M-x sql-list-all', `C-c C-l a' or selecting "SQL->List all +objects" will list all the objects in the database. At a minimum it +lists the tables and views in the database. Preceeding the command by +universal argument may provide additional details or extend the +listing to include other schemas objects. The list will appear in a +separate window in view-mode. + +**** List Table details. +Using `M-x sql-list-table', `C-c C-l t' or selecting "SQL->List Table +details" will ask for the name of a database table or view and display +the list of columns in the relation. Preceeding the comand with the +universal argument may provide additional details about each column. +The list will appear in a separate window in view-mode. + *** Added option `sql-send-terminator'. When set makes sure that each command sent with `sql-send-*' commands are properly terminated and submitted to the SQL processor.
--- a/lisp/ChangeLog Sun Sep 19 02:05:26 2010 +0200 +++ b/lisp/ChangeLog Sat Sep 18 22:11:18 2010 -0400 @@ -1,3 +1,32 @@ +2010-09-18 Michael R. Mauger <mmaug@yahoo.com> + + * progmodes/sql.el: Version 2.8 + (sql-login-params): Updated widget structure; changes still + needed. + (sql-product-alist): Add :list-all and :list-table features for + SQLite, Postgres and MySQL products. + (sql-redirect): Handle default value. + (sql-execute, sql-execute-feature): New functions. + (sql-read-table-name): New function. + (sql-list-all, sql-list-table): New functions. User API + (sql-mode-map, sql-interactive-mode-map): Add key definitions + for above functions. + (sql-mode-menu, sql-interactive-mode-menu): Add menu definitions + for above functions. + (sql-postgres-login-params): Add user and database defaults. + (sql-buffer-live-p): Bug fix. + (sql-product-history); New variable. + (sql-read-product): New function. Use it. + (sql-set-product, sql-product-interactive): Use it. + (sql-connection-history): New variable. + (sql-read-connection): New function. Use it. + (sql-connect): New function. + (sql-for-each-login): Redesign function interface. + (sql-make-alternate-buffer-name, sql-save-connection): Use it. + (sql-get-login-ext, sql-get-login): Use it. Handle default values. + (sql-comint): Check for program. Existing live buffer. + (sql-comint-postgres): Add port parameter. + 2010-09-19 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/warnings.el: Fix commenting convention.
--- a/lisp/progmodes/sql.el Sun Sep 19 02:05:26 2010 +0200 +++ b/lisp/progmodes/sql.el Sat Sep 18 22:11:18 2010 -0400 @@ -5,10 +5,9 @@ ;; Author: Alex Schroeder <alex@gnu.org> ;; Maintainer: Michael Mauger <mmaug@yahoo.com> -;; Version: 2.7 +;; Version: 2.8 ;; 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 ;; This file is part of GNU Emacs. @@ -286,6 +285,9 @@ (define-widget 'sql-login-params 'lazy "Widget definition of the login parameters list" + ;; FIXME: does not implement :default property for the user, + ;; database and server options. Anybody have some guidance on how to + ;; do this. :tag "Login Parameters" :type '(repeat (choice (const user) @@ -300,7 +302,7 @@ (const :format "" server) (const :format "" :completion) (restricted-sexp - :match-alternatives (listp symbolp)))) + :match-alternatives (listp stringp)))) (choice :tag "database" (const database) (list :tag "file" @@ -311,7 +313,7 @@ (const :format "" database) (const :format "" :completion) (restricted-sexp - :match-alternatives (listp symbolp)))) + :match-alternatives (listp stringp)))) (const port)))) ;; SQL Product support @@ -401,6 +403,8 @@ :sqli-options sql-mysql-options :sqli-login sql-mysql-login-params :sqli-comint-func sql-comint-mysql + :list-all "SHOW TABLES;" + :list-table "DESCRIBE %s;" :prompt-regexp "^mysql> " :prompt-length 6 :prompt-cont-regexp "^ -> " @@ -428,6 +432,8 @@ :sqli-options sql-postgres-options :sqli-login sql-postgres-login-params :sqli-comint-func sql-comint-postgres + :list-all ("\\d+" . "\\dS+") + :list-table ("\\d+ %s" . "\\dS+ %s") :prompt-regexp "^.*=[#>] " :prompt-length 5 :prompt-cont-regexp "^.*[-(][#>] " @@ -452,6 +458,8 @@ :sqli-options sql-sqlite-options :sqli-login sql-sqlite-login-params :sqli-comint-func sql-comint-sqlite + :list-all ".tables" + :list-table ".schema %s" :prompt-regexp "^sqlite> " :prompt-length 8 :prompt-cont-regexp "^ ...> " @@ -510,6 +518,23 @@ database. Do product specific configuration of comint in this function. + :list-all Command string or function which produces + a listing of all objects in the database. + If it's a cons cell, then the car + produces the standard list of objects and + the cdr produces an enhanced list of + objects. What \"enhanced\" means is + dependent on the SQL product and may not + exist. In general though, the + \"enhanced\" list should include visible + objects from other schemas. + + :list-table Command string or function which produces + a detailed listing of a specific database + table. If its a cons cell, then the car + produces the standard list and the cdr + produces an enhanced list. + :prompt-regexp regular expression string that matches the prompt issued by the product interpreter. @@ -941,7 +966,9 @@ :version "20.8" :group 'SQL) -(defcustom sql-postgres-login-params '(user database server) +(defcustom sql-postgres-login-params `((user :default ,(user-login-name)) + (database :default ,(user-login-name)) + server) "List of login parameters needed to connect to Postgres." :type 'sql-login-params :version "24.1" @@ -1025,6 +1052,12 @@ ;; Passwords are not kept in a history. +(defvar sql-product-history nil + "History of products used.") + +(defvar sql-connection-history nil + "History of connections used.") + (defvar sql-buffer nil "Current SQLi buffer. @@ -1067,7 +1100,7 @@ (get-buffer-process buffer) (comint-check-proc buffer) (with-current-buffer buffer - (and (derived-mode-p 'sql-product-interactive) + (and (derived-mode-p 'sql-interactive-mode) (or (not product) (eq product sql-product))))))) @@ -1086,6 +1119,8 @@ (define-key map (kbd "O") 'sql-magic-go) (define-key map (kbd "o") 'sql-magic-go) (define-key map (kbd ";") 'sql-magic-semicolon) + (define-key map (kbd "C-c C-l a") 'sql-list-all) + (define-key map (kbd "C-c C-l t") 'sql-list-table) map) "Mode map used for `sql-interactive-mode'. Based on `comint-mode-map'.") @@ -1099,6 +1134,8 @@ (define-key map (kbd "C-c C-s") 'sql-send-string) (define-key map (kbd "C-c C-b") 'sql-send-buffer) (define-key map (kbd "C-c C-i") 'sql-product-interactive) + (define-key map (kbd "C-c C-l a") 'sql-list-all) + (define-key map (kbd "C-c C-l t") 'sql-list-table) map) "Mode map used for `sql-mode'.") @@ -1114,6 +1151,9 @@ ["Send Buffer" sql-send-buffer (sql-buffer-live-p sql-buffer)] ["Send String" sql-send-string (sql-buffer-live-p sql-buffer)] "--" + ["List all objects" sql-list-all (sql-buffer-live-p sql-buffer)] + ["List table details" sql-list-table (sql-buffer-live-p sql-buffer)] + "--" ["Start SQLi session" sql-product-interactive :visible (not sql-connection-alist) :enable (sql-get-product-feature sql-product :sqli-comint-func)] @@ -1152,7 +1192,10 @@ "Menu for `sql-interactive-mode'." '("SQL" ["Rename Buffer" sql-rename-buffer t] - ["Save Connection" sql-save-connection (not sql-connection)])) + ["Save Connection" sql-save-connection (not sql-connection)] + "--" + ["List all objects" sql-list-all t] + ["List table details" sql-list-table t])) ;; Abbreviations -- if you want more of them, define them in your ;; ~/.emacs file. Abbrevs have to be enabled in your ~/.emacs, too. @@ -2135,6 +2178,16 @@ ;;; SQL Product support functions +(defun sql-read-product (prompt &optional initial) + "Read a valid SQL product." + (let ((init (or (and initial (symbol-name initial)) "ansi"))) + (intern (completing-read + prompt + (mapcar (lambda (info) (symbol-name (car info))) + sql-product-alist) + nil 'require-match + init 'sql-product-history init)))) + (defun sql-add-product (product display &rest plist) "Add support for a database product in `sql-mode'. @@ -2325,10 +2378,9 @@ (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))) + (plist (or (and (listp param) (cdr param)) nil))) + + (funcall body token plist))) login-params))) @@ -2348,11 +2400,7 @@ (defun sql-set-product (product) "Set `sql-product' to PRODUCT and enable appropriate highlighting." (interactive - (list (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")))) + (list (sql-read-product "SQL product: "))) (if (stringp product) (setq product (intern product))) (when (not (assoc product sql-product-alist)) (error "SQL product %s is not supported; treated as ANSI" product) @@ -2492,37 +2540,53 @@ "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) +(defun sql-get-login-ext (prompt last-value history-var plist) "Prompt user with extended login parameters. -If TYPE is nil, then the user is simply prompted for a string +If PLIST 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 +The property `:default' specifies the default value. If the +`:number' property is non-nil then ask for a number. + +The `:file' property prompts for a file name that must match the +regexp pattern specified in its value. + +The `:completion' property prompts for a string specified by its +value. (The property value 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)) + (let* ((default (plist-get plist :default)) + (prompt-def + (if default + (if (string-match "\\(\\):[ \t]*\\'" prompt) + (replace-match (format " (default \"%s\")" default) t t prompt 1) + (replace-regexp-in-string "[ \t]*\\'" + (format " (default \"%s\") " default) + prompt t t)) + prompt)) + (use-dialog-box nil)) + (cond + ((plist-member plist :file) (expand-file-name (read-file-name prompt - (file-name-directory last-value) nil t + (file-name-directory last-value) default 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)))) + (when (plist-get plist :file) + `(lambda (f) + (string-match + (concat "\\<" ,(plist-get plist :file) "\\>") + (file-name-nondirectory f))))))) + + ((plist-member plist :completion) + (completing-read prompt-def (plist-get plist :completion) nil t + last-value history-var default)) + + ((plist-get plist :number) + (read-number prompt (or default last-value 0))) + + (t + (let ((r (read-from-minibuffer prompt-def last-value nil nil history-var nil))) + (if (string= "" r) (or default "") r)))))) (defun sql-get-login (&rest what) "Get username, password and database from the user. @@ -2541,57 +2605,55 @@ `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. +Each token may also be a list with the token in the car and a +plist of options as the cdr. The following properties are +supported: + + :file <filename-regexp> + :completion <list-of-strings-or-function> + :default <default-value> + :number t In order to ask the user for username, password and database, call the function like this: (sql-get-login 'user 'password 'database)." (interactive) - (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: " (if (numberp sql-port) - sql-port - 0))))))) - what)) - -(defun sql-find-sqli-buffer () + (mapcar + (lambda (w) + (let ((token (or (and (consp w) (car w)) w)) + (plist (or (and (consp w) (cdr w)) nil))) + + (cond + ((eq token 'user) ; user + (setq sql-user + (sql-get-login-ext "User: " sql-user + 'sql-user-history plist))) + + ((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 plist))) + + ((eq token 'database) ; database + (setq sql-database + (sql-get-login-ext "Database: " sql-database + 'sql-database-history plist))) + + ((eq token 'port) ; port + (setq sql-port + (sql-get-login-ext "Port: " sql-port + nil (append '(:number t) plist))))))) + what)) + +(defun sql-find-sqli-buffer (&optional product) "Returns the name of the current default SQLi buffer or nil. In order to qualify, the SQLi buffer must be alive, be in `sql-interactive-mode' and have a process." (let ((buf sql-buffer) - (prod sql-product)) + (prod (or product sql-product))) (or ;; Current sql-buffer, if there is one. (and (sql-buffer-live-p buf prod) @@ -2689,7 +2751,7 @@ (apply 'append nil (sql-for-each-login (sql-get-product-feature sql-product :sqli-login) - (lambda (token type arg) + (lambda (token plist) (cond ((eq token 'user) (unless (string= "" sql-user) @@ -2701,13 +2763,13 @@ ((eq token 'server) (unless (string= "" sql-server) (list "." - (if (eq type :file) + (if (plist-member plist :file) (file-name-nondirectory sql-server) sql-server)))) ((eq token 'database) (unless (string= "" sql-database) (list "@" - (if (eq type :file) + (if (plist-member plist :file) (file-name-nondirectory sql-database) sql-database)))) @@ -3019,18 +3081,28 @@ :prompt-regexp)) (start nil)) (with-current-buffer buf + (toggle-read-only -1) (unless save-prior (erase-buffer)) (goto-char (point-max)) + (unless (zerop (buffer-size)) + (insert "\n")) (setq start (point))) ;; Run the command + (message "Executing SQL command...") (comint-redirect-send-command-to-process command buf proc nil t) (while (null comint-redirect-completed) (accept-process-output nil 1)) - - ;; Remove echo if there was one + (message "Executing SQL command...done") + + ;; Clean up the output results (with-current-buffer buf + ;; Remove trailing whitespace + (goto-char (point-max)) + (when (looking-back "[ \t\f\n\r]*" start) + (delete-region (match-beginning 0) (match-end 0))) + ;; Remove echo if there was one (goto-char start) (when (looking-at (concat "^" (regexp-quote command) "[\\n]")) (delete-region (match-beginning 0) (match-end 0))) @@ -3064,9 +3136,6 @@ ;; one group specified ((numberp regexp-groups) (match-string regexp-groups)) - ;; (buffer-substring-no-properties - ;; (match-beginning regexp-groups) - ;; (match-end regexp-groups))) ;; list of numbers; return the specified matches only ((consp regexp-groups) (mapcar (lambda (c) @@ -3084,6 +3153,79 @@ results))) (nreverse results))) +(defun sql-execute (sqlbuf outbuf command arg) + "Executes a command in a SQL interacive buffer and captures the output. + +The commands are run in SQLBUF and the output saved in OUTBUF. +COMMAND must be a string, a function or a list of such elements. +Functions are called with SQLBUF, OUTBUF and ARG as parameters; +strings are formatted with ARG and executed. + +If the results are empty the OUTBUF is deleted, otherwise the +buffer is popped into a view window. " + (mapc + (lambda (c) + (cond + ((stringp c) + (sql-redirect (if arg (format c arg) c) sqlbuf outbuf) t) + ((functionp c) + (apply c sqlbuf outbuf arg)) + (t (error "Unknown sql-execute item %s" c)))) + (if (consp command) command (cons command nil))) + + (setq outbuf (get-buffer outbuf)) + (if (zerop (buffer-size outbuf)) + (kill-buffer outbuf) + (let ((one-win (eq (selected-window) + (get-lru-window)))) + (with-current-buffer outbuf + (set-buffer-modified-p nil) + (toggle-read-only 1)) + (view-buffer-other-window outbuf) + (when one-win + (shrink-window-if-larger-than-buffer))))) + +(defun sql-execute-feature (sqlbuf outbuf feature enhanced arg) + "List objects or details in a separate display buffer." + (let (command) + (with-current-buffer sqlbuf + (setq command (sql-get-product-feature sql-product feature))) + (unless command + (error "%s does not support %s" sql-product feature)) + (when (consp command) + (setq command (if enhanced + (cdr command) + (car command)))) + (sql-execute sqlbuf outbuf command arg))) + +(defun sql-read-table-name (prompt) + "Read the name of a database table." + ;; TODO: Fetch table/view names from database and provide completion. + ;; Also implement thing-at-point if the buffer has valid names in it + ;; (i.e. sql-mode, sql-interactive-mode, or sql-list-all buffers) + (read-from-minibuffer prompt)) + +(defun sql-list-all (&optional enhanced) + "List all database objects." + (interactive "P") + (let ((sqlbuf (sql-find-sqli-buffer))) + (unless sqlbuf + (error "No SQL interactive buffer found")) + (sql-execute-feature sqlbuf "*List All*" :list-all enhanced nil))) + +(defun sql-list-table (name &optional enhanced) + "List the details of a database table. " + (interactive + (list (sql-read-table-name "Table name: ") + current-prefix-arg)) + (let ((sqlbuf (sql-find-sqli-buffer))) + (unless sqlbuf + (error "No SQL interactive buffer found")) + (unless name + (error "No table name specified")) + (sql-execute-feature sqlbuf (format "*List %s*" name) + :list-table enhanced name))) + ;;; SQL mode -- uses SQL interactive mode @@ -3313,6 +3455,14 @@ ;;; Connection handling +(defun sql-read-connection (prompt &optional initial default) + "Read a connection name." + (let ((completion-ignore-case t)) + (completing-read prompt + (mapcar (lambda (c) (car c)) + sql-connection-alist) + nil t initial 'sql-connection-history default))) + ;;;###autoload (defun sql-connect (connection) "Connect to an interactive session using CONNECTION settings. @@ -3326,12 +3476,7 @@ ;; 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 '(())))) + (list (sql-read-connection "Connection: " nil '(nil))) nil)) ;; Are there connections defined @@ -3365,10 +3510,10 @@ ;; the remaining params (w/o the connection params) (rem-params (sql-for-each-login login-params - (lambda (token type arg) + (lambda (token plist) (unless (member token set-params) - (if (or type arg) - (list token type arg) + (if plist + (cons token plist) token))))) ;; Remember the connection (sql-connection connection)) @@ -3409,7 +3554,7 @@ (append (list name) (sql-for-each-login `(product ,@login) - (lambda (token type arg) + (lambda (token plist) (cond ((eq token 'product) `(sql-product ',sql-product)) ((eq token 'user) `(sql-user ,sql-user)) @@ -3460,7 +3605,7 @@ (when (and (consp product) (not (cdr product)) (numberp (car product))) - (when (>= (car product) 16) + (when (>= (prefix-numeric-value product) 16) (when (not new-name) (setq new-name '(4))) (setq product '(4))))) @@ -3468,59 +3613,53 @@ ;; Get the value of product that we need (setq product (cond - ((equal product '(4)) ; C-u, 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) + ((= (prefix-numeric-value product) 4) ; C-u, prompt for product + (sql-read-product "SQL product: " sql-product)) (t sql-product))) ; Default to sql-product ;; If we have a product and it has a interactive mode (if product (when (sql-get-product-feature product :sqli-comint-func) - ;; If no new name specified, fall back on sql-buffer if its for - ;; the same product - (if (and (not new-name) - (sql-buffer-live-p sql-buffer product)) - (pop-to-buffer sql-buffer) - - ;; We have a new name or sql-buffer doesn't exist or match - ;; Start by remembering where we start - (let* ((start-buffer (current-buffer)) - 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 new-sqli-buffer (current-buffer)) - (let ((sql-interactive-product product)) - (sql-interactive-mode)) - - ;; Set the new buffer name - (when new-name - (sql-rename-buffer new-name)) - - ;; Set `sql-buffer' in the new buffer and the start buffer - (setq sql-buffer (buffer-name new-sqli-buffer)) - (with-current-buffer start-buffer + ;; If no new name specified, try to pop to an active SQL + ;; interactive for the same product + (let ((buf (sql-find-sqli-buffer product))) + (if (and (not new-name) buf) + (pop-to-buffer buf) + + ;; We have a new name or sql-buffer doesn't exist or match + ;; Start by remembering where we start + (let ((start-buffer (current-buffer)) + 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 new-sqli-buffer (current-buffer)) + (let ((sql-interactive-product product)) + (sql-interactive-mode)) + + ;; Set the new buffer name + (when new-name + (sql-rename-buffer new-name)) + + ;; Set `sql-buffer' in the new buffer and the start buffer (setq sql-buffer (buffer-name new-sqli-buffer)) - (run-hooks 'sql-set-sqli-hook)) - - ;; All done. - (message "Login...done") - (pop-to-buffer sql-buffer)))) + (with-current-buffer start-buffer + (setq sql-buffer (buffer-name new-sqli-buffer)) + (run-hooks 'sql-set-sqli-hook)) + + ;; All done. + (message "Login...done") + (pop-to-buffer sql-buffer))))) (message "No default SQL product defined. Set `sql-product'."))) (defun sql-comint (product params) @@ -3530,14 +3669,17 @@ passed as command line arguments." (let ((program (sql-get-product-feature product :sqli-program)) (buf-name "SQL")) + ;; make sure we can find the program + (unless (executable-find program) + (error "Unable to locate SQL program \'%s\'" program)) ;; Make sure buffer name is unique - (when (get-buffer (format "*%s*" buf-name)) + (when (sql-buffer-live-p (format "*%s*" buf-name)) (setq buf-name (format "SQL-%s" product)) - (when (get-buffer (format "*%s*" buf-name)) + (when (sql-buffer-live-p (format "*%s*" buf-name)) (let ((i 1)) - (while (get-buffer (format "*%s*" - (setq buf-name - (format "SQL-%s%d" product i)))) + (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)))) @@ -3980,6 +4122,8 @@ (setq params (append (list "-h" sql-server) params))) (if (not (string= "" sql-user)) (setq params (append (list "-U" sql-user) params))) + (if (not (= 0 sql-port)) + (setq params (append (list "-p" sql-port) params))) (sql-comint product params)))