;;; sql.el --- specialized comint.el for SQL interpreters -*- lexical-binding: t -*-
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2016 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
-;; Maintainer: Michael Mauger <mmaug@yahoo.com>
-;; Version: 3.1
+;; Maintainer: Michael Mauger <michael@mauger.com>
+;; Version: 3.5
;; Keywords: comm languages processes
;; URL: http://savannah.gnu.org/projects/emacs/
;; nino <nino@inform.dk>
;; Berend de Boer <berend@pobox.com>
;; Adam Jenkins <adam@thejenkins.org>
-;; Michael Mauger <mmaug@yahoo.com> -- improved product support
+;; Michael Mauger <michael@mauger.com> -- improved product support
;; Drew Adams <drew.adams@oracle.com> -- Emacs 20 support
;; Harald Maier <maierh@myself.com> -- sql-send-string
-;; Stefan Monnier <monnier@iro.umontreal.ca> -- font-lock corrections;
+;; Stefan Monnier <monnier@iro.umontreal.ca> -- font-lock corrections;
;; code polish
;; Paul Sleigh <bat@flurf.net> -- MySQL keyword enhancement
;; Andrew Schein <andrew@andrewschein.com> -- sql-port bug
-;; Ian Bjorhovde <idbjorh@dataproxy.com> -- db2 escape newlines
+;; Ian Bjorhovde <idbjorh@dataproxy.com> -- db2 escape newlines
;; incorrectly enabled by default
+;; Roman Scherer <roman.scherer@nugg.ad> -- Connection documentation
+;; Mark Wilkinson <wilkinsonmr@gmail.com> -- file-local variables ignored
+;;
\f
(require 'regexp-opt))
(require 'custom)
(require 'thingatpt)
+(require 'view)
(defvar font-lock-keyword-face)
(defvar font-lock-set-defaults)
:group 'languages
:group 'processes)
-;; These four variables will be used as defaults, if set.
+;; These five variables will be used as defaults, if set.
(defcustom sql-user ""
"Default username."
:group 'SQL
:safe 'numberp)
+(defcustom sql-default-directory nil
+ "Default directory for SQL processes."
+ :version "25.1"
+ :type '(choice (const nil) string)
+ :group 'SQL
+ :safe 'stringp)
+
;; 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"
- (const server)
- (list :tag "file"
- (const :format "" server)
- (const :format "" :file)
- regexp)
- (list :tag "completion"
- (const :format "" server)
+ :type '(set :tag "Login Parameters"
+ (choice :tag "user"
+ :value user
+ (const user)
+ (list :tag "Specify a default"
+ (const user)
+ (list :tag "Default"
+ :inline t (const :default) string)))
+ (const password)
+ (choice :tag "server"
+ :value server
+ (const server)
+ (list :tag "Specify a default"
+ (const server)
+ (list :tag "Default"
+ :inline t (const :default) string))
+ (list :tag "file"
+ (const :format "" server)
+ (const :format "" :file)
+ regexp)
+ (list :tag "completion"
+ (const :format "" server)
+ (const :format "" :completion)
+ (restricted-sexp
+ :match-alternatives (listp stringp))))
+ (choice :tag "database"
+ :value database
+ (const database)
+ (list :tag "Specify a default"
+ (const database)
+ (list :tag "Default"
+ :inline t (const :default) string))
+ (list :tag "file"
+ (const :format "" database)
+ (const :format "" :file)
+ regexp)
+ (list :tag "completion"
+ (const :format "" database)
(const :format "" :completion)
(restricted-sexp
: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 stringp))))
- (const port))))
+ (const port)))
;; SQL Product support
:sqli-comint-func sql-comint-db2
:prompt-regexp "^db2 => "
:prompt-length 7
- :prompt-cont-regexp "^db2 (cont\.) => "
+ :prompt-cont-regexp "^db2 (cont\\.) => "
:input-filter sql-escape-newlines-filter)
(informix
:sqli-options sql-ingres-options
:sqli-login sql-ingres-login-params
:sqli-comint-func sql-comint-ingres
- :prompt-regexp "^\* "
+ :prompt-regexp "^\\* "
:prompt-length 2
- :prompt-cont-regexp "^\* ")
+ :prompt-cont-regexp "^\\* ")
(interbase
:name "Interbase"
:completion-object sql-oracle-completion-object
:prompt-regexp "^SQL> "
:prompt-length 5
- :prompt-cont-regexp "^\\s-*[[:digit:]]+ "
+ :prompt-cont-regexp "^\\(?:[ ][ ][1-9]\\|[ ][1-9][0-9]\\|[1-9][0-9]\\{2\\}\\)[ ]\\{2\\}"
:statement sql-oracle-statement-starters
:syntax-alist ((?$ . "_") (?# . "_"))
:terminator ("\\(^/\\|;\\)$" . "/")
:completion-object sql-sqlite-completion-object
:prompt-regexp "^sqlite> "
:prompt-length 8
- :prompt-cont-regexp "^ \.\.\.> "
+ :prompt-cont-regexp "^ \\.\\.\\.> "
:terminator ";")
(sybase
:prompt-length 5
:syntax-alist ((?@ . "_"))
:terminator ("^go" . "go"))
+
+ (vertica
+ :name "Vertica"
+ :sqli-program sql-vertica-program
+ :sqli-options sql-vertica-options
+ :sqli-login sql-vertica-login-params
+ :sqli-comint-func sql-comint-vertica
+ :list-all ("\\d" . "\\dS")
+ :list-table "\\d %s"
+ :prompt-regexp "^\\w*=[#>] "
+ :prompt-length 5
+ :prompt-cont-regexp "^\\w*[-(][#>] ")
)
"An alist of product specific configuration settings.
Each element in the list is in the following format:
- \(PRODUCT FEATURE VALUE ...)
+ (PRODUCT FEATURE VALUE ...)
where PRODUCT is the appropriate value of `sql-product'. The
product name is then followed by FEATURE-VALUE pairs. If a
"An alist of connection parameters for interacting with a SQL product.
Each element of the alist is as follows:
- \(CONNECTION \(SQL-VARIABLE VALUE) ...)
+ (CONNECTION \(SQL-VARIABLE VALUE) ...)
-Where CONNECTION is a symbol identifying the connection, SQL-VARIABLE
-is the symbol name of a SQL mode variable, and VALUE is the value to
-be assigned to the variable. The most common SQL-VARIABLE settings
-associated with a connection are: `sql-product', `sql-user',
-`sql-password', `sql-port', `sql-server', and `sql-database'.
+Where CONNECTION is a case-insensitive string identifying the
+connection, SQL-VARIABLE is the symbol name of a SQL mode
+variable, and VALUE is the value to be assigned to the variable.
+The most common SQL-VARIABLE settings associated with a
+connection are: `sql-product', `sql-user', `sql-password',
+`sql-port', `sql-server', and `sql-database'.
If a SQL-VARIABLE is part of the connection, it will not be
prompted for during login. The command `sql-connect' starts a
Globally should be set to nil; it will be non-nil in `sql-mode',
`sql-interactive-mode' and list all buffers.")
+(defvar sql-login-delay 7.5 ;; Secs
+ "Maximum number of seconds you are willing to wait for a login connection.")
(defcustom sql-pop-to-buffer-after-send-region nil
"When non-nil, pop to the buffer SQL statements are sent to.
:type 'file
:group 'SQL)
-(defcustom sql-oracle-options nil
+(defcustom sql-oracle-options '("-L")
"List of additional options for `sql-oracle-program'."
:type '(repeat string)
- :version "20.8"
+ :version "24.4"
:group 'SQL)
(defcustom sql-oracle-login-params '(user password database)
(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-n") 'sql-send-line-and-next)
(define-key map (kbd "C-c C-i") 'sql-product-interactive)
+ (define-key map (kbd "C-c C-z") 'sql-show-sqli-buffer)
(define-key map (kbd "C-c C-l a") 'sql-list-all)
(define-key map (kbd "C-c C-l t") 'sql-list-table)
(define-key map [remap beginning-of-defun] 'sql-beginning-of-statement)
;; double quotes (") don't delimit strings
(modify-syntax-entry ?\" "." table)
;; Make these all punctuation
- (mapc (lambda (c) (modify-syntax-entry c "." table))
+ (mapc #'(lambda (c) (modify-syntax-entry c "." table))
(string-to-list "!#$%&+,.:;<=>?@\\|"))
table)
"Syntax table used in `sql-mode' and `sql-interactive-mode'.")
(not (derived-mode-p 'sql-interactive-mode)))
(not sql-buffer)
(not (eq sql-product 'oracle)))
- (error "Not an Oracle buffer")
+ (user-error "Not an Oracle buffer")
(let ((b "*RESERVED WORDS*"))
(sql-execute sql-buffer b
;; Oracle SQL*Plus Commands
;; Only recognized in they start in column 1 and the
;; abbreviation is followed by a space or the end of line.
-
- "\\|"
(list (concat "^" (sql-regexp-abbrev "rem~ark") "\\(?:\\s-.*\\)?$")
0 'font-lock-comment-face t)
"\\)\\(?:\\s-.*\\)?\\(?:[-]\n.*\\)*$")
0 'font-lock-doc-face t)
+ '("&?&\\(?:\\sw\\|\\s_\\)+[.]?" 0 font-lock-preprocessor-face t)
+ ;; Oracle PL/SQL Attributes (Declare these first to match %TYPE correctly)
+ (sql-font-lock-keywords-builder 'font-lock-builtin-face '("%" . "\\b")
+"bulk_exceptions" "bulk_rowcount" "found" "isopen" "notfound"
+"rowcount" "rowtype" "type"
+)
;; Oracle Functions
(sql-font-lock-keywords-builder 'font-lock-builtin-face nil
"abs" "acos" "add_months" "appendchildxml" "ascii" "asciistr" "asin"
"prediction" "prediction_bounds" "prediction_cost"
"prediction_details" "prediction_probability" "prediction_set"
"presentnnv" "presentv" "previous" "rank" "ratio_to_report" "rawtohex"
-"rawtonhex" "ref" "reftohex" "regexp_count" "regexp_instr"
+"rawtonhex" "ref" "reftohex" "regexp_count" "regexp_instr" "regexp_like"
"regexp_replace" "regexp_substr" "regr_avgx" "regr_avgy" "regr_count"
"regr_intercept" "regr_r2" "regr_slope" "regr_sxx" "regr_sxy"
"regr_syy" "remainder" "replace" "round" "rowidtochar" "rowidtonchar"
"noswitch" "not" "nothing" "notimeout" "novalidate" "nowait" "null"
"nulls" "object" "of" "off" "offline" "oidindex" "old" "on" "online"
"only" "open" "operator" "optimal" "option" "or" "order"
-"organization" "out" "outer" "outline" "overflow" "overriding"
+"organization" "out" "outer" "outline" "over" "overflow" "overriding"
"package" "packages" "parallel" "parallel_enable" "parameters"
"parent" "partition" "partitions" "password" "password_grace_time"
"password_life_time" "password_lock_time" "password_reuse_max"
"password_reuse_time" "password_verify_function" "pctfree"
"pctincrease" "pctthreshold" "pctused" "pctversion" "percent"
-"performance" "permanent" "pfile" "physical" "pipelined" "plan"
+"performance" "permanent" "pfile" "physical" "pipelined" "pivot" "plan"
"post_transaction" "pragma" "prebuilt" "preserve" "primary" "private"
"private_sga" "privileges" "procedure" "profile" "protection" "public"
"purge" "query" "quiesce" "quota" "range" "read" "reads" "rebuild"
"temporary" "test" "than" "then" "thread" "through" "time_zone"
"timeout" "to" "trace" "transaction" "trigger" "triggers" "truncate"
"trust" "type" "types" "unarchived" "under" "under_path" "undo"
-"uniform" "union" "unique" "unlimited" "unlock" "unquiesce"
+"uniform" "union" "unique" "unlimited" "unlock" "unpivot" "unquiesce"
"unrecoverable" "until" "unusable" "unused" "update" "upgrade" "usage"
"use" "using" "validate" "validation" "value" "values" "variable"
"varray" "version" "view" "wait" "when" "whenever" "where" "with"
"clob" "date" "day" "float" "interval" "local" "long" "longraw"
"minute" "month" "nchar" "nclob" "number" "nvarchar2" "raw" "rowid" "second"
"time" "timestamp" "urowid" "varchar2" "with" "year" "zone"
-)
-
- ;; Oracle PL/SQL Attributes
- (sql-font-lock-keywords-builder 'font-lock-builtin-face '("%" . "\\b")
-"bulk_exceptions" "bulk_rowcount" "found" "isopen" "notfound"
-"rowcount" "rowtype" "type"
)
;; Oracle PL/SQL Functions
(sql-font-lock-keywords-builder 'font-lock-builtin-face nil
"delete" "trim" "extend" "exists" "first" "last" "count" "limit"
-"prior" "next"
+"prior" "next" "sqlcode" "sqlerrm"
)
;; Oracle PL/SQL Reserved words
(let ((init (or (and initial (symbol-name initial)) "ansi")))
(intern (completing-read
prompt
- (mapcar (lambda (info) (symbol-name (car info)))
+ (mapcar #'(lambda (info) (symbol-name (car info)))
sql-product-alist)
nil 'require-match
init 'sql-product-history init))))
;; Don't do anything if the product is already supported
(if (assoc product sql-product-alist)
- (message "Product `%s' is already defined" product)
+ (user-error "Product `%s' is already defined" product)
;; Add product to the alist
- (add-to-list 'sql-product-alist `((,product :name ,display . ,plist)))
+ (add-to-list 'sql-product-alist `(,product :name ,display . ,plist))
;; Add a menu item to the SQL->Product menu
(easy-menu-add-item sql-mode-menu '("Product")
;; Each product is represented by a radio
;; after this product's name.
(let ((next-item)
(down-display (downcase display)))
- (map-keymap (lambda (k b)
- (when (and (not next-item)
- (string-lessp down-display
- (downcase (cadr b))))
- (setq next-item k)))
+ (map-keymap #'(lambda (k b)
+ (when (and (not next-item)
+ (string-lessp down-display
+ (downcase (cadr b))))
+ (setq next-item k)))
(easy-menu-get-map sql-mode-menu '("Product")))
next-item))
product))
(symbolp v))
(set v newvalue)
(setcdr p (plist-put (cdr p) feature newvalue)))
- (message "`%s' is not a known product; use `sql-add-product' to add it first." product))))
+ (error "`%s' is not a known product; use `sql-add-product' to add it first." product))))
(defun sql-get-product-feature (product feature &optional fallback not-indirect)
"Lookup FEATURE associated with a SQL PRODUCT.
(symbolp v))
(symbol-value v)
v))
- (message "`%s' is not a known product; use `sql-add-product' to add it first." product)
+ (error "`%s' is not a known product; use `sql-add-product' to add it first." product)
nil)))
(defun sql-product-font-lock (keywords-only imenu)
(font-lock-mode-internal t))
(add-hook 'font-lock-mode-hook
- (lambda ()
- ;; Provide defaults for new font-lock faces.
- (defvar font-lock-builtin-face
- (if (boundp 'font-lock-preprocessor-face)
- font-lock-preprocessor-face
- font-lock-keyword-face))
- (defvar font-lock-doc-face font-lock-string-face))
+ #'(lambda ()
+ ;; Provide defaults for new font-lock faces.
+ (defvar font-lock-builtin-face
+ (if (boundp 'font-lock-preprocessor-face)
+ font-lock-preprocessor-face
+ font-lock-keyword-face))
+ (defvar font-lock-doc-face font-lock-string-face))
nil t)
;; Setup imenu; it needs the same syntax-alist.
For example:
- (sql-add-product-keywords 'ms
- '((\"\\\\b\\\\w+_t\\\\b\" . font-lock-type-face)))
+ (sql-add-product-keywords \\='ms
+ \\='((\"\\\\b\\\\w+_t\\\\b\" . font-lock-type-face)))
adds a fontification pattern to fontify identifiers ending in
`_t' as data types."
"Iterate through login parameters and return a list of results."
(delq nil
(mapcar
- (lambda (param)
- (let ((token (or (car-safe param) param))
- (plist (cdr-safe param)))
- (funcall body token plist)))
+ #'(lambda (param)
+ (let ((token (or (car-safe param) param))
+ (plist (cdr-safe param)))
+ (funcall body token plist)))
login-params)))
\f
(defun sql-product-syntax-table ()
(let ((table (copy-syntax-table sql-mode-syntax-table)))
- (mapc (lambda (entry)
- (modify-syntax-entry (car entry) (cdr entry) table))
+ (mapc #'(lambda (entry)
+ (modify-syntax-entry (car entry) (cdr entry) table))
(sql-get-product-feature sql-product :syntax-alist))
table))
(append
;; Change all symbol character to word characters
(mapcar
- (lambda (entry) (if (string= (substring (cdr entry) 0 1) "_")
- (cons (car entry)
- (concat "w" (substring (cdr entry) 1)))
- entry))
+ #'(lambda (entry) (if (string= (substring (cdr entry) 0 1) "_")
+ (cons (car entry)
+ (concat "w" (substring (cdr entry) 1)))
+ entry))
(sql-get-product-feature sql-product :syntax-alist))
'((?_ . "w"))))
(list (sql-read-product "SQL product: ")))
(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)
+ (user-error "SQL product %s is not supported; treated as ANSI" product)
(setq product 'ansi))
;; Save product setting and fontify.
(comint-bol nil)
(looking-at "go\\b")))
(comint-send-input)))
+(put 'sql-magic-go 'delete-selection t)
(defun sql-magic-semicolon (arg)
"Insert semicolon and call `comint-send-input'.
(self-insert-command (prefix-numeric-value arg))
(if (equal sql-electric-stuff 'semicolon)
(comint-send-input)))
+(put 'sql-magic-semicolon 'delete-selection t)
(defun sql-accumulate-and-indent ()
"Continue SQL statement on the next line."
"]\n"))))
doc))
-;;;###autoload
-(eval
- ;; FIXME: This dynamic-docstring-function trick doesn't work for byte-compiled
- ;; functions, because of the lazy-loading of docstrings, which strips away
- ;; text properties.
- '(defun sql-help ()
- #("Show short help for the SQL modes.
+(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.
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."
- 0 1 (dynamic-docstring-function sql--make-help-docstring))
- (interactive)
- (describe-function 'sql-help)))
-
-(defun sql--make-help-docstring (doc _fun)
- "Insert references to loaded products into the help buffer string."
+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))
- ;; Insert FREE software list
- (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]FREE\\s-*\n" doc 0)
- (setq doc (replace-match (sql-help-list-products (match-string 1 doc) t)
- t t doc 0)))
+(defun sql-default-value (var)
+ "Fetch the value of a variable.
- ;; Insert non-FREE software list
- (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]NONFREE\\s-*\n" doc 0)
- (setq doc (replace-match (sql-help-list-products (match-string 1 doc) nil)
- t t doc 0)))
- doc)
+If the current buffer is in `sql-interactive-mode', then fetch
+the global value, otherwise use the buffer local value."
+ (if (derived-mode-p 'sql-interactive-mode)
+ (default-value var)
+ (buffer-local-value var (current-buffer))))
(defun sql-get-login-ext (symbol prompt history-var plist)
"Prompt user with extended login parameters.
(set-default
symbol
(let* ((default (plist-get plist :default))
- (last-value (default-value symbol))
+ (last-value (sql-default-value symbol))
(prompt-def
(if default
(if (string-match "\\(\\):[ \t]*\\'" prompt)
:number t
In order to ask the user for username, password and database, call the
-function like this: (sql-get-login 'user 'password 'database)."
+function like this: (sql-get-login \\='user \\='password \\='database)."
(dolist (w what)
(let ((plist (cdr-safe w)))
(pcase (or (car-safe w) w)
(`password
(setq-default sql-password
- (read-passwd "Password: " nil sql-password)))
+ (read-passwd "Password: " nil (sql-default-value 'sql-password))))
(`server
(sql-get-login-ext 'sql-server "Server: " 'sql-server-history plist))
(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))))
+ (car (apply #'append
+ (mapcar #'(lambda (b)
+ (and (sql-buffer-live-p b prod connection)
+ (list (buffer-name b))))
(buffer-list)))))))
(defun sql-set-sqli-buffer-generally ()
(interactive)
(let ((default-buffer (sql-find-sqli-buffer)))
(if (null default-buffer)
- (error "There is no suitable SQLi buffer")
+ (sql-product-interactive)
(let ((new-buffer (read-buffer "New SQLi buffer: " default-buffer t)))
(if (null (sql-buffer-live-p new-buffer))
- (error "Buffer %s is not a working SQLi buffer" 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)))))))
(defun sql-show-sqli-buffer ()
- "Show the name of current SQLi buffer.
+ "Display the current SQLi buffer.
-This is the buffer SQL strings are sent to. It is stored in the
-variable `sql-buffer'. See `sql-help' on how to create such a 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)
- (if (or (null sql-buffer)
- (null (buffer-live-p (get-buffer sql-buffer))))
- (message "%s has no SQLi buffer set." (buffer-name (current-buffer)))
- (if (null (get-buffer-process sql-buffer))
- (message "Buffer %s has no process." sql-buffer)
- (message "Current SQLi buffer is %s." sql-buffer))))
+ (unless (and sql-buffer (buffer-live-p (get-buffer sql-buffer))
+ (get-buffer-process sql-buffer))
+ (sql-set-sqli-buffer))
+ (display-buffer sql-buffer))
(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'.
;; Build a name using the :sqli-login setting
(setq name
- (apply 'concat
+ (apply #'concat
(cdr
- (apply 'append nil
+ (apply #'append nil
(sql-for-each-login
(sql-get-product-feature sql-product :sqli-login)
- (lambda (token plist)
- (pcase token
- (`user
- (unless (string= "" sql-user)
- (list "/" sql-user)))
- (`port
- (unless (or (not (numberp sql-port))
- (= 0 sql-port))
- (list ":" (number-to-string sql-port))))
- (`server
- (unless (string= "" sql-server)
- (list "."
- (if (plist-member plist :file)
- (file-name-nondirectory sql-server)
- sql-server))))
- (`database
- (unless (string= "" sql-database)
- (list "@"
- (if (plist-member plist :file)
- (file-name-nondirectory sql-database)
- sql-database))))
-
- ;; (`password nil)
- (_ nil))))))))
+ #'(lambda (token plist)
+ (pcase token
+ (`user
+ (unless (string= "" sql-user)
+ (list "/" sql-user)))
+ (`port
+ (unless (or (not (numberp sql-port))
+ (= 0 sql-port))
+ (list ":" (number-to-string sql-port))))
+ (`server
+ (unless (string= "" sql-server)
+ (list "."
+ (if (plist-member plist :file)
+ (file-name-nondirectory sql-server)
+ sql-server))))
+ (`database
+ (unless (string= "" sql-database)
+ (list "@"
+ (if (plist-member plist :file)
+ (file-name-nondirectory sql-database)
+ sql-database))))
+
+ ;; (`password nil)
+ (_ nil))))))))
;; If there's a connection, use it and the name thus far
(if sql-connection
(interactive "P")
(if (not (derived-mode-p 'sql-interactive-mode))
- (message "Current buffer is not a SQL interactive buffer")
+ (user-error "Current buffer is not a SQL interactive buffer")
(setq sql-alternate-buffer-name
(cond
sql-alternate-buffer-name))
(t sql-alternate-buffer-name)))
+ (setq sql-alternate-buffer-name (substring-no-properties sql-alternate-buffer-name))
(rename-buffer (if (string= "" sql-alternate-buffer-name)
"*SQL*"
(format "*SQL: %s*" sql-alternate-buffer-name))
Placeholders are words starting with an ampersand like &this."
(when sql-oracle-scan-on
- (while (string-match "&\\(\\sw+\\)" string)
+ (while (string-match "&?&\\(\\(?:\\sw\\|\\s_\\)+\\)[.]?" string)
(setq string (replace-match
(read-from-minibuffer
(format "Enter value for %s: " (match-string 1 string))
(defun sql-input-sender (proc string)
"Send STRING to PROC after applying filters."
- (let* ((product (with-current-buffer (process-buffer proc) sql-product))
+ (let* ((product (buffer-local-value 'sql-product (process-buffer proc)))
(filter (sql-get-product-feature product :input-filter)))
;; Apply filter(s)
((functionp filter)
(setq string (funcall filter string)))
((listp filter)
- (mapc (lambda (f) (setq string (funcall f string))) filter))
+ (mapc #'(lambda (f) (setq string (funcall f string))) filter))
(t nil))
;; Count how many newlines in the string
- (setq sql-output-newline-count 0)
- (mapc (lambda (ch)
- (when (eq ch ?\n)
- (setq sql-output-newline-count (1+ sql-output-newline-count))))
- string)
+ (setq sql-output-newline-count
+ (apply #'+ (mapcar #'(lambda (ch)
+ (if (eq ch ?\n) 1 0)) string)))
;; Send the string
(comint-simple-send proc string)))
(defvar sql-preoutput-hold nil)
+(defun sql-starts-with-prompt-re ()
+ "Anchor the prompt expression at the beginning of the output line.
+Remove the start of line regexp."
+ (concat "\\`" comint-prompt-regexp))
+
+(defun sql-ends-with-prompt-re ()
+ "Anchor the prompt expression at the end of the output line.
+Match a SQL prompt or a password prompt."
+ (concat "\\(?:\\(?:" sql-prompt-regexp "\\)\\|"
+ "\\(?:" comint-password-prompt-regexp "\\)\\)\\'"))
+
(defun sql-interactive-remove-continuation-prompt (oline)
"Strip out continuation prompts out of the OLINE.
If the filter gets confused, it should reset and stop filtering
to avoid deleting non-prompt output."
- (let (did-filter)
- (setq oline (concat (or sql-preoutput-hold "") oline)
- sql-preoutput-hold nil)
-
- (if (and comint-prompt-regexp
- (integerp sql-output-newline-count)
- (>= sql-output-newline-count 1))
- (progn
- (while (and (not (string= oline ""))
+ ;; continue gathering lines of text iff
+ ;; + we know what a prompt looks like, and
+ ;; + there is held text, or
+ ;; + there are continuation prompt yet to come, or
+ ;; + not just a prompt string
+ (when (and comint-prompt-regexp
+ (or (> (length (or sql-preoutput-hold "")) 0)
+ (> (or sql-output-newline-count 0) 0)
+ (not (or (string-match sql-prompt-regexp oline)
+ (string-match sql-prompt-cont-regexp oline)))))
+
+ (save-match-data
+ (let (prompt-found last-nl)
+
+ ;; Add this text to what's left from the last pass
+ (setq oline (concat sql-preoutput-hold oline)
+ sql-preoutput-hold "")
+
+ ;; If we are looking for multiple prompts
+ (when (and (integerp sql-output-newline-count)
+ (>= sql-output-newline-count 1))
+ ;; Loop thru each starting prompt and remove it
+ (let ((start-re (sql-starts-with-prompt-re)))
+ (while (and (not (string= oline ""))
(> sql-output-newline-count 0)
- (string-match comint-prompt-regexp oline)
- (= (match-beginning 0) 0))
-
- (setq oline (replace-match "" nil nil oline)
- sql-output-newline-count (1- sql-output-newline-count)
- did-filter t))
+ (string-match start-re oline))
+ (setq oline (replace-match "" nil nil oline)
+ sql-output-newline-count (1- sql-output-newline-count)
+ prompt-found t)))
+ ;; If we've found all the expected prompts, stop looking
(if (= sql-output-newline-count 0)
(setq sql-output-newline-count nil
oline (concat "\n" oline))
+ ;; Still more possible prompts, leave them for the next pass
(setq sql-preoutput-hold oline
- oline ""))
-
- (unless did-filter
- (setq oline (or sql-preoutput-hold "")
- sql-preoutput-hold nil
- sql-output-newline-count nil)))
-
- (setq sql-output-newline-count nil))
-
- oline))
+ oline "")))
+
+ ;; If no prompts were found, stop looking
+ (unless prompt-found
+ (setq sql-output-newline-count nil
+ oline (concat oline sql-preoutput-hold)
+ sql-preoutput-hold ""))
+
+ ;; Break up output by physical lines if we haven't hit the final prompt
+ (let ((end-re (sql-ends-with-prompt-re)))
+ (unless (and (not (string= oline ""))
+ (string-match end-re oline)
+ (>= (match-end 0) (length oline)))
+ ;; Find everything upto the last nl
+ (setq last-nl 0)
+ (while (string-match "\n" oline last-nl)
+ (setq last-nl (match-end 0)))
+ ;; Hold after the last nl, return upto last nl
+ (setq sql-preoutput-hold (concat (substring oline last-nl)
+ sql-preoutput-hold)
+ oline (substring oline 0 last-nl)))))))
+ oline)
;;; Sending the region to the SQLi buffer.
(if sql-send-terminator
(sql-send-magic-terminator sql-buffer s sql-send-terminator))
- (message "Sent string to buffer %s." sql-buffer)))
+ (message "Sent string to buffer %s" sql-buffer)))
;; Display the sql buffer
(if sql-pop-to-buffer-after-send-region
(display-buffer sql-buffer)))
;; We don't have no stinkin' sql
- (message "No SQL process started."))))
+ (user-error "No SQL process started"))))
(defun sql-send-region (start end)
"Send a region to the SQL process."
(interactive)
(sql-send-region (point-min) (point-max)))
+(defun sql-send-line-and-next ()
+ "Send the current line to the SQL process and go to the next line."
+ (interactive)
+ (sql-send-region (line-beginning-position 1) (line-beginning-position 2))
+ (beginning-of-line 2)
+ (while (forward-comment 1))) ; skip all comments and whitespace
+
(defun sql-send-magic-terminator (buf str terminator)
"Send TERMINATOR to buffer BUF if its not present in STR."
(let (comint-input-sender-no-newline pat term)
(when visible
(message "Executing SQL command..."))
(if (consp command)
- (mapc (lambda (c) (sql-redirect-one sqlbuf c outbuf save-prior))
+ (mapc #'(lambda (c) (sql-redirect-one sqlbuf c outbuf save-prior))
command)
(sql-redirect-one sqlbuf command outbuf save-prior))
(when visible
(message "Executing SQL command...done"))))
(defun sql-redirect-one (sqlbuf command outbuf save-prior)
- (with-current-buffer sqlbuf
- (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
- (setq view-read-only nil)
- (unless save-prior
- (erase-buffer))
- (goto-char (point-max))
- (unless (zerop (buffer-size))
- (insert "\n"))
- (setq start (point)))
-
- (when sql-debug-redirect
- (message ">>SQL> %S" command))
-
- ;; Run the command
- (comint-redirect-send-command-to-process command buf proc nil t)
- (while (null comint-redirect-completed)
- (accept-process-output nil 1))
-
- ;; 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)))
- ;; Remove Ctrl-Ms
- (goto-char start)
- (while (re-search-forward "\r+$" nil t)
- (replace-match "" t t))
- (goto-char start)))))
+ (when command
+ (with-current-buffer sqlbuf
+ (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
+ (setq-local view-no-disable-on-exit t)
+ (read-only-mode -1)
+ (unless save-prior
+ (erase-buffer))
+ (goto-char (point-max))
+ (unless (zerop (buffer-size))
+ (insert "\n"))
+ (setq start (point)))
+
+ (when sql-debug-redirect
+ (message ">>SQL> %S" command))
+
+ ;; Run the command
+ (let ((inhibit-quit t)
+ comint-preoutput-filter-functions)
+ (with-local-quit
+ (comint-redirect-send-command-to-process command buf proc nil t)
+ (while (or quit-flag (null comint-redirect-completed))
+ (accept-process-output nil 1)))
+
+ (if quit-flag
+ (comint-redirect-cleanup)
+ ;; 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)))
+ ;; Remove Ctrl-Ms
+ (goto-char start)
+ (while (re-search-forward "\r+$" nil t)
+ (replace-match "" t t))
+ (goto-char start))))))))
(defun sql-redirect-value (sqlbuf command regexp &optional regexp-groups)
"Execute the SQL command and return part of result.
(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))))
+ (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)
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 sqlbuf (if arg (format c arg) c) outbuf) t)
- ((functionp c)
- (apply c sqlbuf outbuf enhanced arg nil))
- (t (error "Unknown sql-execute item %s" c))))
+ #'(lambda (c)
+ (cond
+ ((stringp c)
+ (sql-redirect sqlbuf (if arg (format c arg) c) outbuf) t)
+ ((functionp c)
+ (apply c sqlbuf outbuf enhanced arg nil))
+ (t (error "Unknown sql-execute item %s" c))))
(if (consp command) command (cons command nil)))
(setq outbuf (get-buffer outbuf))
(get-lru-window))))
(with-current-buffer outbuf
(set-buffer-modified-p nil)
- (setq view-read-only t))
- (view-buffer-other-window outbuf)
+ (setq-local revert-buffer-function
+ (lambda (_ignore-auto _noconfirm)
+ (sql-execute sqlbuf (buffer-name outbuf)
+ command enhanced arg)))
+ (special-mode))
+ (pop-to-buffer 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)))
+ (let (command
+ (product (buffer-local-value 'sql-product (get-buffer sqlbuf))))
+ (setq command (sql-get-product-feature product feature))
(unless command
- (error "%s does not support %s" sql-product feature))
+ (error "%s does not support %s" product feature))
(when (consp command)
(setq command (if enhanced
(cdr command)
(apply f (current-buffer) (cons schema nil)))
cl)
(unless (member e cl) (setq cl (cons e cl))))
- (sort cl (function string<)))))))
+ (sort cl #'string<))))))
(defun sql-build-completions (schema)
"Generate a list of names in the database for use as completions."
(buffer-substring-no-properties (match-beginning 0)
(match-end 0))))
(sql-completion-sqlbuf (sql-find-sqli-buffer))
- (product (with-current-buffer sql-completion-sqlbuf sql-product))
+ (product (when sql-completion-sqlbuf
+ (with-current-buffer sql-completion-sqlbuf sql-product)))
(completion-ignore-case t))
- (if (sql-get-product-feature product :completion-object)
- (completing-read prompt #'sql--completion-table
- nil nil tname)
- (read-from-minibuffer prompt tname))))
+ (if product
+ (if (sql-get-product-feature product :completion-object)
+ (completing-read prompt #'sql--completion-table
+ nil nil tname)
+ (read-from-minibuffer prompt tname))
+ (user-error "There is no active SQLi buffer"))))
(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"))
+ (user-error "No SQL interactive buffer found"))
(sql-execute-feature sqlbuf "*List All*" :list-all enhanced nil)
(with-current-buffer sqlbuf
;; Contains the name of database objects
current-prefix-arg))
(let ((sqlbuf (sql-find-sqli-buffer)))
(unless sqlbuf
- (error "No SQL interactive buffer found"))
+ (user-error "No SQL interactive buffer found"))
(unless name
- (error "No table name specified"))
+ (user-error "No table name specified"))
(sql-execute-feature sqlbuf (format "*List %s*" name)
:list-table enhanced name)))
\f
one. If you specify backslash as escape character in SQL, you
must tell Emacs. Here's how to do that in your init file:
-\(add-hook 'sql-mode-hook
+\(add-hook \\='sql-mode-hook
(lambda ()
(modify-syntax-entry ?\\\\ \".\" sql-mode-syntax-table)))"
+ :group 'SQL
:abbrev-table sql-mode-abbrev-table
+
(if sql-mode-menu
(easy-menu-add sql-mode-menu)); XEmacs
(setq-local abbrev-all-caps 1)
;; Contains the name of database objects
(set (make-local-variable 'sql-contains-names) t)
+ ;; Set syntax and font-face highlighting
;; Catch changes to sql-product and highlight accordingly
+ (sql-set-product (or sql-product 'ansi)) ; Fixes bug#13591
(add-hook 'hack-local-variables-hook 'sql-highlight-product t t))
\f
;;; SQL interactive mode
(put 'sql-interactive-mode 'mode-class 'special)
+(put 'sql-interactive-mode 'custom-mode-group 'SQL)
(defun sql-interactive-mode ()
"Major mode to use a SQL interpreter interactively.
Here is an example for your init file. It keeps the SQLi buffer a
certain length.
-\(add-hook 'sql-interactive-mode-hook
- \(function (lambda ()
- \(setq comint-output-filter-functions 'comint-truncate-buffer))))
+\(add-hook \\='sql-interactive-mode-hook
+ (function (lambda ()
+ (setq comint-output-filter-functions \\='comint-truncate-buffer))))
Here is another example. It will always put point back to the statement
you entered, right above the output it created.
\(setq comint-output-filter-functions
- \(function (lambda (STR) (comint-show-output))))"
+ (function (lambda (STR) (comint-show-output))))"
(delay-mode-hooks (comint-mode))
;; Get the `sql-product' for this interactive session.
;; People wanting a different history file for each
;; buffer/process/client/whatever can change separator and file-name
;; on the sql-interactive-mode-hook.
- (setq comint-input-ring-separator sql-input-ring-separator
- comint-input-ring-file-name sql-input-ring-file-name)
- ;; Calling the hook before calling comint-read-input-ring allows users
- ;; to set comint-input-ring-file-name in sql-interactive-mode-hook.
- (comint-read-input-ring t))
+ (let
+ ((comint-input-ring-separator sql-input-ring-separator)
+ (comint-input-ring-file-name sql-input-ring-file-name))
+ (comint-read-input-ring t)))
(defun sql-stop (process event)
"Called when the SQL process is stopped.
This function is a sentinel watching the SQL interpreter process.
Sentinels will always get the two parameters PROCESS and EVENT."
- (comint-write-input-ring)
- (if (and (eq (current-buffer) sql-buffer)
- (not buffer-read-only))
- (insert (format "\nProcess %s %s\n" process event))
- (message "Process %s %s" process event)))
+ (with-current-buffer (process-buffer process)
+ (let
+ ((comint-input-ring-separator sql-input-ring-separator)
+ (comint-input-ring-file-name sql-input-ring-file-name))
+ (comint-write-input-ring))
+
+ (if (not buffer-read-only)
+ (insert (format "\nProcess %s %s\n" process event))
+ (message "Process %s %s" process event))))
\f
"Read a connection name."
(let ((completion-ignore-case t))
(completing-read prompt
- (mapcar (lambda (c) (car c))
+ (mapcar #'(lambda (c) (car c))
sql-connection-alist)
nil t initial 'sql-connection-history default)))
(if sql-connection-alist
(list (sql-read-connection "Connection: " nil '(nil))
current-prefix-arg)
- nil))
+ (user-error "No SQL Connections defined")))
;; Are there connections defined
(if sql-connection-alist
;; Params in the connection
(setq set-params
(mapcar
- (lambda (v)
- (pcase (car v)
- (`sql-user 'user)
- (`sql-password 'password)
- (`sql-server 'server)
- (`sql-database 'database)
- (`sql-port 'port)
- (s s)))
+ #'(lambda (v)
+ (pcase (car v)
+ (`sql-user 'user)
+ (`sql-password 'password)
+ (`sql-server 'server)
+ (`sql-database 'database)
+ (`sql-port 'port)
+ (s s)))
(cdr connect-set)))
;; the remaining params (w/o the connection params)
(setq rem-params
(sql-for-each-login login-params
- (lambda (token plist)
- (unless (member token set-params)
- (if plist (cons token plist) token)))))
+ #'(lambda (token plist)
+ (unless (member token set-params)
+ (if plist (cons token plist) token)))))
;; Set the parameters and start the interactive session
(mapc
- (lambda (vv)
- (set-default (car vv) (eval (cadr vv))))
+ #'(lambda (vv)
+ (set-default (car vv) (eval (cadr vv))))
(cdr connect-set))
(setq-default sql-connection connection)
(eval `(let ((,param-var ',rem-params))
(sql-product-interactive ',sql-product ',new-name))))
- (message "SQL Connection <%s> does not exist" connection)
+ (user-error "SQL Connection <%s> does not exist" connection)
nil)))
- (message "No SQL Connections defined")
+ (user-error "No SQL Connections defined")
nil))
(defun sql-save-connection (name)
(interactive "sNew connection name: ")
(unless (derived-mode-p 'sql-interactive-mode)
- (error "Not in a SQL interactive mode!"))
+ (user-error "Not in a SQL interactive mode!"))
;; Capture the buffer local settings
(let* ((buf (current-buffer))
;; Add the new connection if it doesn't exist
(if (assoc name alist)
- (message "Connection <%s> already exists" name)
+ (user-error "Connection <%s> already exists" name)
(setq connect
(cons name
(sql-for-each-login
`(product ,@login)
- (lambda (token _plist)
- (pcase token
- (`product `(sql-product ',product))
- (`user `(sql-user ,user))
- (`database `(sql-database ,database))
- (`server `(sql-server ,server))
- (`port `(sql-port ,port)))))))
+ #'(lambda (token _plist)
+ (pcase token
+ (`product `(sql-product ',product))
+ (`user `(sql-user ,user))
+ (`database `(sql-database ,database))
+ (`server `(sql-server ,server))
+ (`port `(sql-port ,port)))))))
(setq alist (append alist (list connect)))
"Generate menu entries for using each connection."
(append
(mapcar
- (lambda (conn)
- (vector
- (format "Connection <%s>\t%s" (car conn)
- (let ((sql-user "") (sql-database "")
- (sql-server "") (sql-port 0))
- (eval `(let ,(cdr conn) (sql-make-alternate-buffer-name)))))
- (list 'sql-connect (car conn))
- t))
+ #'(lambda (conn)
+ (vector
+ (format "Connection <%s>\t%s" (car conn)
+ (let ((sql-user "") (sql-database "")
+ (sql-server "") (sql-port 0))
+ (eval `(let ,(cdr conn) (sql-make-alternate-buffer-name)))))
+ (list 'sql-connect (car conn))
+ t))
sql-connection-alist)
tail))
\f
;;; Entry functions for different SQL interpreters.
-
;;;###autoload
(defun sql-product-interactive (&optional product new-name)
"Run PRODUCT interpreter as an inferior process.
;; We have a new name or sql-buffer doesn't exist or match
;; Start by remembering where we start
(let ((start-buffer (current-buffer))
- new-sqli-buffer)
+ new-sqli-buffer rpt)
;; Get credentials.
(apply #'sql-get-login
(sql-get-product-feature product :sqli-login))
;; Connect to database.
- (message "Login...")
+ (setq rpt (make-progress-reporter "Login"))
+
(let ((sql-user (default-value 'sql-user))
(sql-password (default-value 'sql-password))
(sql-server (default-value 'sql-server))
(sql-database (default-value 'sql-database))
- (sql-port (default-value 'sql-port)))
+ (sql-port (default-value 'sql-port))
+ (default-directory (or sql-default-directory
+ default-directory)))
(funcall (sql-get-product-feature product :sqli-comint-func)
product
(sql-get-product-feature product :sqli-options)))
;; Make sure the connection is complete
;; (Sometimes start up can be slow)
;; and call the login hook
- (let ((proc (get-buffer-process new-sqli-buffer)))
+ (let ((proc (get-buffer-process new-sqli-buffer))
+ (secs sql-login-delay)
+ (step 0.3))
(while (and (memq (process-status proc) '(open run))
- (accept-process-output proc 2.5)
+ (or (accept-process-output proc step)
+ (<= 0.0 (setq secs (- secs step))))
(progn (goto-char (point-max))
- (not (looking-back sql-prompt-regexp))))))
- (run-hooks 'sql-login-hook)
+ (not (re-search-backward sql-prompt-regexp 0 t))))
+ (progress-reporter-update rpt)))
+
+ (goto-char (point-max))
+ (when (re-search-backward sql-prompt-regexp nil t)
+ (run-hooks 'sql-login-hook))
+
;; All done.
- (message "Login...done")
- (pop-to-buffer new-sqli-buffer)))))
- (message "No default SQL product defined. Set `sql-product'.")))
+ (progress-reporter-done rpt)
+ (pop-to-buffer new-sqli-buffer)
+ (goto-char (point-max))
+ (current-buffer)))))
+ (user-error "No default SQL product defined. Set `sql-product'.")))
(defun sql-comint (product params)
"Set up a comint buffer to run the SQL processor.
;; work for remote hosts; we suppress the check there.
(unless (or (file-remote-p default-directory)
(executable-find program))
- (error "Unable to locate SQL program \'%s\'" program))
+ (error "Unable to locate SQL program `%s'" program))
;; Make sure buffer name is unique.
(when (sql-buffer-live-p (format "*%s*" buf-name))
(setq buf-name (format "SQL-%s" product))
(setq buf-name (format "SQL-%s%d" product i))))
(setq i (1+ i))))))
(set-buffer
- (apply 'make-comint buf-name program nil params))))
+ (apply #'make-comint buf-name program nil params))))
;;;###autoload
(defun sql-oracle (&optional buffer)
(setq parameter sql-user)))
(if (and parameter (not (string= "" sql-database)))
(setq parameter (concat parameter "@" sql-database)))
+ ;; options must appear before the logon parameters
(if parameter
- (setq parameter (nconc (list parameter) options))
+ (setq parameter (append options (list parameter)))
(setq parameter options))
(sql-comint product parameter)
;; Set process coding system to agree with the interpreter
;;
(append
- ;; (apply 'concat (append
+ ;; (apply #'concat (append
;; '("SET")
;; option value...
;; Remove any settings that haven't changed
(mapc
- (lambda (one-cur-setting)
- (setq saved-settings (delete one-cur-setting saved-settings)))
+ #'(lambda (one-cur-setting)
+ (setq saved-settings (delete one-cur-setting saved-settings)))
(sql-oracle-save-settings sqlbuf))
;; Restore the changed settings
Try to set `comint-output-filter-functions' like this:
\(setq comint-output-filter-functions (append comint-output-filter-functions
- '(comint-strip-ctrl-m)))
+ \\='(comint-strip-ctrl-m)))
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
(interactive "P")
(sql-redirect sqlbuf "\\a"))
;; Return the list of table names (public schema name can be omitted)
- (mapcar (lambda (tbl)
- (if (string= (car tbl) "public")
- (cadr tbl)
- (format "%s.%s" (car tbl) (cadr tbl))))
+ (mapcar #'(lambda (tbl)
+ (if (string= (car tbl) "public")
+ (cadr tbl)
+ (format "%s.%s" (car tbl) (cadr tbl))))
cl))))
\f
\f
+(defcustom sql-vertica-program "vsql"
+ "Command to start the Vertica client."
+ :version "25.1"
+ :type 'file
+ :group 'SQL)
+
+(defcustom sql-vertica-options '("-P" "pager=off")
+ "List of additional options for `sql-vertica-program'.
+The default value disables the internal pager."
+ :version "25.1"
+ :type '(repeat string)
+ :group 'SQL)
+
+(defcustom sql-vertica-login-params '(user password database server)
+ "List of login parameters needed to connect to Vertica."
+ :version "25.1"
+ :type 'sql-login-params
+ :group 'SQL)
+
+(defun sql-comint-vertica (product options)
+ "Create comint buffer and connect to Vertica."
+ (sql-comint product
+ (nconc
+ (and (not (string= "" sql-server))
+ (list "-h" sql-server))
+ (and (not (string= "" sql-database))
+ (list "-d" sql-database))
+ (and (not (string= "" sql-password))
+ (list "-w" sql-password))
+ (and (not (string= "" sql-user))
+ (list "-U" sql-user))
+ options)))
+
+;;;###autoload
+(defun sql-vertica (&optional buffer)
+ "Run vsql as an inferior process."
+ (interactive "P")
+ (sql-product-interactive 'vertica buffer))
+
+\f
(provide 'sql)
;;; sql.el ends here