+;;; 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
+ (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")
+
+ ;; 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)))))
+
+(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))
+ ;; 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)))
+
+(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)))
+
+\f
+
HCoop / bpt / emacs.git / blobdiff