emacs: lisp/progmodes/sql.el comparison

comparison lisp/progmodes/sql.el @ 110326:ba7558616802

SQL Mode 2.7: Code cleanup and primatives for SQL redirection * progmodes/sql.el: Version 2.7. (sql-buffer-live-p): Improve detection. (sql-find-sqli-buffer, sql-set-sqli-buffer-generally) (sql-set-sqli-buffer): Use it. (sql-product-interactive): Run `sql-set-sqli-hook'. (sql-rename-buffer): Code cleanup. (sql-redirect, sql-redirect-value): New functions. More to come.

author	Michael Mauger <mmaug@yahoo.com>
date	Mon, 13 Sep 2010 16:05:23 -0400
parents	14a601b405fc
children	03a492f2d1ce

comparison

equal deleted inserted replaced

-:ec11d41deaa6
+:ba7558616802
 ;; 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.6
+;; Version: 2.7
 ;; 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.
 (defvar sql-alternate-buffer-name nil
 "Buffer-local string used to possibly rename the SQLi buffer.
 Used by `sql-rename-buffer'.")
-(defun sql-buffer-live-p (buffer)
+(defun sql-buffer-live-p (buffer &optional product)
-"Returns non-nil if the process associated with buffer is live."
+"Returns non-nil if the process associated with buffer is live.
-(and buffer
-(buffer-live-p (get-buffer buffer))
+BUFFER can be a buffer object or a buffer name.  The buffer must
-(get-buffer-process buffer)))
+be a live buffer, have an running process attached to it, be in
+`sql-interactive-mode', and, if PRODUCT is specified, it's
+`sql-product' must match."
+(when buffer
+(setq buffer (get-buffer 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)
+(or (not product)
+(eq product sql-product)))))))
 ;; Keymap for sql-interactive-mode.
 (defvar sql-interactive-mode-map
 (let ((map (make-sparse-keymap)))
 (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 ((default-buffer (default-value 'sql-buffer))
+(let ((buf  sql-buffer)
-(current-product sql-product))
+(prod sql-product))
-(if (sql-buffer-live-p default-buffer)
+(or
-	default-buffer
+;; Current sql-buffer, if there is one.
-(save-current-buffer
+(and (sql-buffer-live-p buf prod)
-	(let ((buflist (buffer-list))
+buf)
-	      (found))
+;; Global sql-buffer
-	  (while (not (or (null buflist)
+(and (setq buf (default-value 'sql-buffer))
-			  found))
+(sql-buffer-live-p buf prod)
-	    (let ((candidate (car buflist)))
+buf)
-	      (set-buffer candidate)
+;; Look thru each buffer
-	      (if (and (sql-buffer-live-p candidate)
+(car (apply 'append
-(derived-mode-p 'sql-interactive-mode)
+(mapcar (lambda (b)
-(eq sql-product current-product))
+(and (sql-buffer-live-p b prod)
-		  (setq found (buffer-name candidate)))
+(list (buffer-name b))))
-	      (setq buflist (cdr buflist))))
+(buffer-list)))))))
-	  found)))))
 (defun sql-set-sqli-buffer-generally ()
 "Set SQLi buffer for all SQL buffers that have none.
 This function checks all SQL buffers for their SQLi buffer.  If their
 SQLi buffer is nonexistent or has no process, it is set to the current
 (setq-default sql-buffer default-buffer)
 (while (not (null buflist))
 	(let ((candidate (car buflist)))
 	  (set-buffer candidate)
 	  (if (and (derived-mode-p 'sql-mode)
-		   (not (buffer-live-p sql-buffer)))
+		   (not (sql-buffer-live-p sql-buffer)))
 	      (progn
 		(setq sql-buffer default-buffer)
-		(run-hooks 'sql-set-sqli-hook))))
+		(when default-buffer
+(run-hooks 'sql-set-sqli-hook)))))
 	(setq buflist (cdr buflist))))))
 (defun sql-set-sqli-buffer ()
 "Set the SQLi buffer SQL strings are sent to.
 If you call it from anywhere else, it sets the global copy of
 `sql-buffer'."
 (interactive)
 (let ((default-buffer (sql-find-sqli-buffer)))
 (if (null default-buffer)
-	(error "There is no suitable SQLi buffer"))
+(error "There is no suitable SQLi buffer")
-(let ((new-buffer
+(let ((new-buffer (read-buffer "New SQLi buffer: " default-buffer t)))
-	   (get-buffer
+(if (null (sql-buffer-live-p new-buffer))
-	    (read-buffer "New SQLi buffer: " default-buffer t))))
+(error "Buffer %s is not a working SQLi buffer" new-buffer)
-(if (null (get-buffer-process new-buffer))
+(when new-buffer
-	  (error "Buffer %s has no process" (buffer-name new-buffer)))
+(setq sql-buffer new-buffer)
-(if (null (with-current-buffer new-buffer
+(run-hooks 'sql-set-sqli-hook)))))))
-		  (derived-mode-p 'sql-interactive-mode)))
-	  (error "Buffer %s is no SQLi buffer" (buffer-name new-buffer)))
-(if new-buffer
-	  (progn
-	    (setq sql-buffer (buffer-name new-buffer))
-	    (run-hooks 'sql-set-sqli-hook))))))
 (defun sql-show-sqli-buffer ()
 "Show the name of current SQLi buffer.
 This is the buffer SQL strings are sent to.  It is stored in the
 (interactive "P")
 (if (not (derived-mode-p 'sql-interactive-mode))
 (message "Current buffer is not a SQL interactive buffer")
-(cond
+(setq sql-alternate-buffer-name
-((stringp new-name)
+(cond
-(setq sql-alternate-buffer-name new-name))
+((stringp new-name) new-name)
-((listp new-name)
+((consp new-name)
-(setq sql-alternate-buffer-name
 (read-string "Buffer name (\"*SQL: XXX*\"; enter `XXX'): "
-sql-alternate-buffer-name))))
+sql-alternate-buffer-name))
+(t                  sql-alternate-buffer-name)))
 (rename-buffer (if (string= "" sql-alternate-buffer-name)
 "*SQL*"
 (format "*SQL: %s*" sql-alternate-buffer-name))
 t)))
 (interactive "P")
 (if value
 (setq sql-pop-to-buffer-after-send-region value)
 (setq sql-pop-to-buffer-after-send-region
 	  (null sql-pop-to-buffer-after-send-region))))
+;;; Redirect output functions
+(defun sql-redirect (command combuf &optional outbuf save-prior)
+"Execute the SQL command and send output to OUTBUF.
+COMBUF must be an active SQL interactive buffer.  OUTBUF may be
+an existing buffer, or the name of a non-existing buffer.  If
+omitted the output is sent to a temporary buffer which will be
+killed after the command completes.  COMMAND should be a string
+of commands accepted by the SQLi program."
+(with-current-buffer combuf
+(let ((buf  (get-buffer-create (or outbuf " *SQL-Redirect*")))
+(proc (get-buffer-process (current-buffer)))
+(comint-prompt-regexp (sql-get-product-feature sql-product
+:prompt-regexp))
+(start nil))
+(with-current-buffer buf
+(unless save-prior
+(erase-buffer))
+(goto-char (point-max))
+(setq start (point)))
+;; Run the command
+(comint-redirect-send-command-to-process command buf proc nil t)
+(while (null comint-redirect-completed)
+	(accept-process-output nil 1))
+;; Remove echo if there was one
+(with-current-buffer buf
+(goto-char start)
+(when (looking-at (concat "^" (regexp-quote command) "[\\n]"))
+(delete-region (match-beginning 0) (match-end 0)))
+(goto-char start)))))
+(defun sql-redirect-value (command combuf regexp &optional regexp-groups)
+"Execute the SQL command and return part of result.
+COMBUF must be an active SQL interactive buffer.  COMMAND should
+be a string of commands accepted by the SQLi program.  From the
+output, the REGEXP is repeatedly matched and the list of
+REGEXP-GROUPS submatches is returned.  This behaves much like
+\\[comint-redirect-results-list-from-process] but instead of
+returning a single submatch it returns a list of each submatch
+for each match."
+(let ((outbuf " *SQL-Redirect-values*")
+(results nil))
+(sql-redirect command combuf outbuf nil)
+(with-current-buffer outbuf
+(while (re-search-forward regexp nil t)
+	(push
+(cond
+;; no groups-return all of them
+((null regexp-groups)
+(let ((i 1)
+(r nil))
+(while (match-beginning i)
+(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))
+((stringp c) (match-substitute-replacement c))
+(t (error "sql-redirect-value: unknown REGEXP-GROUPS value - %s" c))))
+regexp-groups))
+;; String is specified; return replacement string
+((stringp regexp-groups)
+(match-substitute-replacement regexp-groups))
+(t
+(error "sql-redirect-value: unknown REGEXP-GROUPS value - %s"
+regexp-groups)))
+results)))
+(nreverse results)))
 ;;; SQL mode -- uses SQL interactive mode
 \(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
 (interactive "P")
 ;; Handle universal arguments if specified
 (when (not (or executing-kbd-macro noninteractive))
-(when (and (listp product)
+(when (and (consp product)
 (not (cdr product))
 (numberp (car product)))
 (when (>= (car product) 16)
 (when (not new-name)
 (setq new-name '(4)))
 (if product
 (when (sql-get-product-feature product :sqli-comint-func)
 ;; If no new name specified, fall back on sql-buffer if its for
 ;; the same product
 (if (and (not new-name)
-sql-buffer
+(sql-buffer-live-p sql-buffer product))
-(sql-buffer-live-p sql-buffer)
-(comint-check-proc sql-buffer)
-(eq product (with-current-buffer sql-buffer sql-product)))
 (pop-to-buffer sql-buffer)
 ;; We have a new name or sql-buffer doesn't exist or match
 ;; Start by remembering where we start
 (let* ((start-buffer (current-buffer))
 ;; Set the new buffer name
 (when new-name
 (sql-rename-buffer new-name))
-;; Set `sql-buffer' in the start buffer
+;; 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)))
+(setq sql-buffer (buffer-name new-sqli-buffer))
+(run-hooks 'sql-set-sqli-hook))
 ;; All done.
 (message "Login...done")
 (pop-to-buffer sql-buffer))))
 (message "No default SQL product defined.  Set `sql-product'.")))

Mercurial > emacs

comparison lisp/progmodes/sql.el @ 110326:ba7558616802