[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r100866: SQL Mode Version2.4 - Improv
|
From: |
Michael Mauger |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r100866: SQL Mode Version2.4 - Improved login prompting |
|
Date: |
Thu, 22 Jul 2010 20:59:43 -0400 |
|
User-agent: |
Bazaar (2.0.3) |
------------------------------------------------------------
revno: 100866
committer: Michael Mauger <address@hidden>
branch nick: trunk
timestamp: Thu 2010-07-22 20:59:43 -0400
message:
SQL Mode Version2.4 - Improved login prompting
* progmodes/sql.el: Version 2.4. Improved Login prompting.
(sql-login-params): New widget definition.
(sql-oracle-login-params, sql-mysql-login-params)
(sql-solid-login-params, sql-sybase-login-params)
(sql-informix-login-params, sql-ingres-login-params)
(sql-ms-login-params, sql-postgres-login-params)
(sql-interbase-login-params, sql-db2-login-params)
(sql-linter-login-params): Use it.
(sql-sqlite-login-params): Use it; Define "database" parameter as
a file name.
(sql-sqlite-program): Change to "sqlite3"
(sql-comint-sqlite): Make sure database name is complete.
(sql-for-each-login): New function.
(sql-connect, sql-save-connection): Use it.
(sql-get-login-ext): New function.
(sql-get-login): Use it.
(sql-make-alternate-buffer-name): Handle :file parameters.
modified:
etc/NEWS
lisp/ChangeLog
lisp/progmodes/sql.el
=== modified file 'etc/NEWS'
--- a/etc/NEWS 2010-07-21 01:56:55 +0000
+++ b/etc/NEWS 2010-07-23 00:59:43 +0000
@@ -269,6 +269,22 @@
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:
+
+ (server :file ARG)
+ (database :file ARG)
+ (server :completion ARG)
+ (database :completion ARG)
+
+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.
+
+When :completion is specified, the ARG corresponds to the PREDICATE
+argument to the `completing-read' function.
+
*** Added `sql-connection-alist' to record login parameter values.
An alist for recording different username, database and server
values. If there are multiple databases that you connect to the
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2010-07-22 12:15:31 +0000
+++ b/lisp/ChangeLog 2010-07-23 00:59:43 +0000
@@ -1,3 +1,23 @@
+2010-07-22 Michael R. Mauger <address@hidden>
+
+ * progmodes/sql.el: Version 2.4. Improved Login prompting.
+ (sql-login-params): New widget definition.
+ (sql-oracle-login-params, sql-mysql-login-params)
+ (sql-solid-login-params, sql-sybase-login-params)
+ (sql-informix-login-params, sql-ingres-login-params)
+ (sql-ms-login-params, sql-postgres-login-params)
+ (sql-interbase-login-params, sql-db2-login-params)
+ (sql-linter-login-params): Use it.
+ (sql-sqlite-login-params): Use it; Define "database" parameter as
+ a file name.
+ (sql-sqlite-program): Change to "sqlite3"
+ (sql-comint-sqlite): Make sure database name is complete.
+ (sql-for-each-login): New function.
+ (sql-connect, sql-save-connection): Use it.
+ (sql-get-login-ext): New function.
+ (sql-get-login): Use it.
+ (sql-make-alternate-buffer-name): Handle :file parameters.
+
2010-07-22 Juanma Barranquero <address@hidden>
* dired.el (dired-no-confirm): Document value t and fix defcustom to
=== modified file 'lisp/progmodes/sql.el'
--- a/lisp/progmodes/sql.el 2010-07-21 01:56:55 +0000
+++ b/lisp/progmodes/sql.el 2010-07-23 00:59:43 +0000
@@ -5,7 +5,7 @@
;; Author: Alex Schroeder <address@hidden>
;; Maintainer: Michael Mauger <address@hidden>
-;; 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
@@ -152,12 +152,7 @@
;; (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
@@ -287,6 +282,38 @@
: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
@@ -728,12 +755,7 @@
(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)
@@ -754,7 +776,7 @@
;; 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."
@@ -767,14 +789,9 @@
: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)
@@ -797,12 +814,7 @@
(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)
@@ -817,12 +829,7 @@
(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)
@@ -844,12 +851,7 @@
(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)
@@ -864,12 +866,7 @@
(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)
@@ -884,12 +881,7 @@
(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)
@@ -911,12 +903,7 @@
(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)
@@ -943,12 +930,7 @@
(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)
@@ -969,12 +951,7 @@
(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)
@@ -995,12 +972,7 @@
(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)
@@ -1021,12 +993,7 @@
(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)
@@ -2204,6 +2171,19 @@
(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)))
+
;;; Functions to switch highlighting
@@ -2365,6 +2345,38 @@
"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.
@@ -2382,33 +2394,48 @@
`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.
@@ -2511,42 +2538,49 @@
(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."
@@ -2950,87 +2984,7 @@
-;;; 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)
@@ -3082,12 +3036,13 @@
(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))
@@ -3125,16 +3080,15 @@
(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)))
@@ -3155,6 +3109,90 @@
sql-connection-alist)
tail))
+
+
+;;; 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.
@@ -3318,7 +3356,8 @@
;; 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)))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r100866: SQL Mode Version2.4 - Improved login prompting,
Michael Mauger <=