emacs: lisp/progmodes/sql.el comparison

comparison lisp/progmodes/sql.el @ 110424:03a492f2d1ce

SQL Mode, Version 2.8 - sql-list-all and sql-list-table functions. * progmodes/sql.el: Version 2.8 (sql-login-params): Updated widget structure; changes still needed. (sql-product-alist): Add :list-all and :list-table features for SQLite, Postgres and MySQL products. (sql-redirect): Handle default value. (sql-execute, sql-execute-feature): New functions. (sql-read-table-name): New function. (sql-list-all, sql-list-table): New functions. User API (sql-mode-map, sql-interactive-mode-map): Add key definitions for above functions. (sql-mode-menu, sql-interactive-mode-menu): Add menu definitions for above functions. (sql-postgres-login-params): Add user and database defaults. (sql-buffer-live-p): Bug fix. (sql-product-history); New variable. (sql-read-product): New function. Use it. (sql-set-product, sql-product-interactive): Use it. (sql-connection-history): New variable. (sql-read-connection): New function. Use it. (sql-connect): New function. (sql-for-each-login): Redesign function interface. (sql-make-alternate-buffer-name, sql-save-connection): Use it. (sql-get-login-ext, sql-get-login): Use it. Handle default values. (sql-comint): Check for program. Existing live buffer. (sql-comint-postgres): Add port parameter.

author	Michael Mauger <mmaug@yahoo.com>
date	Sat, 18 Sep 2010 22:11:18 -0400
parents	ba7558616802
children	029e4783cbae

comparison

equal deleted inserted replaced

-:6c2baabc9d98
+:03a492f2d1ce
 ;; 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.7
+;; Version: 2.8
 ;; 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.
 ;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; Login parameter type
 (define-widget 'sql-login-params 'lazy
 "Widget definition of the login parameters list"
+;; FIXME: does not implement :default property for the user,
+;; database and server options.  Anybody have some guidance on how to
+;; do this.
 :tag "Login Parameters"
 :type '(repeat (choice
 (const user)
 (const password)
 (choice :tag "server"
 regexp)
 (list :tag "completion"
 (const :format "" server)
 (const :format "" :completion)
 (restricted-sexp
-:match-alternatives (listp symbolp))))
+:match-alternatives (listp stringp))))
 (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))))
+:match-alternatives (listp stringp))))
 (const port))))
 ;; SQL Product support
 (defvar sql-interactive-product nil
 :font-lock sql-mode-mysql-font-lock-keywords
 :sqli-program sql-mysql-program
 :sqli-options sql-mysql-options
 :sqli-login sql-mysql-login-params
 :sqli-comint-func sql-comint-mysql
+:list-all "SHOW TABLES;"
+:list-table "DESCRIBE %s;"
 :prompt-regexp "^mysql> "
 :prompt-length 6
 :prompt-cont-regexp "^    -> "
 :input-filter sql-remove-tabs-filter)
 :font-lock sql-mode-postgres-font-lock-keywords
 :sqli-program sql-postgres-program
 :sqli-options sql-postgres-options
 :sqli-login sql-postgres-login-params
 :sqli-comint-func sql-comint-postgres
+:list-all ("\\d+" . "\\dS+")
+:list-table ("\\d+ %s" . "\\dS+ %s")
 :prompt-regexp "^.*=[#>] "
 :prompt-length 5
 :prompt-cont-regexp "^.*[-(][#>] "
 :input-filter sql-remove-tabs-filter
 :terminator ("\\(^\\s-*\\\\g\\|;\\)" . ";"))
 :font-lock sql-mode-sqlite-font-lock-keywords
 :sqli-program sql-sqlite-program
 :sqli-options sql-sqlite-options
 :sqli-login sql-sqlite-login-params
 :sqli-comint-func sql-comint-sqlite
+:list-all ".tables"
+:list-table ".schema %s"
 :prompt-regexp "^sqlite> "
 :prompt-length 8
 :prompt-cont-regexp "^   ...> "
 :terminator ";")
 `sql-user', `sql-password',
 `sql-database' and `sql-server' to open a
 comint buffer and connect to the
 database.  Do product specific
 configuration of comint in this function.
+:list-all              Command string or function which produces
+a listing of all objects in the database.
+If it's a cons cell, then the car
+produces the standard list of objects and
+the cdr produces an enhanced list of
+objects.  What \"enhanced\" means is
+dependent on the SQL product and may not
+exist.  In general though, the
+\"enhanced\" list should include visible
+objects from other schemas.
+:list-table            Command string or function which produces
+a detailed listing of a specific database
+table.  If its a cons cell, then the car
+produces the standard list and the cdr
+produces an enhanced list.
 :prompt-regexp         regular expression string that matches
 the prompt issued by the product
 interpreter.
 add your name with a \"-U\" prefix (such as \"-Umark\") to the list."
 :type '(repeat string)
 :version "20.8"
 :group 'SQL)
-(defcustom sql-postgres-login-params '(user database server)
+(defcustom sql-postgres-login-params `((user :default ,(user-login-name))
+(database :default ,(user-login-name))
+server)
 "List of login parameters needed to connect to Postgres."
 :type 'sql-login-params
 :version "24.1"
 :group 'SQL)
 (defvar sql-server-history nil
 "History of servers used.")
 ;; Passwords are not kept in a history.
+(defvar sql-product-history nil
+"History of products used.")
+(defvar sql-connection-history nil
+"History of connections used.")
 (defvar sql-buffer nil
 "Current SQLi buffer.
 The global value of `sql-buffer' is the name of the latest SQLi buffer
 (and buffer
 (buffer-live-p buffer)
 (get-buffer-process buffer)
 (comint-check-proc buffer)
 (with-current-buffer buffer
-(and (derived-mode-p 'sql-product-interactive)
+(and (derived-mode-p 'sql-interactive-mode)
 (or (not product)
 (eq product sql-product)))))))
 ;; Keymap for sql-interactive-mode.
 (define-key map (kbd "C-j") 'sql-accumulate-and-indent)
 (define-key map (kbd "C-c C-w") 'sql-copy-column)
 (define-key map (kbd "O") 'sql-magic-go)
 (define-key map (kbd "o") 'sql-magic-go)
 (define-key map (kbd ";") 'sql-magic-semicolon)
+(define-key map (kbd "C-c C-l a") 'sql-list-all)
+(define-key map (kbd "C-c C-l t") 'sql-list-table)
 map)
 "Mode map used for `sql-interactive-mode'.
 Based on `comint-mode-map'.")
 ;; Keymap for sql-mode.
 (define-key map (kbd "C-c C-c") 'sql-send-paragraph)
 (define-key map (kbd "C-c C-r") 'sql-send-region)
 (define-key map (kbd "C-c C-s") 'sql-send-string)
 (define-key map (kbd "C-c C-b") 'sql-send-buffer)
 (define-key map (kbd "C-c C-i") 'sql-product-interactive)
+(define-key map (kbd "C-c C-l a") 'sql-list-all)
+(define-key map (kbd "C-c C-l t") 'sql-list-table)
 map)
 "Mode map used for `sql-mode'.")
 ;; easy menu for sql-mode.
 ["Send Paragraph" sql-send-paragraph (sql-buffer-live-p sql-buffer)]
 ["Send Region" sql-send-region (and mark-active
 				       (sql-buffer-live-p sql-buffer))]
 ["Send Buffer" sql-send-buffer (sql-buffer-live-p sql-buffer)]
 ["Send String" sql-send-string (sql-buffer-live-p sql-buffer)]
+"--"
+["List all objects" sql-list-all (sql-buffer-live-p sql-buffer)]
+["List table details" sql-list-table (sql-buffer-live-p sql-buffer)]
 "--"
 ["Start SQLi session" sql-product-interactive
 :visible (not sql-connection-alist)
 :enable (sql-get-product-feature sql-product :sqli-comint-func)]
 ("Start..."
 (easy-menu-define
 sql-interactive-mode-menu sql-interactive-mode-map
 "Menu for `sql-interactive-mode'."
 '("SQL"
 ["Rename Buffer" sql-rename-buffer t]
-["Save Connection" sql-save-connection (not sql-connection)]))
+["Save Connection" sql-save-connection (not sql-connection)]
+"--"
+["List all objects" sql-list-all t]
+["List table details" sql-list-table t]))
 ;; 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
 ;;; SQL Product support functions
+(defun sql-read-product (prompt &optional initial)
+"Read a valid SQL product."
+(let ((init (or (and initial (symbol-name initial)) "ansi")))
+(intern (completing-read
+prompt
+(mapcar (lambda (info) (symbol-name (car info)))
+sql-product-alist)
+nil 'require-match
+init 'sql-product-history init))))
 (defun sql-add-product (product display &rest plist)
 "Add support for a database product in `sql-mode'.
 Add PRODUCT to `sql-product-alist' which enables `sql-mode' to
 properly support syntax highlighting and interactive interaction.
 (delq nil
 (mapcar
 (lambda (param)
 (let ((token (or (and (listp param) (car param)) param))
-(type  (or (and (listp param) (nth 1 param)) nil))
+(plist (or (and (listp param) (cdr param)) nil)))
-(arg   (or (and (listp param) (nth 2 param)) nil)))
+(funcall body token plist)))
-(funcall body token type arg)))
 login-params)))
 ;;; Functions to switch highlighting
 				       (symbol-name sql-product)) "]"))))
 (defun sql-set-product (product)
 "Set `sql-product' to PRODUCT and enable appropriate highlighting."
 (interactive
-(list (completing-read "SQL product: "
+(list (sql-read-product "SQL product: ")))
-(mapcar (lambda (info) (symbol-name (car info)))
-sql-product-alist)
-nil 'require-match
-(or (and sql-product (symbol-name sql-product)) "ansi"))))
 (if (stringp product) (setq product (intern product)))
 (when (not (assoc product sql-product-alist))
 (error "SQL product %s is not supported; treated as ANSI" product)
 (setq product 'ansi))
 (defun sql-read-passwd (prompt &optional default)
 "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)
+(defun sql-get-login-ext (prompt last-value history-var plist)
 "Prompt user with extended login parameters.
-If TYPE is nil, then the user is simply prompted for a string
+If PLIST is nil, then the user is simply prompted for a string
 value.
-If TYPE is `:file', then the user is prompted for a file
+The property `:default' specifies the default value.  If the
-name that must match the regexp pattern specified in the ARG
+`:number' property is non-nil then ask for a number.
-argument.
+The `:file' property prompts for a file name that must match the
-If TYPE is `:completion', then the user is prompted for a string
+regexp pattern specified in its value.
-specified by ARG.  (ARG is used as the PREDICATE argument to
+The `:completion' property prompts for a string specified by its
+value.  (The property value is used as the PREDICATE argument to
 `completing-read'.)"
-(cond
+(let* ((default (plist-get plist :default))
-((eq type nil)
+(prompt-def
-(read-from-minibuffer prompt last-value nil nil history-var))
+(if default
+(if (string-match "\\(\\):[ \t]*\\'" prompt)
-((eq type :file)
+(replace-match (format " (default \"%s\")" default) t t prompt 1)
-(let ((use-dialog-box nil))
+(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) nil t
+(file-name-directory last-value) default t
 (file-name-nondirectory last-value)
-(if arg
+(when (plist-get plist :file)
 `(lambda (f)
-(string-match (concat "\\<" ,arg "\\>")
+(string-match
-(file-name-nondirectory f)))
+(concat "\\<" ,(plist-get plist :file) "\\>")
-nil)))))
+(file-name-nondirectory f)))))))
-((eq type :completion)
+((plist-member plist :completion)
-(completing-read prompt arg nil t last-value history-var))))
+(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)))
+(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.
 The variables `sql-user', `sql-password', `sql-server', and
 symbol `password', for the server if it contains the symbol
 `server', and for the database if it contains the symbol
 `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
+Each token may also be a list with the token in the car and a
-control or limit the values that can be supplied.  These can be
+plist of options as the cdr.  The following properties are
-of the form:
+supported:
-\(database :file \".+\\\\.EXT\")
+:file <filename-regexp>
-\(database :completion FUNCTION)
+:completion <list-of-strings-or-function>
+:default <default-value>
-The `server' token supports the same forms.
+:number t
 In order to ask the user for username, password and database, call the
 function like this: (sql-get-login 'user 'password 'database)."
 (interactive)
 (mapcar
 (lambda (w)
-(let ((token (or (and (listp w) (car w)) w))
+(let ((token (or (and (consp w) (car w)) w))
-(type  (or (and (listp w) (nth 1 w)) nil))
+(plist (or (and (consp w) (cdr w)) nil)))
-(arg   (or (and (listp w) (nth 2 w)) nil)))
+(cond
-(cond
+((eq token 'user)		; user
-((eq token 'user)		; user
+(setq sql-user
-(setq sql-user
+(sql-get-login-ext "User: " sql-user
-(read-from-minibuffer "User: " sql-user nil nil
+'sql-user-history plist)))
-'sql-user-history)))
+((eq token 'password)		; password
-((eq token 'password)		; password
+(setq sql-password
-(setq sql-password
+(sql-read-passwd "Password: " sql-password)))
-(sql-read-passwd "Password: " sql-password)))
+((eq token 'server)		; server
-((eq token 'server)		; server
+(setq sql-server
-(setq sql-server
+(sql-get-login-ext "Server: " sql-server
-(sql-get-login-ext "Server: " sql-server
+'sql-server-history plist)))
-'sql-server-history type arg)))
+((eq token 'database)		; database
-((eq token 'database)		; database
+(setq sql-database
-(setq sql-database
+(sql-get-login-ext "Database: " sql-database
-(sql-get-login-ext "Database: " sql-database
+'sql-database-history plist)))
-'sql-database-history type arg)))
+((eq token 'port)		; port
-((eq token 'port)		; port
+(setq sql-port
-(setq sql-port
+(sql-get-login-ext "Port: " sql-port
-(read-number "Port: " (if (numberp sql-port)
+nil (append '(:number t) plist)))))))
-sql-port
+what))
-0)))))))
-what))
+(defun sql-find-sqli-buffer (&optional product)
-(defun sql-find-sqli-buffer ()
 "Returns the name of the current default SQLi buffer or nil.
 In order to qualify, the SQLi buffer must be alive, be in
 `sql-interactive-mode' and have a process."
 (let ((buf  sql-buffer)
-(prod sql-product))
+(prod (or product sql-product)))
 (or
 ;; Current sql-buffer, if there is one.
 (and (sql-buffer-live-p buf prod)
 buf)
 ;; Global sql-buffer
 (apply 'concat
 (cdr
 (apply 'append nil
 (sql-for-each-login
 (sql-get-product-feature sql-product :sqli-login)
-(lambda (token type arg)
+(lambda (token plist)
 (cond
 ((eq token 'user)
 (unless (string= "" sql-user)
 (list "/" sql-user)))
 ((eq token 'port)
 (= 0 sql-port))
 (list ":" (number-to-string sql-port))))
 ((eq token 'server)
 (unless (string= "" sql-server)
 (list "."
-(if (eq type :file)
+(if (plist-member plist :file)
 (file-name-nondirectory sql-server)
 sql-server))))
 ((eq token 'database)
 (unless (string= "" sql-database)
 (list "@"
-(if (eq type :file)
+(if (plist-member plist :file)
 (file-name-nondirectory sql-database)
 sql-database))))
 ((eq token 'password) nil)
 (t                    nil))))))))
 (proc (get-buffer-process (current-buffer)))
 (comint-prompt-regexp (sql-get-product-feature sql-product
 :prompt-regexp))
 (start nil))
 (with-current-buffer buf
+(toggle-read-only -1)
 (unless save-prior
 (erase-buffer))
 (goto-char (point-max))
+(unless (zerop (buffer-size))
+(insert "\n"))
 (setq start (point)))
 ;; Run the command
+(message "Executing SQL command...")
 (comint-redirect-send-command-to-process command buf proc nil t)
 (while (null comint-redirect-completed)
 	(accept-process-output nil 1))
+(message "Executing SQL command...done")
-;; Remove echo if there was one
+;; Clean up the output results
 (with-current-buffer buf
+;; Remove trailing whitespace
+(goto-char (point-max))
+(when (looking-back "[ \t\f\n\r]*" start)
+(delete-region (match-beginning 0) (match-end 0)))
+;; Remove echo if there was one
 (goto-char start)
 (when (looking-at (concat "^" (regexp-quote command) "[\\n]"))
 (delete-region (match-beginning 0) (match-end 0)))
 (goto-char start)))))
 (push (match-string i) r))
 (nreverse r)))
 ;; one group specified
 ((numberp regexp-groups)
 (match-string regexp-groups))
-;; (buffer-substring-no-properties
-;;  (match-beginning regexp-groups)
-;;  (match-end regexp-groups)))
 ;; list of numbers; return the specified matches only
 ((consp regexp-groups)
 (mapcar (lambda (c)
 (cond
 ((numberp c) (match-string c))
 (t
 (error "sql-redirect-value: unknown REGEXP-GROUPS value - %s"
 regexp-groups)))
 results)))
 (nreverse results)))
+(defun sql-execute (sqlbuf outbuf command arg)
+"Executes a command in a SQL interacive buffer and captures the output.
+The commands are run in SQLBUF and the output saved in OUTBUF.
+COMMAND must be a string, a function or a list of such elements.
+Functions are called with SQLBUF, OUTBUF and ARG as parameters;
+strings are formatted with ARG and executed.
+If the results are empty the OUTBUF is deleted, otherwise the
+buffer is popped into a view window. "
+(mapc
+(lambda (c)
+(cond
+((stringp c)
+(sql-redirect (if arg (format c arg) c) sqlbuf outbuf) t)
+((functionp c)
+(apply c sqlbuf outbuf arg))
+(t (error "Unknown sql-execute item %s" c))))
+(if (consp command) command (cons command nil)))
+(setq outbuf (get-buffer outbuf))
+(if (zerop (buffer-size outbuf))
+(kill-buffer outbuf)
+(let ((one-win (eq (selected-window)
+(get-lru-window))))
+(with-current-buffer outbuf
+(set-buffer-modified-p nil)
+(toggle-read-only 1))
+(view-buffer-other-window outbuf)
+(when one-win
+(shrink-window-if-larger-than-buffer)))))
+(defun sql-execute-feature (sqlbuf outbuf feature enhanced arg)
+"List objects or details in a separate display buffer."
+(let (command)
+(with-current-buffer sqlbuf
+(setq command (sql-get-product-feature sql-product feature)))
+(unless command
+(error "%s does not support %s" sql-product feature))
+(when (consp command)
+(setq command (if enhanced
+(cdr command)
+(car command))))
+(sql-execute sqlbuf outbuf command arg)))
+(defun sql-read-table-name (prompt)
+"Read the name of a database table."
+;; TODO: Fetch table/view names from database and provide completion.
+;; Also implement thing-at-point if the buffer has valid names in it
+;; (i.e. sql-mode, sql-interactive-mode, or sql-list-all buffers)
+(read-from-minibuffer prompt))
+(defun sql-list-all (&optional enhanced)
+"List all database objects."
+(interactive "P")
+(let ((sqlbuf (sql-find-sqli-buffer)))
+(unless sqlbuf
+(error "No SQL interactive buffer found"))
+(sql-execute-feature sqlbuf "*List All*" :list-all enhanced nil)))
+(defun sql-list-table (name &optional enhanced)
+"List the details of a database table. "
+(interactive
+(list (sql-read-table-name "Table name: ")
+current-prefix-arg))
+(let ((sqlbuf (sql-find-sqli-buffer)))
+(unless sqlbuf
+(error "No SQL interactive buffer found"))
+(unless name
+(error "No table name specified"))
+(sql-execute-feature sqlbuf (format "*List %s*" name)
+:list-table enhanced name)))
 ;;; SQL mode -- uses SQL interactive mode
 ;;; Connection handling
+(defun sql-read-connection (prompt &optional initial default)
+"Read a connection name."
+(let ((completion-ignore-case t))
+(completing-read prompt
+(mapcar (lambda (c) (car c))
+sql-connection-alist)
+nil t initial 'sql-connection-history default)))
 ;;;###autoload
 (defun sql-connect (connection)
 "Connect to an interactive session using CONNECTION settings.
 See `sql-connection-alist' to see how to define connections and
 is specified in the connection settings."
 ;; Prompt for the connection from those defined in the alist
 (interactive
 (if sql-connection-alist
-(list
+(list (sql-read-connection "Connection: " nil '(nil)))
-(let ((completion-ignore-case t))
-(completing-read "Connection: "
-(mapcar (lambda (c) (car c))
-sql-connection-alist)
-nil t nil nil '(()))))
 nil))
 ;; Are there connections defined
 (if sql-connection-alist
 ;; Was one selected
 (t                          (car v))))
 (cdr connect-set)))
 ;; the remaining params (w/o the connection params)
 (rem-params   (sql-for-each-login
 login-params
-(lambda (token type arg)
+(lambda (token plist)
 (unless (member token set-params)
-(if (or type arg)
+(if plist
-(list token type arg)
+(cons token plist)
 token)))))
 ;; Remember the connection
 (sql-connection connection))
 ;; Set the remaining parameters and start the
 (message "Connection <%s> already exists" name)
 (setq connect
 (append (list name)
 (sql-for-each-login
 `(product ,@login)
-(lambda (token type arg)
+(lambda (token plist)
 (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))
 ;; Handle universal arguments if specified
 (when (not (or executing-kbd-macro noninteractive))
 (when (and (consp product)
 (not (cdr product))
 (numberp (car product)))
-(when (>= (car product) 16)
+(when (>= (prefix-numeric-value product) 16)
 (when (not new-name)
 (setq new-name '(4)))
 (setq product '(4)))))
 ;; Get the value of product that we need
 (setq product
 (cond
-((equal product '(4))          ; C-u, 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)
+((= (prefix-numeric-value product) 4) ; C-u, prompt for product
+(sql-read-product "SQL product: " sql-product))
 (t sql-product)))              ; Default to sql-product
 ;; If we have a product and it has a interactive mode
 (if product
 (when (sql-get-product-feature product :sqli-comint-func)
-;; If no new name specified, fall back on sql-buffer if its for
+;; If no new name specified, try to pop to an active SQL
-;; the same product
+;; interactive for the same product
-(if (and (not new-name)
+(let ((buf (sql-find-sqli-buffer product)))
-(sql-buffer-live-p sql-buffer product))
+(if (and (not new-name) buf)
-(pop-to-buffer sql-buffer)
+(pop-to-buffer buf)
 ;; We have a new name or sql-buffer doesn't exist or match
 ;; Start by remembering where we start
-(let* ((start-buffer (current-buffer))
+(let ((start-buffer (current-buffer))
 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 new-sqli-buffer (current-buffer))
 (let ((sql-interactive-product product))
 (sql-interactive-mode))
 ;; Set the new buffer name
 (when new-name
 (sql-rename-buffer new-name))
 ;; Set `sql-buffer' in the new buffer and the start buffer
-(setq sql-buffer (buffer-name new-sqli-buffer))
-(with-current-buffer start-buffer
 (setq sql-buffer (buffer-name new-sqli-buffer))
-(run-hooks 'sql-set-sqli-hook))
+(with-current-buffer start-buffer
+(setq sql-buffer (buffer-name new-sqli-buffer))
-;; All done.
+(run-hooks 'sql-set-sqli-hook))
-(message "Login...done")
-(pop-to-buffer sql-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))
 (buf-name "SQL"))
+;; make sure we can find the program
+(unless (executable-find program)
+(error "Unable to locate SQL program \'%s\'" program))
 ;; Make sure buffer name is unique
-(when (get-buffer (format "*%s*" buf-name))
+(when (sql-buffer-live-p (format "*%s*" buf-name))
 (setq buf-name (format "SQL-%s" product))
-(when (get-buffer (format "*%s*" buf-name))
+(when (sql-buffer-live-p (format "*%s*" buf-name))
 (let ((i 1))
-(while (get-buffer (format "*%s*"
+(while (sql-buffer-live-p
-(setq buf-name
+(format "*%s*"
-(format "SQL-%s%d" product i))))
+(setq buf-name (format "SQL-%s%d" product i))))
 (setq i (1+ i))))))
 (set-buffer
 (apply 'make-comint buf-name program nil params))))
 ;;;###autoload
 	(setq params (append params (list sql-database))))
 (if (not (string= "" sql-server))
 	(setq params (append (list "-h" sql-server) params)))
 (if (not (string= "" sql-user))
 	(setq params (append (list "-U" sql-user) params)))
+(if (not (= 0 sql-port))
+	(setq params (append (list "-p" sql-port) params)))
 (sql-comint product params)))
 ;;;###autoload

Mercurial > emacs

comparison lisp/progmodes/sql.el @ 110424:03a492f2d1ce