aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/progmodes/sql.el
diff options
context:
space:
mode:
authorJoakim Verona2012-03-06 09:23:09 +0100
committerJoakim Verona2012-03-06 09:23:09 +0100
commit28485daaf752ff5264ed2f6a32ec15588beaa929 (patch)
treea480205aa664c61b1d212833144c0a2d44f7ac01 /lisp/progmodes/sql.el
parente8e42079e76ca6255bbd53312994ba8e1b3b0ee8 (diff)
parent2e86d8576c668e149cc100f3222bcf19b38019dc (diff)
downloademacs-28485daaf752ff5264ed2f6a32ec15588beaa929.tar.gz
emacs-28485daaf752ff5264ed2f6a32ec15588beaa929.zip
upstream
Diffstat (limited to 'lisp/progmodes/sql.el')
-rw-r--r--lisp/progmodes/sql.el187
1 files changed, 99 insertions, 88 deletions
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."
2853 "Read a password using PROMPT. Optional DEFAULT is password to start with." 2853 "Read a password using PROMPT. Optional DEFAULT is password to start with."
2854 (read-passwd prompt nil default)) 2854 (read-passwd prompt nil default))
2855 2855
2856(defun sql-get-login-ext (prompt last-value history-var plist) 2856(defun sql-get-login-ext (symbol prompt history-var plist)
2857 "Prompt user with extended login parameters. 2857 "Prompt user with extended login parameters.
2858 2858
2859The global value of SYMBOL is the last value and the global value
2860of the SYMBOL is set based on the user's input.
2861
2859If PLIST is nil, then the user is simply prompted for a string 2862If PLIST is nil, then the user is simply prompted for a string
2860value. 2863value.
2861 2864
@@ -2868,38 +2871,41 @@ regexp pattern specified in its value.
2868The `:completion' property prompts for a string specified by its 2871The `:completion' property prompts for a string specified by its
2869value. (The property value is used as the PREDICATE argument to 2872value. (The property value is used as the PREDICATE argument to
2870`completing-read'.)" 2873`completing-read'.)"
2871 (let* ((default (plist-get plist :default)) 2874 (set-default
2872 (prompt-def 2875 symbol
2873 (if default 2876 (let* ((default (plist-get plist :default))
2874 (if (string-match "\\(\\):[ \t]*\\'" prompt) 2877 (last-value (default-value symbol))
2875 (replace-match (format " (default \"%s\")" default) t t prompt 1) 2878 (prompt-def
2876 (replace-regexp-in-string "[ \t]*\\'" 2879 (if default
2877 (format " (default \"%s\") " default) 2880 (if (string-match "\\(\\):[ \t]*\\'" prompt)
2878 prompt t t)) 2881 (replace-match (format " (default \"%s\")" default) t t prompt 1)
2879 prompt)) 2882 (replace-regexp-in-string "[ \t]*\\'"
2880 (use-dialog-box nil)) 2883 (format " (default \"%s\") " default)
2881 (cond 2884 prompt t t))
2882 ((plist-member plist :file) 2885 prompt))
2883 (expand-file-name 2886 (use-dialog-box nil))
2884 (read-file-name prompt 2887 (cond
2885 (file-name-directory last-value) default t 2888 ((plist-member plist :file)
2886 (file-name-nondirectory last-value) 2889 (expand-file-name
2887 (when (plist-get plist :file) 2890 (read-file-name prompt
2888 `(lambda (f) 2891 (file-name-directory last-value) default t
2889 (string-match 2892 (file-name-nondirectory last-value)
2890 (concat "\\<" ,(plist-get plist :file) "\\>") 2893 (when (plist-get plist :file)
2891 (file-name-nondirectory f))))))) 2894 `(lambda (f)
2892 2895 (string-match
2893 ((plist-member plist :completion) 2896 (concat "\\<" ,(plist-get plist :file) "\\>")
2894 (completing-read prompt-def (plist-get plist :completion) nil t 2897 (file-name-nondirectory f)))))))
2895 last-value history-var default)) 2898
2896 2899 ((plist-member plist :completion)
2897 ((plist-get plist :number) 2900 (completing-read prompt-def (plist-get plist :completion) nil t
2898 (read-number prompt (or default last-value 0))) 2901 last-value history-var default))
2899 2902
2900 (t 2903 ((plist-get plist :number)
2901 (let ((r (read-from-minibuffer prompt-def last-value nil nil history-var nil))) 2904 (read-number prompt (or default last-value 0)))
2902 (if (string= "" r) (or default "") r)))))) 2905
2906 (t
2907 (let ((r (read-from-minibuffer prompt-def last-value nil nil history-var nil)))
2908 (if (string= "" r) (or default "") r)))))))
2903 2909
2904(defun sql-get-login (&rest what) 2910(defun sql-get-login (&rest what)
2905 "Get username, password and database from the user. 2911 "Get username, password and database from the user.
@@ -2937,28 +2943,20 @@ function like this: (sql-get-login 'user 'password 'database)."
2937 2943
2938 (cond 2944 (cond
2939 ((eq token 'user) ; user 2945 ((eq token 'user) ; user
2940 (setq sql-user 2946 (sql-get-login-ext 'sql-user "User: " 'sql-user-history plist))
2941 (sql-get-login-ext "User: " sql-user
2942 'sql-user-history plist)))
2943 2947
2944 ((eq token 'password) ; password 2948 ((eq token 'password) ; password
2945 (setq sql-password 2949 (setq-default sql-password
2946 (sql-read-passwd "Password: " sql-password))) 2950 (sql-read-passwd "Password: " sql-password)))
2947 2951
2948 ((eq token 'server) ; server 2952 ((eq token 'server) ; server
2949 (setq sql-server 2953 (sql-get-login-ext 'sql-server "Server: " 'sql-server-history plist))
2950 (sql-get-login-ext "Server: " sql-server
2951 'sql-server-history plist)))
2952 2954
2953 ((eq token 'database) ; database 2955 ((eq token 'database) ; database
2954 (setq sql-database 2956 (sql-get-login-ext 'sql-database "Database: " 'sql-database-history plist))
2955 (sql-get-login-ext "Database: " sql-database
2956 'sql-database-history plist)))
2957 2957
2958 ((eq token 'port) ; port 2958 ((eq token 'port) ; port
2959 (setq sql-port 2959 (sql-get-login-ext 'sql-port "Port: " nil (append '(:number t) plist))))))
2960 (sql-get-login-ext "Port: " sql-port
2961 nil (append '(:number t) plist)))))))
2962 what)) 2960 what))
2963 2961
2964(defun sql-find-sqli-buffer (&optional product connection) 2962(defun sql-find-sqli-buffer (&optional product connection)
@@ -3841,6 +3839,7 @@ you entered, right above the output it created.
3841 (set (make-local-variable 'sql-server) sql-server) 3839 (set (make-local-variable 'sql-server) sql-server)
3842 (set (make-local-variable 'sql-port) sql-port) 3840 (set (make-local-variable 'sql-port) sql-port)
3843 (set (make-local-variable 'sql-connection) sql-connection) 3841 (set (make-local-variable 'sql-connection) sql-connection)
3842 (setq-default sql-connection nil)
3844 ;; Contains the name of database objects 3843 ;; Contains the name of database objects
3845 (set (make-local-variable 'sql-contains-names) t) 3844 (set (make-local-variable 'sql-contains-names) t)
3846 ;; Keep track of existing object names 3845 ;; Keep track of existing object names
@@ -3935,43 +3934,50 @@ is specified in the connection settings."
3935 ;; Settings are defined 3934 ;; Settings are defined
3936 (if connect-set 3935 (if connect-set
3937 ;; Set the desired parameters 3936 ;; Set the desired parameters
3938 (eval `(let* 3937 (let (param-var login-params set-params rem-params)
3939 (,@(cdr connect-set) 3938
3940 ;; :sqli-login params variable 3939 ;; :sqli-login params variable
3941 (param-var (sql-get-product-feature sql-product 3940 (setq param-var
3942 :sqli-login nil t)) 3941 (sql-get-product-feature sql-product :sqli-login nil t))
3943 ;; :sqli-login params value 3942
3944 (login-params (sql-get-product-feature sql-product 3943 ;; :sqli-login params value
3945 :sqli-login)) 3944 (setq login-params
3946 ;; which params are in the connection 3945 (sql-get-product-feature sql-product :sqli-login))
3947 (set-params (mapcar 3946
3948 (lambda (v) 3947 ;; Params in the connection
3949 (cond 3948 (setq set-params
3950 ((eq (car v) 'sql-user) 'user) 3949 (mapcar
3951 ((eq (car v) 'sql-password) 'password) 3950 (lambda (v)
3952 ((eq (car v) 'sql-server) 'server) 3951 (cond
3953 ((eq (car v) 'sql-database) 'database) 3952 ((eq (car v) 'sql-user) 'user)
3954 ((eq (car v) 'sql-port) 'port) 3953 ((eq (car v) 'sql-password) 'password)
3955 (t (car v)))) 3954 ((eq (car v) 'sql-server) 'server)
3956 (cdr connect-set))) 3955 ((eq (car v) 'sql-database) 'database)
3957 ;; the remaining params (w/o the connection params) 3956 ((eq (car v) 'sql-port) 'port)
3958 (rem-params (sql-for-each-login 3957 (t (car v))))
3959 login-params 3958 (cdr connect-set)))
3960 (lambda (token plist) 3959
3961 (unless (member token set-params) 3960 ;; the remaining params (w/o the connection params)
3962 (if plist 3961 (setq rem-params
3963 (cons token plist) 3962 (sql-for-each-login login-params
3964 token)))))) 3963 (lambda (token plist)
3965 3964 (unless (member token set-params)
3966 ;; Set the remaining parameters and start the 3965 (if plist (cons token plist) token)))))
3967 ;; interactive session 3966
3968 (eval `(let ((sql-connection ,connection) 3967 ;; Set the parameters and start the interactive session
3969 (,param-var ',rem-params)) 3968 (mapc
3970 (sql-product-interactive sql-product 3969 (lambda (vv)
3971 new-name))))) 3970 (set-default (car vv) (eval (cadr vv))))
3971 (cdr connect-set))
3972 (setq-default sql-connection connection)
3973
3974 ;; Start the SQLi session with revised list of login parameters
3975 (eval `(let ((,param-var ',rem-params))
3976 (sql-product-interactive sql-product new-name))))
3972 3977
3973 (message "SQL Connection <%s> does not exist" connection) 3978 (message "SQL Connection <%s> does not exist" connection)
3974 nil))) 3979 nil)))
3980
3975 (message "No SQL Connections defined") 3981 (message "No SQL Connections defined")
3976 nil)) 3982 nil))
3977 3983
@@ -4101,9 +4107,14 @@ the call to \\[sql-product-interactive] with
4101 4107
4102 ;; Connect to database. 4108 ;; Connect to database.
4103 (message "Login...") 4109 (message "Login...")
4104 (funcall (sql-get-product-feature product :sqli-comint-func) 4110 (let ((sql-user (default-value 'sql-user))
4105 product 4111 (sql-password (default-value 'sql-password))
4106 (sql-get-product-feature product :sqli-options)) 4112 (sql-server (default-value 'sql-server))
4113 (sql-database (default-value 'sql-database))
4114 (sql-port (default-value 'sql-port)))
4115 (funcall (sql-get-product-feature product :sqli-comint-func)
4116 product
4117 (sql-get-product-feature product :sqli-options)))
4107 4118
4108 ;; Set SQLi mode. 4119 ;; Set SQLi mode.
4109 (let ((sql-interactive-product product)) 4120 (let ((sql-interactive-product product))
@@ -4113,7 +4124,7 @@ the call to \\[sql-product-interactive] with
4113 (setq new-sqli-buffer (current-buffer)) 4124 (setq new-sqli-buffer (current-buffer))
4114 (when new-name 4125 (when new-name
4115 (sql-rename-buffer new-name)) 4126 (sql-rename-buffer new-name))
4116 (set (make-local-variable 'sql-buffer) 4127 (set (make-local-variable 'sql-buffer)
4117 (buffer-name new-sqli-buffer)) 4128 (buffer-name new-sqli-buffer))
4118 4129
4119 ;; Set `sql-buffer' in the start buffer 4130 ;; Set `sql-buffer' in the start buffer