emacs: lisp/progmodes/sql.el comparison

comparison lisp/progmodes/sql.el @ 109482:c9df47f7bbf3

SQL Mode V2.3 - cleanup connection handling

author	Michael Mauger <mmaug@yahoo.com>
date	Tue, 20 Jul 2010 21:56:55 -0400
parents	597339bd6bef
children	b4b02bfd4d95

comparison

equal deleted inserted replaced

-:d12162869c07
+:c9df47f7bbf3
 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
 ;;   2007, 2008, 2009, 2010  Free Software Foundation, Inc.
 ;; Author: Alex Schroeder <alex@gnu.org>
 ;; Maintainer: Michael Mauger <mmaug@yahoo.com>
-;; Version: 2.2
+;; Version: 2.3
 ;; 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.
 ;;           (if (not (string= "" sql-user))
 ;;               (setq params (append (list "-U" sql-user) params)))
 ;;           (sql-comint product params)))
 ;;
 ;;     (sql-set-product-feature 'xyz
-;;                              :sqli-connect-func 'my-sql-comint-xyz)
+;;                              :sqli-comint-func 'my-sql-comint-xyz)
 ;; 6) Define a convienence function to invoke the SQL interpreter.
 ;;     (defun my-sql-xyz ()
 ;;       "Run ixyz by XyzDB as an inferior process."
 (require 'comint)
 ;; Need the following to allow GNU Emacs 19 to compile the file.
 (eval-when-compile
 (require 'regexp-opt))
 (require 'custom)
-(require 'assoc)
 (eval-when-compile ;; needed in Emacs 19, 20
-(setq max-specpdl-size 2000))
+(setq max-specpdl-size (max max-specpdl-size 2000)))
 (defvar font-lock-keyword-face)
 (defvar font-lock-set-defaults)
 (defvar font-lock-string-face)
 `sql-database'
 If a SQL-VARIABLE is part of the connection, it will not be
 prompted for during login."
-:type `(alist :key-type (symbol :tag "Connection")
+:type `(alist :key-type (string :tag "Connection")
 :value-type
 (set
 (group (const :tag "Product"  sql-product)
 (choice
 ,@(mapcar (lambda (prod-info)
 sql-product-alist)))
 (group (const :tag "Username" sql-user)     string)
 (group (const :tag "Password" sql-password) string)
 (group (const :tag "Server"   sql-server)   string)
 (group (const :tag "Database" sql-database) string)
-(group (const :tag "Port"     sql-port)     integer)))
+(group (const :tag "Port"     sql-port)     integer)
+(repeat :inline t
+(list :tab "Other"
+(symbol :tag " Variable Symbol")
+(sexp   :tag "Value Expression")))))
 :version "24.1"
 :group 'SQL)
 ;;;###autoload
 (defcustom sql-product 'ansi
 				       (get-buffer-process sql-buffer))]
 ["Send Buffer" sql-send-buffer (and (buffer-live-p sql-buffer)
 				       (get-buffer-process sql-buffer))]
 ["Send String" sql-send-string (and (buffer-live-p sql-buffer)
 				       (get-buffer-process sql-buffer))]
-["--" nil nil]
+"--"
-["Start SQLi session" sql-product-interactive (sql-get-product-feature sql-product :sqli-comint-func)]
+["Start SQLi session" sql-product-interactive
+:visible (not sql-connection-alist)
+:enable (sql-get-product-feature sql-product :sqli-comint-func)]
+("Start..."
+:visible sql-connection-alist
+:filter sql-connection-menu-filter
+"--"
+["New SQLi Session" sql-product-interactive (sql-get-product-feature sql-product :sqli-comint-func)])
+["--"
+:visible sql-connection-alist]
 ["Show SQLi buffer" sql-show-sqli-buffer t]
 ["Set SQLi buffer" sql-set-sqli-buffer t]
 ["Pop to SQLi buffer after send"
 sql-toggle-pop-to-buffer-after-send-region
 :style toggle
 (easy-menu-define
 sql-interactive-mode-menu sql-interactive-mode-map
 "Menu for `sql-interactive-mode'."
 '("SQL"
-["Rename Buffer" sql-rename-buffer t]))
+["Rename Buffer" sql-rename-buffer t]
+["Save Connection" sql-save-connection (not sql-connection)]))
 ;; Abbreviations -- if you want more of them, define them in your
 ;; ~/.emacs file.  Abbrevs have to be enabled in your ~/.emacs, too.
 (defvar sql-mode-abbrev-table nil
 ;; Add a menu item to the SQL->Product menu
 (easy-menu-add-item sql-mode-menu '("Product")
 			;; Each product is represented by a radio
 			;; button with it's display name.
 			`[,display
-			  (lambda () (interactive) (sql-set-product ',product))
+			  (sql-set-product ',product)
 			 :style radio
 			 :selected (eq sql-product ',product)]
 			;; Maintain the product list in
 			;; (case-insensitive) alphabetic order of the
 			;; display names.  Loop thru each keymap item
 (member feature sql-indirect-features)
 (not not-indirect)
 (symbolp v))
 (symbol-value v)
 v))
-(message "`%s' is not a known product; use `sql-add-product' to add it first." product))))
+(message "`%s' is not a known product; use `sql-add-product' to add it first." product)
+nil)))
 (defun sql-product-font-lock (keywords-only imenu)
 "Configure font-lock and imenu with product-specific settings.
 The KEYWORDS-ONLY flag is passed to font-lock to specify whether
 (message "%s has no SQLi buffer set." (buffer-name (current-buffer)))
 (if (null (get-buffer-process sql-buffer))
 	(message "Buffer %s has no process." (buffer-name sql-buffer))
 (message "Current SQLi buffer is %s." (buffer-name sql-buffer)))))
-(defun sql--alt-buffer-part (delim part)
-(unless (string= "" part)
-(list delim part)))
-(defun sql--alt-if-not-empty (s)
-(if (string= "" s) nil s))
 (defun sql-make-alternate-buffer-name ()
 "Return a string that can be used to rename a SQLi buffer.
 This is used to set `sql-alternate-buffer-name' within
 `sql-interactive-mode'.
 parameter.
 If all else fails, the alternate name would be the user and
 server/database name."
-(or
+(let ((name ""))
-;; If started by sql-connect, use that
-(sql--alt-if-not-empty
+;; Try using the :sqli-login setting
-(when sql-connection (symbol-name sql-connection)))
+(when (string= "" (or name ""))
+(setq name
-;; based on :sqli-login setting
+(apply 'concat
-(sql--alt-if-not-empty
+(apply 'append nil
-(apply 'concat
+(mapcar
-(cdr
+(lambda (v)
-(apply 'append nil
+(cond
-(mapcar
+((eq v 'user)     (list "/" sql-user))
-(lambda (v)
+((eq v 'server)   (list "." sql-server))
-(cond
+((eq v 'database) (list "@" sql-database))
-((eq v 'user)     (sql--alt-buffer-part "/" sql-user))
+((eq v 'port)     (list ":" sql-port))
-((eq v 'server)   (sql--alt-buffer-part "@" sql-server))
-((eq v 'database) (sql--alt-buffer-part "@" sql-database))
+((eq v 'password) nil)
-((eq v 'port)     (sql--alt-buffer-part ":" sql-port))
+(t                nil)))
+(sql-get-product-feature sql-product :sqli-login))))))
-((eq v 'password) nil)
-(t                nil)))
+;; Default: username/server format
-(sql-get-product-feature sql-product :sqli-login))))))
+(when (string= "" (or name ""))
+(setq name
-;; Default: username/server format
+(concat " "
-(sql--alt-if-not-empty
+(if (string= "" sql-user)
-(concat (if (string= "" sql-user)
+(if (string= "" (user-login-name))
-(if (string= "" (user-login-name))
+()
-()
+(concat (user-login-name) "/"))
-(concat (user-login-name) "/"))
+(concat sql-user "/"))
-(concat sql-user "/"))
+(if (string= "" sql-database)
-(if (string= "" sql-database)
+(if (string= "" sql-server)
-(if (string= "" sql-server)
+(system-name)
-(system-name)
+sql-server)
-sql-server)
+sql-database))))
-sql-database)))))
+;; Return the final string; prefixed by the connection name
+(if sql-connection
+(format "<%s>%s" sql-connection (or name ""))
+(substring (or name " ") 1))))
 (defun sql-rename-buffer ()
 "Rename a SQLi buffer."
 (interactive)
 (rename-buffer (format "*SQL: %s*" sql-alternate-buffer-name) t))
 (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"))))
-((symbolp product) product)    ; Product specified
+((and product                  ; Product specified
+(symbolp product)) product)
 (t sql-product)))              ; Default to sql-product
-(when (sql-get-product-feature product :sqli-comint-func)
+(if product
-(if (and sql-buffer
+(when (sql-get-product-feature product :sqli-comint-func)
-(buffer-live-p sql-buffer)
+(if (and sql-buffer
-	     (comint-check-proc sql-buffer))
+(buffer-live-p sql-buffer)
-	(pop-to-buffer 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
+;; Is the current buffer in sql-mode and
-(let* ((start-buffer
+;; there is a buffer local setting of sql-buffer
-	      (and (derived-mode-p 'sql-mode)
+(let* ((start-buffer
-		   (current-buffer)))
+(and (derived-mode-p 'sql-mode)
-	     (start-sql-buffer
+(current-buffer)))
-	      (and start-buffer
+(start-sql-buffer
-		   (let (found)
+(and start-buffer
-		     (dolist (var (buffer-local-variables))
+(let (found)
-		       (and (consp var)
+(dolist (var (buffer-local-variables))
-			    (eq (car var) 'sql-buffer)
+(and (consp var)
-			    (buffer-live-p (cdr var))
+(eq (car var) 'sql-buffer)
-			    (get-buffer-process (cdr var))
+(buffer-live-p (cdr var))
-			    (setq found (cdr var))))
+(get-buffer-process (cdr var))
-		     found)))
+(setq found (cdr var))))
-	     new-sqli-buffer)
+found)))
+new-sqli-buffer)
-	;; Get credentials.
-	(apply 'sql-get-login (sql-get-product-feature product :sqli-login))
+;; Get credentials.
+(apply 'sql-get-login (sql-get-product-feature product :sqli-login))
-	;; Connect to database.
-	(message "Login...")
+;; Connect to database.
-	(funcall (sql-get-product-feature product :sqli-comint-func)
+(message "Login...")
-product
+(funcall (sql-get-product-feature product :sqli-comint-func)
-(sql-get-product-feature product :sqli-options))
+product
+(sql-get-product-feature product :sqli-options))
-	;; Set SQLi mode.
-	(setq sql-interactive-product product
+;; Set SQLi mode.
-	      new-sqli-buffer (current-buffer)
+(setq sql-interactive-product product
-	      sql-buffer new-sqli-buffer)
+new-sqli-buffer (current-buffer)
-	(sql-interactive-mode)
+sql-buffer new-sqli-buffer)
+(sql-interactive-mode)
-	;; Set `sql-buffer' in the start buffer
-	(when (and start-buffer (not start-sql-buffer))
+;; Set `sql-buffer' in the start buffer
-	  (with-current-buffer start-buffer
+(when (and start-buffer (not start-sql-buffer))
-	    (setq sql-buffer new-sqli-buffer)))
+(with-current-buffer start-buffer
+(setq sql-buffer new-sqli-buffer)))
-	;; All done.
-	(message "Login...done")
+;; All done.
-	(pop-to-buffer sql-buffer)))))
+(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
 ;; Prompt for the connection from those defined in the alist
 (interactive
 (if sql-connection-alist
 (list
-(intern
+(let ((completion-ignore-case t))
 (completing-read "Connection: "
-(mapcar (lambda (c) (symbol-name (car c)))
+(mapcar (lambda (c) (car c))
 sql-connection-alist)
-nil t)))
+nil t nil nil '(()))))
 nil))
 ;; Are there connections defined
 (if sql-connection-alist
 ;; Was one selected
 (when connection
 ;; Get connection settings
-(let ((connect-set  (aget sql-connection-alist connection)))
+(let ((connect-set  (assoc connection sql-connection-alist)))
 ;; Settings are defined
 (if connect-set
 ;; Set the desired parameters
 (eval `(let*
-(,@connect-set
+(,@(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
 ((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))))
-connect-set))
+(cdr connect-set)))
 ;; the remaining params (w/o the connection params)
-(rem-params   (apply 'append nil
+(rem-params   (delq nil
 (mapcar
 (lambda (l)
 (unless (member l set-params)
-(list l)))
+l))
 login-params)))
 ;; Remember the connection
 (sql-connection connection))
 ;; Set the remaining parameters and start the
 ;; interactive session
 (eval `(let ((,param-var ',rem-params))
 (sql-product-interactive sql-product)))))
-(message "SQL Connection \"%s\" does not exist" connection)
+(message "SQL Connection <%s> does not exist" connection)
 nil)))
 (message "No SQL Connections defined")
 nil))
+(defun sql-save-connection (name)
+"Captures the connection information of the current SQLi session.
+The information is appended to `sql-connection-alist' and
+optionally is saved to the user's init file."
+(interactive "sNew connection name: ")
+(if sql-connection
+(message "This session was started by a connection; it's already been saved.")
+(let ((login (sql-get-product-feature sql-product :sqli-login))
+(alist sql-connection-alist)
+connect)
+;; Remove the existing connection if the user says so
+(when (and (assoc name alist)
+(yes-or-no-p (format "Replace connection definition <%s>? " name)))
+(setq alist (assq-delete-all name alist)))
+;; Add the new connection if it doesn't exist
+(if (assoc name alist)
+(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)))))
+(setq alist (append alist (list connect)))
+;; confirm whether we want to save the connections
+(if (yes-or-no-p "Save the connections for future sessions? ")
+(customize-save-variable 'sql-connection-alist alist)
+(customize-set-variable 'sql-connection-alist alist))))))
+(defun sql-connection-menu-filter (tail)
+"Generates menu entries for using each connection."
+(append
+(mapcar
+(lambda (conn)
+(vector
+(format "Connection <%s>" (car conn))
+(list 'sql-connect (car conn))
+t))
+sql-connection-alist)
+tail))
 ;;;###autoload
 (defun sql-oracle ()
 "Run sqlplus by Oracle as an inferior process.

Mercurial > emacs

comparison lisp/progmodes/sql.el @ 109482:c9df47f7bbf3