diff options
Diffstat (limited to 'lisp/progmodes/sql.el')
| -rw-r--r-- | lisp/progmodes/sql.el | 187 |
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 | ||
| 2859 | The global value of SYMBOL is the last value and the global value | ||
| 2860 | of the SYMBOL is set based on the user's input. | ||
| 2861 | |||
| 2859 | If PLIST is nil, then the user is simply prompted for a string | 2862 | If PLIST is nil, then the user is simply prompted for a string |
| 2860 | value. | 2863 | value. |
| 2861 | 2864 | ||
| @@ -2868,38 +2871,41 @@ regexp pattern specified in its value. | |||
| 2868 | The `:completion' property prompts for a string specified by its | 2871 | The `:completion' property prompts for a string specified by its |
| 2869 | value. (The property value is used as the PREDICATE argument to | 2872 | value. (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 |