;; sql-product-interactive. Do *not* call sql-interactive-mode by
;; itself.
-;; The list of currently supported interpreters and the corresponding
-;; entry function used to create the SQLi buffers is shown with
-;; `sql-help' (M-x sql-help).
-
;; Since sql-interactive-mode is built on top of the general
;; command-interpreter-in-a-buffer mode (comint mode), it shares a
;; common base functionality, and a common set of bindings, with all
(capitalize (symbol-name prod))))
(cmd (intern (format "sql-highlight-%s-keywords" prod))))
(fset cmd `(lambda () ,(format "Highlight %s SQL keywords." name)
- (interactive)
+ (interactive "" sql-mode)
(sql-set-product ',prod)))
(vector name cmd
:style 'radio
;;; 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-read-product (prompt &optional default)
+ "Prompt for SQL product name with PROMPT.
+
+Optional argument DEFAULT is the default minibuffer argument."
+ (intern (completing-read
+ (format-prompt prompt default)
+ (completion-table-dynamic
+ (lambda (&rest _)
+ (mapcar (compose #'symbol-name #'car) sql-product-alist)))
+ nil t nil 'sql-product-history default)))
(defun sql-add-product (product display &rest plist)
"Add support for a database product in `sql-mode'.
(defun sql-set-product (product)
"Set `sql-product' to PRODUCT and enable appropriate highlighting."
(interactive
- (list (sql-read-product "SQL product: ")))
+ (list (sql-read-product "SQL product"))
+ sql-mode)
(if (stringp product) (setq product (intern product)))
- (when (not (assoc product sql-product-alist))
- (user-error "SQL product %s is not supported; treated as ANSI" product)
- (setq product 'ansi))
+ (unless (assoc product sql-product-alist)
+ (user-error "SQL product %s is not supported" product))
;; Save product setting and fontify.
(setq sql-product product)
(sql-highlight-product))
+
+(put 'sql-set-product 'minibuffer-action
+ (cons (lambda (c)
+ (with-current-buffer (window-buffer (minibuffer-selected-window))
+ (sql-set-product c)))
+ "set"))
+
(defalias 'sql-set-dialect 'sql-set-product)
\f
(defun sql-buffer-hidden-p (buf)
(defun sql-beginning-of-statement (arg)
"Move to the beginning of the current SQL statement."
- (interactive "p")
+ (interactive "p" sql-mode)
(let ((here (point))
(regexp (sql-statement-regexp sql-product))
(defun sql-end-of-statement (arg)
"Move to the end of the current SQL statement."
- (interactive "p")
+ (interactive "p" sql-mode)
(let ((term (or (sql-get-product-feature sql-product :terminator) ";"))
(re-search (if (> 0 arg) 're-search-backward 're-search-forward))
(here (point))
(defun sql-magic-go (arg)
"Insert \"o\" and call `comint-send-input'.
`sql-electric-stuff' must be the symbol `go'."
- (interactive "P")
+ (interactive "P" sql-interactive-mode)
(self-insert-command (prefix-numeric-value arg))
(if (and (equal sql-electric-stuff 'go)
(save-excursion
(defun sql-magic-semicolon (arg)
"Insert semicolon and call `comint-send-input'.
`sql-electric-stuff' must be the symbol `semicolon'."
- (interactive "P")
+ (interactive "P" sql-interactive-mode)
(self-insert-command (prefix-numeric-value arg))
(if (equal sql-electric-stuff 'semicolon)
(comint-send-input)))
(defun sql-accumulate-and-indent ()
"Continue SQL statement on the next line."
- (interactive)
+ (interactive "" sql-interactive-mode)
(comint-accumulate)
(indent-according-to-mode))
-(defun sql-help-list-products (indent freep)
- "Generate listing of products available for use under SQLi.
-
-List products with :free-software attribute set to FREEP. Indent
-each line with INDENT."
-
- (let (sqli-func doc)
- (setq doc "")
- (dolist (p sql-product-alist)
- (setq sqli-func (intern (concat "sql-" (symbol-name (car p)))))
-
- (if (and (fboundp sqli-func)
- (eq (sql-get-product-feature (car p) :free-software) freep))
- (setq doc
- (concat doc
- indent
- (or (sql-get-product-feature (car p) :name)
- (symbol-name (car p)))
- ":\t"
- "\\["
- (symbol-name sqli-func)
- "]\n"))))
- doc))
-
-(defun sql-help ()
- "Show short help for the SQL modes."
- (interactive)
- (describe-function 'sql-help))
-(put 'sql-help 'function-documentation '(sql--make-help-docstring))
-
-(defvar sql--help-docstring
- "Show short help for the SQL modes.
-Use an entry function to open an interactive SQL buffer. This buffer is
-usually named `*SQL*'. The name of the major mode is SQLi.
-
-Use the following commands to start a specific SQL interpreter:
-
- \\\\FREE
-
-Other non-free SQL implementations are also supported:
-
- \\\\NONFREE
-
-But we urge you to choose a free implementation instead of these.
-
-You can also use \\[sql-product-interactive] to invoke the
-interpreter for the current `sql-product'.
-
-Once you have the SQLi buffer, you can enter SQL statements in the
-buffer. The output generated is appended to the buffer and a new prompt
-is generated. See the In/Out menu in the SQLi buffer for some functions
-that help you navigate through the buffer, the input history, etc.
-
-If you have a really complex SQL statement or if you are writing a
-procedure, you can do this in a separate buffer. Put the new buffer in
-`sql-mode' by calling \\[sql-mode]. The name of this buffer can be
-anything. The name of the major mode is SQL.
-
-In this SQL buffer (SQL mode), you can send the region or the entire
-buffer to the interactive SQL buffer (SQLi mode). The results are
-appended to the SQLi buffer without disturbing your SQL buffer.")
-
-(defun sql--make-help-docstring ()
- "Return a docstring for `sql-help' listing loaded SQL products."
- (let ((doc sql--help-docstring))
- ;; Insert FREE software list
- (when (string-match "^\\(\\s-*\\)[\\][\\]FREE\\s-*$" doc 0)
- (setq doc (replace-match (sql-help-list-products (match-string 1 doc) t)
- t t doc 0)))
- ;; Insert non-FREE software list
- (when (string-match "^\\(\\s-*\\)[\\][\\]NONFREE\\s-*$" doc 0)
- (setq doc (replace-match (sql-help-list-products (match-string 1 doc) nil)
- t t doc 0)))
- doc))
-
(defun sql-default-value (var)
"Fetch the value of a variable.
(sql-buffer-live-p buf prod connection)
buf)
;; Look thru each buffer
- (car (apply #'append
- (mapcar (lambda (b)
- (and (sql-buffer-live-p b prod connection)
- (list (buffer-name b))))
- (buffer-list)))))))
+ (seq-some (lambda (b)
+ (and (sql-buffer-live-p b prod connection)
+ (buffer-name b)))
+ (buffer-list)))))
(defun sql-set-sqli-buffer-generally ()
"Set SQLi buffer for all SQL buffers that have none.
`sql-set-sqli-hook' is run."
(interactive)
(save-excursion
- (let ((buflist (buffer-list))
- (default-buffer (sql-find-sqli-buffer)))
+ (let ((default-buffer (sql-find-sqli-buffer)))
(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 (sql-buffer-live-p sql-buffer)))
- (progn
- (setq sql-buffer default-buffer)
- (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.
+ (dolist (buf (match-buffers '(derived-mode-p . sql-mode)))
+ (with-current-buffer buf
+ (unless (sql-buffer-live-p sql-buffer)
+ (setq sql-buffer default-buffer)
+ (when default-buffer
+ (run-hooks 'sql-set-sqli-hook))))))))
+
+(defun sql-set-sqli-buffer (buf)
+ "Set the SQLi buffer SQL strings are sent to to BUF.
Call this function in a SQL buffer in order to set the SQLi buffer SQL
strings are sent to. Calling this function sets `sql-buffer' and runs
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)
- (sql-product-interactive)
- (let ((new-buffer (read-buffer "New SQLi buffer: " default-buffer t)))
- (if (null (sql-buffer-live-p new-buffer))
- (user-error "Buffer %s is not a working SQLi buffer" new-buffer)
- (when new-buffer
- (setq sql-buffer new-buffer)
- (run-hooks 'sql-set-sqli-hook)))))))
+ (interactive
+ (list
+ (let ((default-buffer (sql-find-sqli-buffer)))
+ (read-buffer
+ (format-prompt "New SQLi buffer" default-buffer) default-buffer t
+ #'sql-buffer-live-p))))
+ (unless (sql-buffer-live-p buf)
+ (user-error "Buffer %s is not a working SQLi buffer" buf))
+ (setq sql-buffer buf)
+ (minibuffer-message "`sql-buffer' is now `%s'" buf)
+ (run-hooks 'sql-set-sqli-hook))
+
+(put 'sql-set-sqli-buffer 'minibuffer-action "set")
(defun sql-show-sqli-buffer ()
"Display the current SQLi buffer.
This is the buffer SQL strings are sent to.
-It is stored in the variable `sql-buffer'.
-I
-See also `sql-help' on how to create such a buffer."
- (interactive)
+It is stored in the variable `sql-buffer'."
+ (interactive "" sql-mode)
(unless (and sql-buffer (buffer-live-p (get-buffer sql-buffer))
(get-buffer-process sql-buffer))
- (sql-set-sqli-buffer))
+ (user-error "No current SQLi buffer"))
(display-buffer sql-buffer))
(defun sql-make-alternate-buffer-name (&optional product)
The actual buffer name set will be \"*SQL: NEW-NAME*\". If
NEW-NAME is empty, then the buffer name will be \"*SQL*\"."
- (interactive "P")
+ (interactive "P" sql-interactive-mode)
(if (not (derived-mode-p 'sql-interactive-mode))
(user-error "Current buffer is not a SQL interactive buffer")
(defun sql-copy-column ()
"Copy current column to the end of buffer.
Inserts SELECT or commas if appropriate."
- (interactive)
+ (interactive "" sql-interactive-mode)
(let ((column))
(save-excursion
(setq column (buffer-substring-no-properties
You can send SQL statements to the SQLi buffer using
\\[sql-send-region]. Such a buffer must exist before you can do this.
-See `sql-help' on how to create SQLi buffers.
\\{sql-mode-map}
Customization: Entry to this mode runs the `sql-mode-hook'.
Do not call this function by yourself. The environment must be
initialized by an entry function specific for the SQL interpreter.
-See `sql-help' for a list of available entry functions.
\\[comint-send-input] after the end of the process' output sends the
text from the end of process to the end of the current line.
If you want to make multiple SQL buffers, rename the `*SQL*' buffer
using \\[rename-buffer] or \\[rename-uniquely] and start a new process.
-See `sql-help' for a list of available entry functions. The last buffer
-created by such an entry function is the current SQLi buffer. SQL
-buffers will send strings to the SQLi buffer current at the time of
-their creation. See `sql-mode' for details.
+The last buffer created by such an entry function is the current SQLi
+buffer. SQL buffers will send strings to the SQLi buffer current at the
+time of their creation. See `sql-mode' for details.
Sample session using two connections:
The information is appended to `sql-connection-alist' and
optionally is saved to the user's init file."
- (interactive "sNew connection name: ")
+ (interactive "sNew connection name: " sql-interactive-mode)
(unless (derived-mode-p 'sql-interactive-mode)
(user-error "Not in a SQL interactive mode!"))
(setq product
(cond
((= (prefix-numeric-value product) 4) ; C-u, prompt for product
- (sql-read-product "SQL product: " sql-product))
+ (sql-read-product "SQL product" sql-product))
((assoc product sql-product-alist) ; Product specified
product)
(t sql-product))) ; Default to sql-product
projects / emacs.git / commitdiff