diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 85af5f8ec78..8df640a3c99 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2012-03-01 Michael R. Mauger + + * progmodes/sql.el: Bug fix + (sql-get-login-ext): Save login values in globals. + (sql-get-login): Use new version of `sql-get-login-ext'. + (sql-interactive-mode): Set global `sql-connection' to nil. + (sql-connect): Set global values for connection. + (sql-product-interactive): Save global values as buffer local. + 2012-02-29 Leo Liu * abbrev.el (define-abbrevs): Reset sys to nil. diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index f5bfe526aae..56f42e31cf1 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -2853,9 +2853,12 @@ appended to the SQLi buffer without disturbing your SQL buffer." "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 plist) +(defun sql-get-login-ext (symbol prompt history-var plist) "Prompt user with extended login parameters. +The global value of SYMBOL is the last value and the global value +of the SYMBOL is set based on the user's input. + If PLIST is nil, then the user is simply prompted for a string value. @@ -2868,38 +2871,41 @@ 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'.)" - (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) default t - (file-name-nondirectory last-value) - (when (plist-get plist :file) - `(lambda (f) - (string-match - (concat "\\<" ,(plist-get plist :file) "\\>") - (file-name-nondirectory f))))))) + (set-default + symbol + (let* ((default (plist-get plist :default)) + (last-value (default-value symbol)) + (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) default t + (file-name-nondirectory last-value) + (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-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))) + ((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)))))) + (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. @@ -2937,28 +2943,20 @@ function like this: (sql-get-login 'user 'password 'database)." (cond ((eq token 'user) ; user - (setq sql-user - (sql-get-login-ext "User: " sql-user - 'sql-user-history plist))) + (sql-get-login-ext 'sql-user "User: " 'sql-user-history plist)) - ((eq token 'password) ; password - (setq sql-password - (sql-read-passwd "Password: " sql-password))) + ((eq token 'password) ; password + (setq-default 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 'server) ; server + (sql-get-login-ext 'sql-server "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 'database) ; database + (sql-get-login-ext 'sql-database "Database: " 'sql-database-history plist)) ((eq token 'port) ; port - (setq sql-port - (sql-get-login-ext "Port: " sql-port - nil (append '(:number t) plist))))))) + (sql-get-login-ext 'sql-port "Port: " nil (append '(:number t) plist)))))) what)) (defun sql-find-sqli-buffer (&optional product connection) @@ -3841,6 +3839,7 @@ you entered, right above the output it created. (set (make-local-variable 'sql-server) sql-server) (set (make-local-variable 'sql-port) sql-port) (set (make-local-variable 'sql-connection) sql-connection) + (setq-default sql-connection nil) ;; Contains the name of database objects (set (make-local-variable 'sql-contains-names) t) ;; Keep track of existing object names @@ -3935,43 +3934,50 @@ is specified in the connection settings." ;; 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 plist) - (unless (member token set-params) - (if plist - (cons token plist) - token)))))) + (let (param-var login-params set-params rem-params) - ;; Set the remaining parameters and start the - ;; interactive session - (eval `(let ((sql-connection ,connection) - (,param-var ',rem-params)) - (sql-product-interactive sql-product - new-name))))) + ;; :sqli-login params variable + (setq param-var + (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)) + + ;; Params in the connection + (setq 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) + (setq rem-params + (sql-for-each-login login-params + (lambda (token plist) + (unless (member token set-params) + (if plist (cons token plist) token))))) + + ;; Set the parameters and start the interactive session + (mapc + (lambda (vv) + (set-default (car vv) (eval (cadr vv)))) + (cdr connect-set)) + (setq-default sql-connection connection) + + ;; Start the SQLi session with revised list of login parameters + (eval `(let ((,param-var ',rem-params)) + (sql-product-interactive sql-product new-name)))) (message "SQL Connection <%s> does not exist" connection) nil))) + (message "No SQL Connections defined") nil)) @@ -4101,9 +4107,14 @@ the call to \\[sql-product-interactive] with ;; Connect to database. (message "Login...") - (funcall (sql-get-product-feature product :sqli-comint-func) - product - (sql-get-product-feature product :sqli-options)) + (let ((sql-user (default-value 'sql-user)) + (sql-password (default-value 'sql-password)) + (sql-server (default-value 'sql-server)) + (sql-database (default-value 'sql-database)) + (sql-port (default-value 'sql-port))) + (funcall (sql-get-product-feature product :sqli-comint-func) + product + (sql-get-product-feature product :sqli-options))) ;; Set SQLi mode. (let ((sql-interactive-product product)) @@ -4113,7 +4124,7 @@ the call to \\[sql-product-interactive] with (setq new-sqli-buffer (current-buffer)) (when new-name (sql-rename-buffer new-name)) - (set (make-local-variable 'sql-buffer) + (set (make-local-variable 'sql-buffer) (buffer-name new-sqli-buffer)) ;; Set `sql-buffer' in the start buffer