-;;; sql.el --- specialized comint.el for SQL interpreters
+;;; sql.el --- specialized comint.el for SQL interpreters -*- lexical-binding: t -*-
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2014 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
-;; Maintainer: Michael Mauger <mmaug@yahoo.com>
-;; Version: 2.8
+;; Maintainer: Michael Mauger <michael@mauger.com>
+;; Version: 3.3
;; Keywords: comm languages processes
;; URL: http://savannah.gnu.org/projects/emacs/
-;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SqlMode
;; This file is part of GNU Emacs.
;; available in early versions of sql.el. This support has been
;; extended and formalized in later versions. Part of the impetus for
;; the improved support of SQL flavors was borne out of the current
-;; maintainer's consulting experience. In the past fifteen years, I
+;; maintainers consulting experience. In the past twenty years, I
;; have used Oracle, Sybase, Informix, MySQL, Postgres, and SQLServer.
;; On some assignments, I have used two or more of these concurrently.
;; Hint for newbies: take a look at `dabbrev-expand', `abbrev-mode', and
;; `imenu-add-menubar-index'.
-;;; Requirements for Emacs 19.34:
-
-;; If you are using Emacs 19.34, you will have to get and install
-;; the file regexp-opt.el
-;; <URL:ftp://ftp.ifi.uio.no/pub/emacs/emacs-20.3/lisp/emacs-lisp/regexp-opt.el>
-;; and the custom package
-;; <URL:http://www.dina.kvl.dk/~abraham/custom/>.
-
;;; Bugs:
;; sql-ms now uses osql instead of isql. Osql flushes its error
;; This improves the interaction under Emacs but it still is somewhat
;; awkward.
-;; Quoted identifiers are not supported for hilighting. Most
+;; Quoted identifiers are not supported for highlighting. Most
;; databases support the use of double quoted strings in place of
;; identifiers; ms (Microsoft SQLServer) also supports identifiers
;; enclosed within brackets [].
;; identifier characters.
;; (sql-set-product-feature 'xyz
-;; :syntax-alist ((?# . "w")))
+;; :syntax-alist ((?# . "_")))
;; 4) Define the interactive command interpreter for the database
;; product.
;;
;; ;; Do something with `sql-user', `sql-password',
;; ;; `sql-database', and `sql-server'.
-;; (let ((params options))
-;; (if (not (string= "" sql-server))
-;; (setq params (append (list "-S" sql-server) params)))
-;; (if (not (string= "" sql-database))
-;; (setq params (append (list "-D" sql-database) params)))
-;; (if (not (string= "" sql-password))
-;; (setq params (append (list "-P" sql-password) params)))
+;; (let ((params
+;; (append
;; (if (not (string= "" sql-user))
-;; (setq params (append (list "-U" sql-user) params)))
+;; (list "-U" sql-user))
+;; (if (not (string= "" sql-password))
+;; (list "-P" sql-password))
+;; (if (not (string= "" sql-database))
+;; (list "-D" sql-database))
+;; (if (not (string= "" sql-server))
+;; (list "-S" sql-server))
+;; options)))
;; (sql-comint product params)))
;;
;; (sql-set-product-feature 'xyz
;; :sqli-comint-func 'my-sql-comint-xyz)
-;; 6) Define a convienence function to invoke the SQL interpreter.
+;; 6) Define a convenience function to invoke the SQL interpreter.
;; (defun my-sql-xyz (&optional buffer)
;; "Run ixyz by XyzDB as an inferior process."
;; 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; code polish
+;; 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
+;; incorrectly enabled by default
+;; Roman Scherer <roman.scherer@nugg.ad> -- Connection documentation
+;; Mark Wilkinson <wilkinsonmr@gmail.com> -- file-local variables ignored
+;;
\f
;;; Code:
+(require 'cl-lib)
(require 'comint)
;; Need the following to allow GNU Emacs 19 to compile the file.
(eval-when-compile
(require 'regexp-opt))
(require 'custom)
-(eval-when-compile ;; needed in Emacs 19, 20
- (setq max-specpdl-size (max max-specpdl-size 2000)))
+(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."
(defcustom sql-password ""
"Default password.
-
-Storing your password in a textfile such as ~/.emacs could be dangerous.
-Customizing your password will store it in your ~/.emacs file."
+If you customize this, the value will be stored in your init
+file. Since that is a plaintext file, this could be dangerous."
:type 'string
:group 'SQL
:risky t)
:safe 'stringp)
(defcustom sql-port 0
- "Default port."
+ "Default port for connecting to a MySQL or Postgres server."
:version "24.1"
:type 'number
:group 'SQL
(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
(defvar sql-product-alist
'((ansi
:name "ANSI"
- :font-lock sql-mode-ansi-font-lock-keywords)
+ :font-lock sql-mode-ansi-font-lock-keywords
+ :statement sql-ansi-statement-starters)
(db2
:name "DB2"
:sqli-comint-func sql-comint-ms
:prompt-regexp "^[0-9]*>"
:prompt-length 5
- :syntax-alist ((?@ . "w"))
+ :syntax-alist ((?@ . "_"))
:terminator ("^go" . "go"))
(mysql
:prompt-regexp "^mysql> "
:prompt-length 6
:prompt-cont-regexp "^ -> "
+ :syntax-alist ((?# . "< b"))
:input-filter sql-remove-tabs-filter)
(oracle
:sqli-options sql-oracle-options
:sqli-login sql-oracle-login-params
:sqli-comint-func sql-comint-oracle
+ :list-all sql-oracle-list-all
+ :list-table sql-oracle-list-table
+ :completion-object sql-oracle-completion-object
:prompt-regexp "^SQL> "
:prompt-length 5
- :prompt-cont-regexp "^\\s-*\\d+> "
- :syntax-alist ((?$ . "w") (?# . "w"))
- :terminator ("\\(^/\\|;\\)" . "/")
+ :prompt-cont-regexp "^\\(?:[ ][ ][1-9]\\|[ ][1-9][0-9]\\|[1-9][0-9]\\{2\\}\\)[ ]\\{2\\}"
+ :statement sql-oracle-statement-starters
+ :syntax-alist ((?$ . "_") (?# . "_"))
+ :terminator ("\\(^/\\|;\\)$" . "/")
:input-filter sql-placeholders-filter)
(postgres
:sqli-comint-func sql-comint-postgres
:list-all ("\\d+" . "\\dS+")
:list-table ("\\d+ %s" . "\\dS+ %s")
- :prompt-regexp "^.*=[#>] "
+ :completion-object sql-postgres-completion-object
+ :prompt-regexp "^\\w*=[#>] "
:prompt-length 5
- :prompt-cont-regexp "^.*[-(][#>] "
+ :prompt-cont-regexp "^\\w*[-(][#>] "
:input-filter sql-remove-tabs-filter
- :terminator ("\\(^\\s-*\\\\g\\|;\\)" . ";"))
+ :terminator ("\\(^\\s-*\\\\g$\\|;\\)" . "\\g"))
(solid
:name "Solid"
:sqli-comint-func sql-comint-sqlite
:list-all ".tables"
:list-table ".schema %s"
+ :completion-object sql-sqlite-completion-object
:prompt-regexp "^sqlite> "
:prompt-length 8
- :prompt-cont-regexp "^ ...> "
+ :prompt-cont-regexp "^ \.\.\.> "
:terminator ";")
(sybase
:sqli-comint-func sql-comint-sybase
:prompt-regexp "^SQL> "
:prompt-length 5
- :syntax-alist ((?@ . "w"))
+ :syntax-alist ((?@ . "_"))
:terminator ("^go" . "go"))
)
"An alist of product specific configuration settings.
:sqli-comint-func name of a function which accepts no
parameters that will use the values of
`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.
+ `sql-database', `sql-server' and
+ `sql-port' 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.
produces the standard list and the cdr
produces an enhanced list.
+ :completion-object A function that returns a list of
+ objects. Called with a single
+ parameter--if nil then list objects
+ accessible in the current schema, if
+ not-nil it is the name of a schema whose
+ objects should be listed.
+
+ :completion-column A function that returns a list of
+ columns. Called with a single
+ parameter--if nil then list objects
+ accessible in the current schema, if
+ not-nil it is the name of a schema whose
+ objects should be listed.
+
:prompt-regexp regular expression string that matches
the prompt issued by the product
interpreter.
filtered string. May also be a list of
such functions.
+ :statement name of a variable containing a regexp that
+ matches the beginning of SQL statements.
+
:terminator the terminator to be sent after a
`sql-send-string', `sql-send-region',
`sql-send-paragraph' and
settings.")
(defvar sql-indirect-features
- '(:font-lock :sqli-program :sqli-options :sqli-login))
+ '(:font-lock :sqli-program :sqli-options :sqli-login :statement))
(defcustom sql-connection-alist nil
- "An alist of connection parameters for interacting with a SQL
- product.
-
+ "An alist of connection parameters for interacting with a SQL product.
Each element of the alist is as follows:
\(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'
- `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."
-
+prompted for during login. The command `sql-connect' starts a
+predefined SQLi session using the parameters from this list.
+Connections defined here appear in the submenu SQL->Start... for
+making new SQLi sessions."
:type `(alist :key-type (string :tag "Connection")
:value-type
(set
(group (const :tag "Product" sql-product)
(choice
- ,@(mapcar (lambda (prod-info)
- `(const :tag
- ,(or (plist-get (cdr prod-info) :name)
- (capitalize (symbol-name (car prod-info))))
- (quote ,(car prod-info))))
- sql-product-alist)))
+ ,@(mapcar
+ (lambda (prod-info)
+ `(const :tag
+ ,(or (plist-get (cdr prod-info) :name)
+ (capitalize
+ (symbol-name (car prod-info))))
+ (quote ,(car prod-info))))
+ sql-product-alist)))
(group (const :tag "Username" sql-user) string)
(group (const :tag "Password" sql-password) string)
(group (const :tag "Server" sql-server) string)
:group 'SQL)
(defcustom sql-product 'ansi
- "Select the SQL database product used so that buffers can be
-highlighted properly when you open them."
+ "Select the SQL database product used.
+This allows highlighting buffers properly when you open them."
:type `(choice
,@(mapcar (lambda (prod-info)
`(const :tag
:safe 'symbolp)
(defvaralias 'sql-dialect 'sql-product)
-;; misc customization of sql.el behaviour
+;; misc customization of sql.el behavior
(defcustom sql-electric-stuff nil
"Treat some input as electric.
:version "22.2"
:group 'SQL)
+(defvar sql-contains-names nil
+ "When non-nil, the current buffer contains database names.
+
+Globally should be set to nil; it will be non-nil in `sql-mode',
+`sql-interactive-mode' and list all buffers.")
+
+
(defcustom sql-pop-to-buffer-after-send-region nil
"When non-nil, pop to the buffer SQL statements are sent to.
(defvar sql-imenu-generic-expression
;; Items are in reverse order because they are rendered in reverse.
- '(("Rules/Defaults" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*\\(rule\\|default\\)\\s-+\\(\\w+\\)" 3)
- ("Sequences" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*sequence\\s-+\\(\\w+\\)" 2)
- ("Triggers" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*trigger\\s-+\\(\\w+\\)" 2)
- ("Functions" "^\\s-*\\(create\\s-+\\(\\w+\\s-+\\)*\\)?function\\s-+\\(\\w+\\)" 3)
- ("Procedures" "^\\s-*\\(create\\s-+\\(\\w+\\s-+\\)*\\)?proc\\(edure\\)?\\s-+\\(\\w+\\)" 4)
- ("Packages" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*package\\s-+\\(body\\s-+\\)?\\(\\w+\\)" 3)
- ("Types" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*type\\s-+\\(body\\s-+\\)?\\(\\w+\\)" 3)
- ("Indexes" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*index\\s-+\\(\\w+\\)" 2)
- ("Tables/Views" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*\\(table\\|view\\)\\s-+\\(\\w+\\)" 3))
+ '(("Rules/Defaults" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*\\(?:rule\\|default\\)\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\s-+\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1)
+ ("Sequences" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*sequence\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1)
+ ("Triggers" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*trigger\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1)
+ ("Functions" "^\\s-*\\(?:create\\s-+\\(?:\\w+\\s-+\\)*\\)?function\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1)
+ ("Procedures" "^\\s-*\\(?:create\\s-+\\(?:\\w+\\s-+\\)*\\)?proc\\(?:edure\\)?\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1)
+ ("Packages" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*package\\s-+\\(?:body\\s-+\\)?\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1)
+ ("Types" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*type\\s-+\\(?:body\\s-+\\)?\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1)
+ ("Indexes" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*index\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1)
+ ("Tables/Views" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*\\(?:table\\|view\\)\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1))
"Define interesting points in the SQL buffer for `imenu'.
This is used to set `imenu-generic-expression' when SQL mode is
:type 'hook
:group 'SQL)
+(defcustom sql-login-hook '()
+ "Hook for interacting with a buffer in `sql-interactive-mode'.
+
+This hook is invoked in a buffer once it is ready to accept input
+for the first time."
+ :version "24.1"
+ :type 'hook
+ :group 'SQL)
+
+;; Customization for ANSI
+
+(defcustom sql-ansi-statement-starters
+ (regexp-opt '("create" "alter" "drop"
+ "select" "insert" "update" "delete" "merge"
+ "grant" "revoke"))
+ "Regexp of keywords that start SQL commands.
+
+All products share this list; products should define a regexp to
+identify additional keywords in a variable defined by
+the :statement feature."
+ :version "24.1"
+ :type 'string
+ :group 'SQL)
+
;; Customization for Oracle
(defcustom sql-oracle-program "sqlplus"
:version "24.1"
:group 'SQL)
+(defcustom sql-oracle-statement-starters
+ (regexp-opt '("declare" "begin" "with"))
+ "Additional statement starting keywords in Oracle."
+ :version "24.1"
+ :type 'string
+ :group 'SQL)
+
(defcustom sql-oracle-scan-on t
"Non-nil if placeholders should be replaced in Oracle SQLi.
When non-nil, Emacs will scan text sent to sqlplus and prompt
for replacement text for & placeholders as sqlplus does. This
-is needed on Windows where sqlplus output is buffered and the
+is needed on Windows where SQL*Plus output is buffered and the
prompts are not shown until after the text is entered.
-You will probably want to issue the following command in sqlplus
-to be safe:
+You need to issue the following command in SQL*Plus to be safe:
+
+ SET DEFINE OFF
- SET SCAN OFF"
+In older versions of SQL*Plus, this was the SET SCAN OFF command."
+ :version "24.1"
+ :type 'boolean
+ :group 'SQL)
+
+(defcustom sql-db2-escape-newlines nil
+ "Non-nil if newlines should be escaped by a backslash in DB2 SQLi.
+
+When non-nil, Emacs will automatically insert a space and
+backslash prior to every newline in multi-line SQL statements as
+they are submitted to an interactive DB2 session."
+ :version "24.3"
:type 'boolean
:group 'SQL)
:version "24.1"
:group 'SQL)
-;; Customization for MySql
+;; Customization for MySQL
(defcustom sql-mysql-program "mysql"
"Command to start mysql by TcX.
:group 'SQL)
(defcustom sql-mysql-login-params '(user password database server)
- "List of login parameters needed to connect to MySql."
+ "List of login parameters needed to connect to MySQL."
:type 'sql-login-params
:version "24.1"
:group 'SQL)
Used by `sql-rename-buffer'.")
-(defun sql-buffer-live-p (buffer &optional product)
- "Returns non-nil if the process associated with buffer is live.
+(defun sql-buffer-live-p (buffer &optional product connection)
+ "Return non-nil if the process associated with buffer is live.
BUFFER can be a buffer object or a buffer name. The buffer must
-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."
+be a live buffer, have a running process attached to it, be in
+`sql-interactive-mode', and, if PRODUCT or CONNECTION are
+specified, it's `sql-product' or `sql-connection' 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-interactive-mode)
(or (not product)
- (eq product sql-product)))))))
+ (eq product sql-product))
+ (or (not connection)
+ (eq connection sql-connection)))))))
;; Keymap for sql-interactive-mode.
(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)
+ (define-key map [remap beginning-of-defun] 'sql-beginning-of-statement)
+ (define-key map [remap end-of-defun] 'sql-end-of-statement)
map)
"Mode map used for `sql-mode'.")
["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)]
+ ["List all objects" sql-list-all (and (sql-buffer-live-p sql-buffer)
+ (sql-get-product-feature sql-product :list-all))]
+ ["List table details" sql-list-table (and (sql-buffer-live-p sql-buffer)
+ (sql-get-product-feature sql-product :list-table))]
"--"
["Start SQLi session" sql-product-interactive
:visible (not sql-connection-alist)
["Rename Buffer" sql-rename-buffer t]
["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
+ ["List all objects" sql-list-all (sql-get-product-feature sql-product :list-all)]
+ ["List table details" sql-list-table (sql-get-product-feature sql-product :list-table)]))
+
+;; Abbreviations -- if you want more of them, define them in your init
+;; file. Abbrevs have to be enabled in your init file, too.
+
+(define-abbrev-table 'sql-mode-abbrev-table
+ '(("ins" "insert" nil nil t)
+ ("upd" "update" nil nil t)
+ ("del" "delete" nil nil t)
+ ("sel" "select" nil nil t)
+ ("proc" "procedure" nil nil t)
+ ("func" "function" nil nil t)
+ ("cr" "create" nil nil t))
"Abbrev table used in `sql-mode' and `sql-interactive-mode'.")
-(unless sql-mode-abbrev-table
- (define-abbrev-table 'sql-mode-abbrev-table nil))
-
-(mapc
- ;; In Emacs 22+, provide SYSTEM-FLAG to define-abbrev.
- (lambda (abbrev)
- (let ((name (car abbrev))
- (expansion (cdr abbrev)))
- (condition-case nil
- (define-abbrev sql-mode-abbrev-table name expansion nil 0 t)
- (error
- (define-abbrev sql-mode-abbrev-table name expansion)))))
- '(("ins" . "insert")
- ("upd" . "update")
- ("del" . "delete")
- ("sel" . "select")
- ("proc" . "procedure")
- ("func" . "function")
- ("cr" . "create")))
;; Syntax Table
(modify-syntax-entry ?' "\"" table)
;; double quotes (") don't delimit strings
(modify-syntax-entry ?\" "." table)
- ;; backslash is no escape character
- (modify-syntax-entry ?\\ "." table)
+ ;; Make these all punctuation
+ (mapc #'(lambda (c) (modify-syntax-entry c "." table))
+ (string-to-list "!#$%&+,.:;<=>?@\\|"))
table)
"Syntax table used in `sql-mode' and `sql-interactive-mode'.")
"\\(?:\\w+\\s-+\\)*" ;; optional intervening keywords
"\\(?:table\\|view\\|\\(?:package\\|type\\)\\(?:\\s-+body\\)?\\|proc\\(?:edure\\)?"
"\\|function\\|trigger\\|sequence\\|rule\\|default\\)\\s-+"
- "\\(\\w+\\)")
+ "\\(?:if\\s-+not\\s-+exists\\s-+\\)?" ;; IF NOT EXISTS
+ "\\(\\w+\\(?:\\s-*[.]\\s-*\\w+\\)*\\)")
1 'font-lock-function-name-face))
"Pattern to match the names of top-level objects.
;; are not followed closely, and most vendors offer significant
;; capabilities beyond those defined in the standard specifications.
-;; SQL mode provides support for hilighting based on the product. In
-;; addition to hilighting the product keywords, any ANSI keywords not
-;; used by the product are also hilighted. This will help identify
+;; SQL mode provides support for highlighting based on the product. In
+;; addition to highlighting the product keywords, any ANSI keywords not
+;; used by the product are also highlighted. This will help identify
;; keywords that could be restricted in future versions of the product
;; or might be a problem if ported to another product.
;; Remove keywords that are defined in ANSI
(setq kwd keywords)
- (dolist (k keywords)
- (catch 'next
- (dolist (a sql-mode-ansi-font-lock-keywords)
- (when (and (eq face (cdr a))
- (eq (string-match (car a) k 0) 0)
- (eq (match-end 0) (length k)))
- (setq kwd (delq k kwd))
- (throw 'next nil)))))
+ ;; (dolist (k keywords)
+ ;; (catch 'next
+ ;; (dolist (a sql-mode-ansi-font-lock-keywords)
+ ;; (when (and (eq face (cdr a))
+ ;; (eq (string-match (car a) k 0) 0)
+ ;; (eq (match-end 0) (length k)))
+ ;; (setq kwd (delq k kwd))
+ ;; (throw 'next nil)))))
;; Create a properly formed font-lock-keywords item
(cons (concat (car bdy)
(regexp-opt kwd t)
(cdr bdy))
- face))))
+ face)))
+
+ (defun sql-regexp-abbrev (keyword)
+ (let ((brk (string-match "[~]" keyword))
+ (len (length keyword))
+ (sep "\\(?:")
+ re i)
+ (if (not brk)
+ keyword
+ (setq re (substring keyword 0 brk)
+ i (+ 2 brk)
+ brk (1+ brk))
+ (while (<= i len)
+ (setq re (concat re sep (substring keyword brk i))
+ sep "\\|"
+ i (1+ i)))
+ (concat re "\\)?"))))
+
+ (defun sql-regexp-abbrev-list (&rest keyw-list)
+ (let ((re nil)
+ (sep "\\<\\(?:"))
+ (while keyw-list
+ (setq re (concat re sep (sql-regexp-abbrev (car keyw-list)))
+ sep "\\|"
+ keyw-list (cdr keyw-list)))
+ (concat re "\\)\\>"))))
(eval-when-compile
(setq sql-mode-ansi-font-lock-keywords
"user_defined_type_catalog" "user_defined_type_name"
"user_defined_type_schema"
)
+
;; ANSI Reserved keywords
(sql-font-lock-keywords-builder 'font-lock-keyword-face nil
"absolute" "action" "add" "admin" "after" "aggregate" "alias" "all"
"substring" "sum" "system_user" "translate" "treat" "trim" "upper"
"user"
)
+
;; ANSI Data Types
(sql-font-lock-keywords-builder 'font-lock-type-face nil
"array" "binary" "bit" "blob" "boolean" "char" "character" "clob"
you define your own `sql-mode-ansi-font-lock-keywords'. You may want
to add functions and PL/SQL keywords.")
+(defun sql--oracle-show-reserved-words ()
+ ;; This function is for use by the maintainer of SQL.EL only.
+ (if (or (and (not (derived-mode-p 'sql-mode))
+ (not (derived-mode-p 'sql-interactive-mode)))
+ (not sql-buffer)
+ (not (eq sql-product 'oracle)))
+ (user-error "Not an Oracle buffer")
+
+ (let ((b "*RESERVED WORDS*"))
+ (sql-execute sql-buffer b
+ (concat "SELECT "
+ " keyword "
+ ", reserved AS \"Res\" "
+ ", res_type AS \"Type\" "
+ ", res_attr AS \"Attr\" "
+ ", res_semi AS \"Semi\" "
+ ", duplicate AS \"Dup\" "
+ "FROM V$RESERVED_WORDS "
+ "WHERE length > 1 "
+ "AND SUBSTR(keyword, 1, 1) BETWEEN 'A' AND 'Z' "
+ "ORDER BY 2 DESC, 3 DESC, 4 DESC, 5 DESC, 6 DESC, 1;")
+ nil nil)
+ (with-current-buffer b
+ (set (make-local-variable 'sql-product) 'oracle)
+ (sql-product-font-lock t nil)
+ (font-lock-mode +1)))))
+
(defvar sql-mode-oracle-font-lock-keywords
(eval-when-compile
(list
;; Oracle SQL*Plus Commands
- (cons
- (concat
- "^\\s-*\\(?:\\(?:" (regexp-opt '(
-"@" "@@" "accept" "append" "archive" "attribute" "break"
-"btitle" "change" "clear" "column" "connect" "copy" "define"
-"del" "describe" "disconnect" "edit" "execute" "exit" "get" "help"
-"host" "input" "list" "password" "pause" "print" "prompt" "recover"
-"remark" "repfooter" "repheader" "run" "save" "show" "shutdown"
-"spool" "start" "startup" "store" "timing" "ttitle" "undefine"
-"variable" "whenever"
-) t)
+ ;; Only recognized in they start in column 1 and the
+ ;; abbreviation is followed by a space or the end of line.
- "\\)\\|"
- "\\(?:compute\\s-+\\(?:avg\\|cou\\|min\\|max\\|num\\|sum\\|std\\|var\\)\\)\\|"
- "\\(?:set\\s-+\\("
-
- (regexp-opt
- '("appi" "appinfo" "array" "arraysize" "auto" "autocommit"
- "autop" "autoprint" "autorecovery" "autot" "autotrace" "blo"
- "blockterminator" "buffer" "closecursor" "cmds" "cmdsep"
- "colsep" "com" "compatibility" "con" "concat" "constraint"
- "constraints" "copyc" "copycommit" "copytypecheck" "database"
- "def" "define" "document" "echo" "editf" "editfile" "emb"
- "embedded" "esc" "escape" "feed" "feedback" "flagger" "flu"
- "flush" "hea" "heading" "heads" "headsep" "instance" "lin"
- "linesize" "lobof" "loboffset" "logsource" "long" "longc"
- "longchunksize" "maxdata" "newp" "newpage" "null" "num"
- "numf" "numformat" "numwidth" "pages" "pagesize" "pau"
- "pause" "recsep" "recsepchar" "role" "scan" "serveroutput"
- "shift" "shiftinout" "show" "showmode" "space" "sqlbl"
- "sqlblanklines" "sqlc" "sqlcase" "sqlco" "sqlcontinue" "sqln"
- "sqlnumber" "sqlp" "sqlpluscompat" "sqlpluscompatibility"
- "sqlpre" "sqlprefix" "sqlprompt" "sqlt" "sqlterminator"
- "statement_id" "suf" "suffix" "tab" "term" "termout" "ti"
- "time" "timi" "timing" "transaction" "trim" "trimout" "trims"
- "trimspool" "truncate" "und" "underline" "ver" "verify" "wra"
- "wrap")) "\\)\\)"
-
- "\\)\\b.*"
- )
- 'font-lock-doc-face)
- '("^\\s-*rem\\(?:ark\\)?\\>.*" . font-lock-comment-face)
+ "\\|"
+ (list (concat "^" (sql-regexp-abbrev "rem~ark") "\\(?:\\s-.*\\)?$")
+ 0 'font-lock-comment-face t)
+
+ (list
+ (concat
+ "^\\(?:"
+ (sql-regexp-abbrev-list
+ "[@]\\{1,2\\}" "acc~ept" "a~ppend" "archive" "attribute"
+ "bre~ak" "bti~tle" "c~hange" "cl~ear" "col~umn" "conn~ect"
+ "copy" "def~ine" "del" "desc~ribe" "disc~onnect" "ed~it"
+ "exec~ute" "exit" "get" "help" "ho~st" "[$]" "i~nput" "l~ist"
+ "passw~ord" "pau~se" "pri~nt" "pro~mpt" "quit" "recover"
+ "repf~ooter" "reph~eader" "r~un" "sav~e" "sho~w" "shutdown"
+ "spo~ol" "sta~rt" "startup" "store" "tim~ing" "tti~tle"
+ "undef~ine" "var~iable" "whenever")
+ "\\|"
+ (concat "\\(?:"
+ (sql-regexp-abbrev "comp~ute")
+ "\\s-+"
+ (sql-regexp-abbrev-list
+ "avg" "cou~nt" "min~imum" "max~imum" "num~ber" "sum"
+ "std" "var~iance")
+ "\\)")
+ "\\|"
+ (concat "\\(?:set\\s-+"
+ (sql-regexp-abbrev-list
+ "appi~nfo" "array~size" "auto~commit" "autop~rint"
+ "autorecovery" "autot~race" "blo~ckterminator"
+ "cmds~ep" "colsep" "com~patibility" "con~cat"
+ "copyc~ommit" "copytypecheck" "def~ine" "describe"
+ "echo" "editf~ile" "emb~edded" "esc~ape" "feed~back"
+ "flagger" "flu~sh" "hea~ding" "heads~ep" "instance"
+ "lin~esize" "lobof~fset" "long" "longc~hunksize"
+ "mark~up" "newp~age" "null" "numf~ormat" "num~width"
+ "pages~ize" "pau~se" "recsep" "recsepchar"
+ "scan" "serverout~put" "shift~inout" "show~mode"
+ "sqlbl~anklines" "sqlc~ase" "sqlco~ntinue"
+ "sqln~umber" "sqlpluscompat~ibility" "sqlpre~fix"
+ "sqlp~rompt" "sqlt~erminator" "suf~fix" "tab"
+ "term~out" "ti~me" "timi~ng" "trim~out" "trims~pool"
+ "und~erline" "ver~ify" "wra~p")
+ "\\)")
+
+ "\\)\\(?:\\s-.*\\)?\\(?:[-]\n.*\\)*$")
+ 0 'font-lock-doc-face t)
;; Oracle Functions
(sql-font-lock-keywords-builder 'font-lock-builtin-face nil
-"abs" "acos" "add_months" "ascii" "asciistr" "asin" "atan" "atan2"
-"avg" "bfilename" "bin_to_num" "bitand" "cast" "ceil" "chartorowid"
-"chr" "coalesce" "compose" "concat" "convert" "corr" "cos" "cosh"
-"count" "covar_pop" "covar_samp" "cume_dist" "current_date"
-"current_timestamp" "current_user" "dbtimezone" "decode" "decompose"
-"dense_rank" "depth" "deref" "dump" "empty_clob" "existsnode" "exp"
-"extract" "extractvalue" "first" "first_value" "floor" "following"
-"from_tz" "greatest" "group_id" "grouping_id" "hextoraw" "initcap"
-"instr" "lag" "last" "last_day" "last_value" "lead" "least" "length"
-"ln" "localtimestamp" "lower" "lpad" "ltrim" "make_ref" "max" "min"
-"mod" "months_between" "new_time" "next_day" "nls_charset_decl_len"
+"abs" "acos" "add_months" "appendchildxml" "ascii" "asciistr" "asin"
+"atan" "atan2" "avg" "bfilename" "bin_to_num" "bitand" "cardinality"
+"cast" "ceil" "chartorowid" "chr" "cluster_id" "cluster_probability"
+"cluster_set" "coalesce" "collect" "compose" "concat" "convert" "corr"
+"connect_by_root" "connect_by_iscycle" "connect_by_isleaf"
+"corr_k" "corr_s" "cos" "cosh" "count" "covar_pop" "covar_samp"
+"cube_table" "cume_dist" "current_date" "current_timestamp" "cv"
+"dataobj_to_partition" "dbtimezone" "decode" "decompose" "deletexml"
+"dense_rank" "depth" "deref" "dump" "empty_blob" "empty_clob"
+"existsnode" "exp" "extract" "extractvalue" "feature_id" "feature_set"
+"feature_value" "first" "first_value" "floor" "from_tz" "greatest"
+"grouping" "grouping_id" "group_id" "hextoraw" "initcap"
+"insertchildxml" "insertchildxmlafter" "insertchildxmlbefore"
+"insertxmlafter" "insertxmlbefore" "instr" "instr2" "instr4" "instrb"
+"instrc" "iteration_number" "lag" "last" "last_day" "last_value"
+"lead" "least" "length" "length2" "length4" "lengthb" "lengthc"
+"listagg" "ln" "lnnvl" "localtimestamp" "log" "lower" "lpad" "ltrim"
+"make_ref" "max" "median" "min" "mod" "months_between" "nanvl" "nchr"
+"new_time" "next_day" "nlssort" "nls_charset_decl_len"
"nls_charset_id" "nls_charset_name" "nls_initcap" "nls_lower"
-"nls_upper" "nlssort" "ntile" "nullif" "numtodsinterval"
-"numtoyminterval" "nvl" "nvl2" "over" "path" "percent_rank"
-"percentile_cont" "percentile_disc" "power" "preceding" "rank"
-"ratio_to_report" "rawtohex" "rawtonhex" "reftohex" "regr_"
-"regr_avgx" "regr_avgy" "regr_count" "regr_intercept" "regr_r2"
-"regr_slope" "regr_sxx" "regr_sxy" "regr_syy" "replace" "round"
-"row_number" "rowidtochar" "rowidtonchar" "rpad" "rtrim"
-"sessiontimezone" "sign" "sin" "sinh" "soundex" "sqrt" "stddev"
-"stddev_pop" "stddev_samp" "substr" "sum" "sys_connect_by_path"
-"sys_context" "sys_dburigen" "sys_extract_utc" "sys_guid" "sys_typeid"
-"sys_xmlagg" "sys_xmlgen" "sysdate" "systimestamp" "tan" "tanh"
+"nls_upper" "nth_value" "ntile" "nullif" "numtodsinterval"
+"numtoyminterval" "nvl" "nvl2" "ora_dst_affected" "ora_dst_convert"
+"ora_dst_error" "ora_hash" "path" "percentile_cont" "percentile_disc"
+"percent_rank" "power" "powermultiset" "powermultiset_by_cardinality"
+"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"
+"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"
+"row_number" "rpad" "rtrim" "scn_to_timestamp" "sessiontimezone" "set"
+"sign" "sin" "sinh" "soundex" "sqrt" "stats_binomial_test"
+"stats_crosstab" "stats_f_test" "stats_ks_test" "stats_mode"
+"stats_mw_test" "stats_one_way_anova" "stats_t_test_indep"
+"stats_t_test_indepu" "stats_t_test_one" "stats_t_test_paired"
+"stats_wsr_test" "stddev" "stddev_pop" "stddev_samp" "substr"
+"substr2" "substr4" "substrb" "substrc" "sum" "sysdate" "systimestamp"
+"sys_connect_by_path" "sys_context" "sys_dburigen" "sys_extract_utc"
+"sys_guid" "sys_typeid" "sys_xmlagg" "sys_xmlgen" "tan" "tanh"
+"timestamp_to_scn" "to_binary_double" "to_binary_float" "to_blob"
"to_char" "to_clob" "to_date" "to_dsinterval" "to_lob" "to_multi_byte"
"to_nchar" "to_nclob" "to_number" "to_single_byte" "to_timestamp"
"to_timestamp_tz" "to_yminterval" "translate" "treat" "trim" "trunc"
-"tz_offset" "uid" "unbounded" "unistr" "updatexml" "upper" "user"
-"userenv" "var_pop" "var_samp" "variance" "vsize" "width_bucket" "xml"
-"xmlagg" "xmlattribute" "xmlcolattval" "xmlconcat" "xmlelement"
-"xmlforest" "xmlsequence" "xmltransform"
+"tz_offset" "uid" "unistr" "updatexml" "upper" "user" "userenv"
+"value" "variance" "var_pop" "var_samp" "vsize" "width_bucket"
+"xmlagg" "xmlcast" "xmlcdata" "xmlcolattval" "xmlcomment" "xmlconcat"
+"xmldiff" "xmlelement" "xmlexists" "xmlforest" "xmlisvalid" "xmlparse"
+"xmlpatch" "xmlpi" "xmlquery" "xmlroot" "xmlsequence" "xmlserialize"
+"xmltable" "xmltransform"
)
+
+ ;; See the table V$RESERVED_WORDS
;; Oracle Keywords
(sql-font-lock-keywords-builder 'font-lock-keyword-face nil
"abort" "access" "accessed" "account" "activate" "add" "admin"
"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"
"varray" "version" "view" "wait" "when" "whenever" "where" "with"
"without" "wnds" "wnps" "work" "write" "xmldata" "xmlschema" "xmltype"
)
+
;; Oracle Data Types
(sql-font-lock-keywords-builder 'font-lock-type-face nil
-"bfile" "blob" "byte" "char" "character" "clob" "date" "dec" "decimal"
-"double" "float" "int" "integer" "interval" "long" "national" "nchar"
-"nclob" "number" "numeric" "nvarchar2" "precision" "raw" "real"
-"rowid" "second" "smallint" "time" "timestamp" "urowid" "varchar"
-"varchar2" "varying" "year" "zone"
+"bfile" "binary_double" "binary_float" "blob" "byte" "char" "charbyte"
+"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_rowcount" "%found" "%isopen" "%notfound" "%rowcount" "%rowtype"
-"%type"
+ (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
-"extend" "prior"
+"delete" "trim" "extend" "exists" "first" "last" "count" "limit"
+"prior" "next" "sqlcode" "sqlerrm"
+)
+
+ ;; Oracle PL/SQL Reserved words
+ (sql-font-lock-keywords-builder 'font-lock-keyword-face nil
+"all" "alter" "and" "any" "as" "asc" "at" "begin" "between" "by"
+"case" "check" "clusters" "cluster" "colauth" "columns" "compress"
+"connect" "crash" "create" "cursor" "declare" "default" "desc"
+"distinct" "drop" "else" "end" "exception" "exclusive" "fetch" "for"
+"from" "function" "goto" "grant" "group" "having" "identified" "if"
+"in" "index" "indexes" "insert" "intersect" "into" "is" "like" "lock"
+"minus" "mode" "nocompress" "not" "nowait" "null" "of" "on" "option"
+"or" "order" "overlaps" "procedure" "public" "resource" "revoke"
+"select" "share" "size" "sql" "start" "subtype" "tabauth" "table"
+"then" "to" "type" "union" "unique" "update" "values" "view" "views"
+"when" "where" "with"
+
+"true" "false"
+"raise_application_error"
)
;; Oracle PL/SQL Keywords
(sql-font-lock-keywords-builder 'font-lock-keyword-face nil
-"autonomous_transaction" "bulk" "char_base" "collect" "constant"
-"cursor" "declare" "do" "elsif" "exception_init" "execute" "exit"
-"extends" "false" "fetch" "forall" "goto" "hour" "if" "interface"
-"loop" "minute" "number_base" "ocirowid" "opaque" "others" "rowtype"
-"separate" "serially_reusable" "sql" "sqlcode" "sqlerrm" "subtype"
-"the" "timezone_abbr" "timezone_hour" "timezone_minute"
-"timezone_region" "true" "varrying" "while"
+"a" "add" "agent" "aggregate" "array" "attribute" "authid" "avg"
+"bfile_base" "binary" "blob_base" "block" "body" "both" "bound" "bulk"
+"byte" "c" "call" "calling" "cascade" "char" "char_base" "character"
+"charset" "charsetform" "charsetid" "clob_base" "close" "collect"
+"comment" "commit" "committed" "compiled" "constant" "constructor"
+"context" "continue" "convert" "count" "current" "customdatum"
+"dangling" "data" "date" "date_base" "day" "define" "delete"
+"deterministic" "double" "duration" "element" "elsif" "empty" "escape"
+"except" "exceptions" "execute" "exists" "exit" "external" "final"
+"fixed" "float" "forall" "force" "general" "hash" "heap" "hidden"
+"hour" "immediate" "including" "indicator" "indices" "infinite"
+"instantiable" "int" "interface" "interval" "invalidate" "isolation"
+"java" "language" "large" "leading" "length" "level" "library" "like2"
+"like4" "likec" "limit" "limited" "local" "long" "loop" "map" "max"
+"maxlen" "member" "merge" "min" "minute" "mod" "modify" "month"
+"multiset" "name" "nan" "national" "native" "nchar" "new" "nocopy"
+"number_base" "object" "ocicoll" "ocidate" "ocidatetime" "ociduration"
+"ociinterval" "ociloblocator" "ocinumber" "ociraw" "ociref"
+"ocirefcursor" "ocirowid" "ocistring" "ocitype" "old" "only" "opaque"
+"open" "operator" "oracle" "oradata" "organization" "orlany" "orlvary"
+"others" "out" "overriding" "package" "parallel_enable" "parameter"
+"parameters" "parent" "partition" "pascal" "pipe" "pipelined" "pragma"
+"precision" "prior" "private" "raise" "range" "raw" "read" "record"
+"ref" "reference" "relies_on" "rem" "remainder" "rename" "result"
+"result_cache" "return" "returning" "reverse" "rollback" "row"
+"sample" "save" "savepoint" "sb1" "sb2" "sb4" "second" "segment"
+"self" "separate" "sequence" "serializable" "set" "short" "size_t"
+"some" "sparse" "sqlcode" "sqldata" "sqlname" "sqlstate" "standard"
+"static" "stddev" "stored" "string" "struct" "style" "submultiset"
+"subpartition" "substitutable" "sum" "synonym" "tdo" "the" "time"
+"timestamp" "timezone_abbr" "timezone_hour" "timezone_minute"
+"timezone_region" "trailing" "transaction" "transactional" "trusted"
+"ub1" "ub2" "ub4" "under" "unsigned" "untrusted" "use" "using"
+"valist" "value" "variable" "variance" "varray" "varying" "void"
+"while" "work" "wrapped" "write" "year" "zone"
+;; Pragma
+"autonomous_transaction" "exception_init" "inline"
+"restrict_references" "serially_reusable"
)
;; Oracle PL/SQL Data Types
(sql-font-lock-keywords-builder 'font-lock-type-face nil
-"binary_integer" "boolean" "naturaln" "pls_integer" "positive"
-"positiven" "record" "signtype" "string"
+"\"BINARY LARGE OBJECT\"" "\"CHAR LARGE OBJECT\"" "\"CHAR VARYING\""
+"\"CHARACTER LARGE OBJECT\"" "\"CHARACTER VARYING\""
+"\"DOUBLE PRECISION\"" "\"INTERVAL DAY TO SECOND\""
+"\"INTERVAL YEAR TO MONTH\"" "\"LONG RAW\"" "\"NATIONAL CHAR\""
+"\"NATIONAL CHARACTER LARGE OBJECT\"" "\"NATIONAL CHARACTER\""
+"\"NCHAR LARGE OBJECT\"" "\"NCHAR\"" "\"NCLOB\"" "\"NVARCHAR2\""
+"\"TIME WITH TIME ZONE\"" "\"TIMESTAMP WITH LOCAL TIME ZONE\""
+"\"TIMESTAMP WITH TIME ZONE\""
+"bfile" "bfile_base" "binary_double" "binary_float" "binary_integer"
+"blob" "blob_base" "boolean" "char" "character" "char_base" "clob"
+"clob_base" "cursor" "date" "day" "dec" "decimal"
+"dsinterval_unconstrained" "float" "int" "integer" "interval" "local"
+"long" "mlslabel" "month" "natural" "naturaln" "nchar_cs" "number"
+"number_base" "numeric" "pls_integer" "positive" "positiven" "raw"
+"real" "ref" "rowid" "second" "signtype" "simple_double"
+"simple_float" "simple_integer" "smallint" "string" "time" "timestamp"
+"timestamp_ltz_unconstrained" "timestamp_tz_unconstrained"
+"timestamp_unconstrained" "time_tz_unconstrained" "time_unconstrained"
+"to" "urowid" "varchar" "varchar2" "with" "year"
+"yminterval_unconstrained" "zone"
)
;; Oracle PL/SQL Exceptions
(sql-font-lock-keywords-builder 'font-lock-warning-face nil
"access_into_null" "case_not_found" "collection_is_null"
"cursor_already_open" "dup_val_on_index" "invalid_cursor"
-"invalid_number" "login_denied" "no_data_found" "not_logged_on"
-"program_error" "rowtype_mismatch" "self_is_null" "storage_error"
-"subscript_beyond_count" "subscript_outside_limit" "sys_invalid_rowid"
-"timeout_on_resource" "too_many_rows" "value_error" "zero_divide"
-"exception" "notfound"
+"invalid_number" "login_denied" "no_data_found" "no_data_needed"
+"not_logged_on" "program_error" "rowtype_mismatch" "self_is_null"
+"storage_error" "subscript_beyond_count" "subscript_outside_limit"
+"sys_invalid_rowid" "timeout_on_resource" "too_many_rows"
+"value_error" "zero_divide"
)))
"Oracle SQL keywords used by font-lock.
;; Postgres non-reserved words
(sql-font-lock-keywords-builder 'font-lock-builtin-face nil
"abort" "absolute" "access" "action" "add" "admin" "after" "aggregate"
-"also" "alter" "always" "assertion" "assignment" "at" "backward"
+"also" "alter" "always" "assertion" "assignment" "at" "attribute" "backward"
"before" "begin" "between" "by" "cache" "called" "cascade" "cascaded"
"catalog" "chain" "characteristics" "checkpoint" "class" "close"
"cluster" "coalesce" "comment" "comments" "commit" "committed"
"delimiters" "dictionary" "disable" "discard" "document" "domain"
"drop" "each" "enable" "encoding" "encrypted" "enum" "escape"
"exclude" "excluding" "exclusive" "execute" "exists" "explain"
-"external" "extract" "family" "first" "float" "following" "force"
+"extension" "external" "extract" "family" "first" "float" "following" "force"
"forward" "function" "functions" "global" "granted" "greatest"
"handler" "header" "hold" "hour" "identity" "if" "immediate"
"immutable" "implicit" "including" "increment" "index" "indexes"
"inherit" "inherits" "inline" "inout" "input" "insensitive" "insert"
-"instead" "invoker" "isolation" "key" "language" "large" "last"
-"lc_collate" "lc_ctype" "least" "level" "listen" "load" "local"
+"instead" "invoker" "isolation" "key" "label" "language" "large" "last"
+"lc_collate" "lc_ctype" "leakproof" "least" "level" "listen" "load" "local"
"location" "lock" "login" "mapping" "match" "maxvalue" "minute"
-"minvalue" "mode" "month" "move" "name" "names" "national" "nchar"
+"minvalue" "mode" "month" "move" "names" "national" "nchar"
"next" "no" "nocreatedb" "nocreaterole" "nocreateuser" "noinherit"
-"nologin" "none" "nosuperuser" "nothing" "notify" "nowait" "nullif"
-"nulls" "object" "of" "oids" "operator" "option" "options" "out"
-"overlay" "owned" "owner" "parser" "partial" "partition" "password"
-"plans" "position" "preceding" "prepare" "prepared" "preserve" "prior"
+"nologin" "none" "noreplication" "nosuperuser" "nothing" "notify" "nowait" "nullif"
+"nulls" "object" "of" "off" "oids" "operator" "option" "options" "out"
+"overlay" "owned" "owner" "parser" "partial" "partition" "passing" "password"
+"plans" "position" "preceding" "precision" "prepare" "prepared" "preserve" "prior"
"privileges" "procedural" "procedure" "quote" "range" "read"
-"reassign" "recheck" "recursive" "reindex" "relative" "release"
-"rename" "repeatable" "replace" "replica" "reset" "restart" "restrict"
+"reassign" "recheck" "recursive" "ref" "reindex" "relative" "release"
+"rename" "repeatable" "replace" "replica" "replication" "reset" "restart" "restrict"
"returns" "revoke" "role" "rollback" "row" "rows" "rule" "savepoint"
-"schema" "scroll" "search" "second" "security" "sequence" "sequences"
+"schema" "scroll" "search" "second" "security" "sequence"
"serializable" "server" "session" "set" "setof" "share" "show"
-"simple" "stable" "standalone" "start" "statement" "statistics"
+"simple" "snapshot" "stable" "standalone" "start" "statement" "statistics"
"stdin" "stdout" "storage" "strict" "strip" "substring" "superuser"
"sysid" "system" "tables" "tablespace" "temp" "template" "temporary"
-"transaction" "treat" "trigger" "trim" "truncate" "trusted" "type"
-"unbounded" "uncommitted" "unencrypted" "unknown" "unlisten" "until"
-"update" "vacuum" "valid" "validator" "value" "values" "version"
-"view" "volatile" "whitespace" "work" "wrapper" "write"
-"xmlattributes" "xmlconcat" "xmlelement" "xmlforest" "xmlparse"
-"xmlpi" "xmlroot" "xmlserialize" "year" "yes"
+"transaction" "treat" "trim" "truncate" "trusted" "type" "types"
+"unbounded" "uncommitted" "unencrypted" "unlisten" "unlogged" "until"
+"update" "vacuum" "valid" "validate" "validator" "value" "values" "varying" "version"
+"view" "volatile" "whitespace" "without" "work" "wrapper" "write"
+"xmlattributes" "xmlconcat" "xmlelement" "xmlexists" "xmlforest" "xmlparse"
+"xmlpi" "xmlroot" "xmlserialize" "year" "yes" "zone"
)
;; Postgres Reserved
(sql-font-lock-keywords-builder 'font-lock-keyword-face nil
-"all" "analyse" "analyze" "and" "any" "array" "asc" "as" "asymmetric"
+"all" "analyse" "analyze" "and" "array" "asc" "as" "asymmetric"
"authorization" "binary" "both" "case" "cast" "check" "collate"
"column" "concurrently" "constraint" "create" "cross"
"current_catalog" "current_date" "current_role" "current_schema"
"fetch" "foreign" "for" "freeze" "from" "full" "grant" "group"
"having" "ilike" "initially" "inner" "in" "intersect" "into" "isnull"
"is" "join" "leading" "left" "like" "limit" "localtime"
-"localtimestamp" "natural" "notnull" "not" "null" "off" "offset"
+"localtimestamp" "natural" "notnull" "not" "null" "offset"
"only" "on" "order" "or" "outer" "overlaps" "over" "placing" "primary"
"references" "returning" "right" "select" "session_user" "similar"
"some" "symmetric" "table" "then" "to" "trailing" "true" "union"
"unique" "user" "using" "variadic" "verbose" "when" "where" "window"
"with"
+)
+
+ ;; Postgres PL/pgSQL
+ (sql-font-lock-keywords-builder 'font-lock-keyword-face nil
+"assign" "if" "case" "loop" "while" "for" "foreach" "exit" "elsif" "return"
+"raise" "execsql" "dynexecute" "perform" "getdiag" "open" "fetch" "move" "close"
)
;; Postgres Data Types
"bigint" "bigserial" "bit" "bool" "boolean" "box" "bytea" "char"
"character" "cidr" "circle" "date" "decimal" "double" "float4"
"float8" "inet" "int" "int2" "int4" "int8" "integer" "interval" "line"
-"lseg" "macaddr" "money" "numeric" "path" "point" "polygon"
-"precision" "real" "serial" "serial4" "serial8" "smallint" "text"
+"lseg" "macaddr" "money" "name" "numeric" "path" "point" "polygon"
+"precision" "real" "serial" "serial4" "serial8" "sequences" "smallint" "text"
"time" "timestamp" "timestamptz" "timetz" "tsquery" "tsvector"
-"txid_snapshot" "uuid" "varbit" "varchar" "varying" "without"
+"txid_snapshot" "unknown" "uuid" "varbit" "varchar" "varying" "without"
"xml" "zone"
)))
"collation" "column" "columns" "comment" "committed" "concurrent"
"constraint" "create" "cross" "data" "database" "default"
"delay_key_write" "delayed" "delete" "desc" "directory" "disable"
-"distinct" "distinctrow" "do" "drop" "dumpfile" "duplicate" "else"
+"distinct" "distinctrow" "do" "drop" "dumpfile" "duplicate" "else" "elseif"
"enable" "enclosed" "end" "escaped" "exists" "fields" "first" "for"
"force" "foreign" "from" "full" "fulltext" "global" "group" "handler"
"having" "heap" "high_priority" "if" "ignore" "in" "index" "infile"
(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)
"Configure font-lock and imenu with product-specific settings.
The KEYWORDS-ONLY flag is passed to font-lock to specify whether
-only keywords should be hilighted and syntactic hilighting
+only keywords should be highlighted and syntactic highlighting
skipped. The IMENU flag indicates whether `imenu-mode' should
also be configured."
(let
;; Get the product-specific syntax-alist.
- ((syntax-alist
- (append
- (sql-get-product-feature sql-product :syntax-alist)
- '((?_ . "w") (?. . "w")))))
+ ((syntax-alist (sql-product-font-lock-syntax-alist)))
;; Get the product-specific keywords.
(set (make-local-variable 'sql-mode-font-lock-keywords)
(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.
(append keywords old-val))))))
(defun sql-for-each-login (login-params body)
- "Iterates through login parameters and returns a list of results."
-
+ "Iterate through login parameters and return a list of results."
(delq nil
(mapcar
- (lambda (param)
- (let ((token (or (and (listp param) (car param)) param))
- (plist (or (and (listp param) (cdr param)) nil)))
-
- (funcall body token plist)))
+ #'(lambda (param)
+ (let ((token (or (car-safe param) param))
+ (plist (cdr-safe param)))
+ (funcall body token plist)))
login-params)))
\f
;;; Functions to switch highlighting
+(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))
+ (sql-get-product-feature sql-product :syntax-alist))
+ table))
+
+(defun sql-product-font-lock-syntax-alist ()
+ (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))
+ (sql-get-product-feature sql-product :syntax-alist))
+ '((?_ . "w"))))
+
(defun sql-highlight-product ()
"Turn on the font highlighting for the SQL product selected."
(when (derived-mode-p 'sql-mode)
+ ;; Enhance the syntax table for the product
+ (set-syntax-table (sql-product-syntax-table))
+
;; Setup font-lock
(sql-product-font-lock nil t)
(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-line-beginning-position is defined in Emacs 21
(defun comint-line-beginning-position ()
"Return the buffer position of the beginning of the line, after any prompt.
-The prompt is assumed to be any text at the beginning of the line matching
-the regular expression `comint-prompt-regexp', a buffer local variable."
+The prompt is assumed to be any text at the beginning of the line
+matching the regular expression `comint-prompt-regexp', a buffer
+local variable."
(save-excursion (comint-bol nil) (point))))
-\f
+;;; SMIE support
+
+;; Needs a lot more love than I can provide. --Stef
+
+;; (require 'smie)
+
+;; (defconst sql-smie-grammar
+;; (smie-prec2->grammar
+;; (smie-bnf->prec2
+;; ;; Partly based on http://www.h2database.com/html/grammar.html
+;; '((cmd ("SELECT" select-exp "FROM" select-table-exp)
+;; )
+;; (select-exp ("*") (exp) (exp "AS" column-alias))
+;; (column-alias)
+;; (select-table-exp (table-exp "WHERE" exp) (table-exp))
+;; (table-exp)
+;; (exp ("CASE" exp "WHEN" exp "THEN" exp "ELSE" exp "END")
+;; ("CASE" exp "WHEN" exp "THEN" exp "END"))
+;; ;; Random ad-hoc additions.
+;; (foo (foo "," foo))
+;; )
+;; '((assoc ",")))))
+
+;; (defun sql-smie-rules (kind token)
+;; (pcase (cons kind token)
+;; (`(:list-intro . ,_) t)
+;; (`(:before . "(") (smie-rule-parent))))
+
+;;; Motion Functions
+
+(defun sql-statement-regexp (prod)
+ (let* ((ansi-stmt (sql-get-product-feature 'ansi :statement))
+ (prod-stmt (sql-get-product-feature prod :statement)))
+ (concat "^\\<"
+ (if prod-stmt
+ ansi-stmt
+ (concat "\\(" ansi-stmt "\\|" prod-stmt "\\)"))
+ "\\>")))
+
+(defun sql-beginning-of-statement (arg)
+ "Move to the beginning of the current SQL statement."
+ (interactive "p")
+
+ (let ((here (point))
+ (regexp (sql-statement-regexp sql-product))
+ last next)
+
+ ;; Go to the end of the statement before the start we desire
+ (setq last (or (sql-end-of-statement (- arg))
+ (point-min)))
+ ;; And find the end after that
+ (setq next (or (sql-end-of-statement 1)
+ (point-max)))
+
+ ;; Our start must be between them
+ (goto-char last)
+ ;; Find an beginning-of-stmt that's not in a comment
+ (while (and (re-search-forward regexp next t 1)
+ (nth 7 (syntax-ppss)))
+ (goto-char (match-end 0)))
+ (goto-char
+ (if (match-data)
+ (match-beginning 0)
+ last))
+ (beginning-of-line)
+ ;; If we didn't move, try again
+ (when (= here (point))
+ (sql-beginning-of-statement (* 2 (cl-signum arg))))))
+
+(defun sql-end-of-statement (arg)
+ "Move to the end of the current SQL statement."
+ (interactive "p")
+ (let ((term (sql-get-product-feature sql-product :terminator))
+ (re-search (if (> 0 arg) 're-search-backward 're-search-forward))
+ (here (point))
+ (n 0))
+ (when (consp term)
+ (setq term (car term)))
+ ;; Iterate until we've moved the desired number of stmt ends
+ (while (not (= (cl-signum arg) 0))
+ ;; if we're looking at the terminator, jump by 2
+ (if (or (and (> 0 arg) (looking-back term))
+ (and (< 0 arg) (looking-at term)))
+ (setq n 2)
+ (setq n 1))
+ ;; If we found another end-of-stmt
+ (if (not (apply re-search term nil t n nil))
+ (setq arg 0)
+ ;; count it if we're not in a comment
+ (unless (nth 7 (syntax-ppss))
+ (setq arg (- arg (cl-signum arg))))))
+ (goto-char (if (match-data)
+ (match-end 0)
+ here))))
;;; Small functions
(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."
(defun sql-help-list-products (indent freep)
"Generate listing of products available for use under SQLi.
-List products with :free-softare attribute set to FREEP. Indent
+List products with :free-software attribute set to FREEP. Indent
each line with INDENT."
(let (sqli-func doc)
"]\n"))))
doc))
-;;;###autoload
(defun sql-help ()
- "Show short help for the SQL modes.
+ "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."
- (interactive)
-
- ;; Insert references to loaded products into the help buffer string
- (let ((doc (documentation 'sql-help t))
- changedp)
- (setq changedp nil)
+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-*\n" doc 0)
+ (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)
- changedp t))
-
+ t t doc 0)))
;; Insert non-FREE software list
- (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]NONFREE\\s-*\n" doc 0)
+ (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)
- changedp t))
-
- ;; If we changed the help text, save the change so that the help
- ;; sub-system will see it
- (when changedp
- (put 'sql-help 'function-documentation doc)))
+ t t doc 0)))
+ doc))
- ;; Call help on this function
- (describe-function 'sql-help))
+(defun sql-default-value (var)
+ "Fetch the value of a variable.
-(defun sql-read-passwd (prompt &optional default)
- "Read a password using PROMPT. Optional DEFAULT is password to start with."
- (read-passwd prompt nil default))
+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 (prompt last-value history-var plist)
+(defun sql-get-login-ext (symbol prompt history-var plist)
"Prompt user with extended login parameters.
+The global value of SYMBOL is the last value and the global value
+of the SYMBOL is set based on the user's input.
+
If PLIST is nil, then the user is simply prompted for a string
value.
The `:completion' property prompts for a string specified by its
value. (The property value is used as the PREDICATE argument to
`completing-read'.)"
- (let* ((default (plist-get plist :default))
- (prompt-def
- (if default
- (if (string-match "\\(\\):[ \t]*\\'" prompt)
- (replace-match (format " (default \"%s\")" default) t t prompt 1)
- (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) default t
- (file-name-nondirectory last-value)
- (when (plist-get plist :file)
- `(lambda (f)
- (string-match
- (concat "\\<" ,(plist-get plist :file) "\\>")
- (file-name-nondirectory f)))))))
-
- ((plist-member plist :completion)
- (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))))))
+ (set-default
+ symbol
+ (let* ((default (plist-get plist :default))
+ (last-value (sql-default-value symbol))
+ (prompt-def
+ (if default
+ (if (string-match "\\(\\):[ \t]*\\'" prompt)
+ (replace-match (format " (default \"%s\")" default) t t prompt 1)
+ (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) default t
+ (file-name-nondirectory last-value)
+ (when (plist-get plist :file)
+ `(lambda (f)
+ (string-match
+ (concat "\\<" ,(plist-get plist :file) "\\>")
+ (file-name-nondirectory f)))))))
+
+ ((plist-member plist :completion)
+ (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
+ (read-string prompt-def last-value history-var default))))))
(defun sql-get-login (&rest what)
"Get username, password and database from the user.
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 (consp w) (car w)) w))
- (plist (or (and (consp w) (cdr w)) nil)))
+ (dolist (w what)
+ (let ((plist (cdr-safe w)))
+ (pcase (or (car-safe w) w)
+ (`user
+ (sql-get-login-ext 'sql-user "User: " 'sql-user-history plist))
- (cond
- ((eq token 'user) ; user
- (setq sql-user
- (sql-get-login-ext "User: " sql-user
- 'sql-user-history plist)))
-
- ((eq token 'password) ; password
- (setq sql-password
- (sql-read-passwd "Password: " sql-password)))
-
- ((eq token 'server) ; server
- (setq sql-server
- (sql-get-login-ext "Server: " sql-server
- 'sql-server-history plist)))
-
- ((eq token 'database) ; database
- (setq sql-database
- (sql-get-login-ext "Database: " sql-database
- 'sql-database-history plist)))
-
- ((eq token 'port) ; port
- (setq sql-port
- (sql-get-login-ext "Port: " sql-port
- nil (append '(:number t) plist)))))))
- what))
-
-(defun sql-find-sqli-buffer (&optional product)
- "Returns the name of the current default SQLi buffer or nil.
+ (`password
+ (setq-default sql-password
+ (read-passwd "Password: " nil (sql-default-value 'sql-password))))
+
+ (`server
+ (sql-get-login-ext 'sql-server "Server: " 'sql-server-history plist))
+
+ (`database
+ (sql-get-login-ext 'sql-database "Database: "
+ 'sql-database-history plist))
+
+ (`port
+ (sql-get-login-ext 'sql-port "Port: "
+ nil (append '(:number t) plist)))))))
+
+(defun sql-find-sqli-buffer (&optional product connection)
+ "Return 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 (or product sql-product)))
(or
;; Current sql-buffer, if there is one.
- (and (sql-buffer-live-p buf prod)
+ (and (sql-buffer-live-p buf prod connection)
buf)
;; Global sql-buffer
(and (setq buf (default-value 'sql-buffer))
- (sql-buffer-live-p buf prod)
+ (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)
- (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")
+ (user-error "There is no suitable SQLi buffer")
(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)))))))
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."
(interactive)
- (if (null (buffer-live-p (get-buffer sql-buffer)))
- (message "%s has no SQLi buffer set." (buffer-name (current-buffer)))
+ (if (or (null sql-buffer)
+ (null (buffer-live-p (get-buffer sql-buffer))))
+ (user-error "%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))))
+ (user-error "Buffer %s has no process" sql-buffer)
+ (user-error "Current SQLi buffer is %s" sql-buffer))))
(defun sql-make-alternate-buffer-name ()
"Return a string that can be used to rename a SQLi buffer.
;; 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)
- (cond
- ((eq token 'user)
- (unless (string= "" sql-user)
- (list "/" sql-user)))
- ((eq token 'port)
- (unless (or (not (numberp sql-port))
- (= 0 sql-port))
- (list ":" (number-to-string sql-port))))
- ((eq token 'server)
- (unless (string= "" sql-server)
- (list "."
- (if (plist-member plist :file)
- (file-name-nondirectory sql-server)
- sql-server))))
- ((eq token 'database)
- (unless (string= "" sql-database)
- (list "@"
- (if (plist-member plist :file)
- (file-name-nondirectory sql-database)
- sql-database))))
-
- ((eq token 'password) nil)
- (t 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))
;; Using DB2 interactively, newlines must be escaped with " \".
;; The space before the backslash is relevant.
+
(defun sql-escape-newlines-filter (string)
"Escape newlines in STRING.
Every newline in STRING will be preceded with a space and a backslash."
- (let ((result "") (start 0) mb me)
- (while (string-match "\n" string start)
- (setq mb (match-beginning 0)
- me (match-end 0)
- result (concat result
- (substring string start mb)
- (if (and (> mb 1)
- (string-equal " \\" (substring string (- mb 2) mb)))
- "" " \\\n"))
- start me))
- (concat result (substring string start))))
+ (if (not sql-db2-escape-newlines)
+ string
+ (let ((result "") (start 0) mb me)
+ (while (string-match "\n" string start)
+ (setq mb (match-beginning 0)
+ me (match-end 0)
+ result (concat result
+ (substring string start mb)
+ (if (and (> mb 1)
+ (string-equal " \\" (substring string (- mb 2) mb)))
+ "" " \\\n"))
+ start me))
+ (concat result (substring string start)))))
\f
Allows the suppression of continuation prompts.")
-(defvar sql-output-by-send nil
- "Non-nil if the command in the input was generated by `sql-send-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)))
;;; Strip out continuation prompts
+(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."
+ (replace-regexp-in-string "\\^" "\\\\`" comint-prompt-regexp))
+
+(defun sql-ends-with-prompt-re ()
+ "Anchor the prompt expression at the end of the output line.
+Remove the start of line regexp from the prompt expression since
+it may not follow newline characters in the output line."
+ (concat (replace-regexp-in-string "\\^" "" sql-prompt-regexp) "\\'"))
+
(defun sql-interactive-remove-continuation-prompt (oline)
"Strip out continuation prompts out of the OLINE.
Added to the `comint-preoutput-filter-functions' hook in a SQL
-interactive buffer. If `sql-outut-newline-count' is greater than
+interactive buffer. If `sql-output-newline-count' is greater than
zero, then an output line matching the continuation prompt is filtered
-out. If the count is one, then the prompt is replaced with a newline
-to force the output from the query to appear on a new line."
- (if (and sql-prompt-cont-regexp
- sql-output-newline-count
- (numberp sql-output-newline-count)
- (>= sql-output-newline-count 1))
- (progn
- (while (and oline
- sql-output-newline-count
- (> sql-output-newline-count 0)
- (string-match sql-prompt-cont-regexp oline))
-
- (setq oline
- (replace-match (if (and
- (= 1 sql-output-newline-count)
- sql-output-by-send)
- "\n" "")
- nil nil oline)
- sql-output-newline-count
- (1- sql-output-newline-count)))
- (if (= sql-output-newline-count 0)
- (setq sql-output-newline-count nil))
- (setq sql-output-by-send nil))
- (setq sql-output-newline-count nil))
- oline)
+out. If the count is zero, then a newline is inserted into the output
+to force the output from the query to appear on a new line.
+
+The complication to this filter is that the continuation prompts
+may arrive in multiple chunks. If they do, then the function
+saves any unfiltered output in a buffer and prepends that buffer
+to the next chunk to properly match the broken-up prompt.
+
+If the filter gets confused, it should reset and stop filtering
+to avoid deleting non-prompt output."
+
+ (when comint-prompt-regexp
+ (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 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 "")))
+
+ ;; 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
+ (unless (and (not (string= oline ""))
+ (string-match (sql-ends-with-prompt-re) oline)
+ (>= (match-end 0) (length oline)))
+ (setq last-nl 0)
+ (while (string-match "\n" oline last-nl)
+ (setq last-nl (match-end 0)))
+ (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."
(setq sql-output-newline-count
(if sql-output-newline-count
(1+ sql-output-newline-count)
- 1)))
- (setq sql-output-by-send t)))
+ 1)))))
(defun sql-remove-tabs-filter (str)
"Replace tab characters with spaces."
;;; Redirect output functions
-(defun sql-redirect (command combuf &optional outbuf save-prior)
+(defvar sql-debug-redirect nil
+ "If non-nil, display messages related to the use of redirection.")
+
+(defun sql-str-literal (s)
+ (concat "'" (replace-regexp-in-string "[']" "''" s) "'"))
+
+(defun sql-redirect (sqlbuf command &optional outbuf save-prior)
"Execute the SQL command and send output to OUTBUF.
-COMBUF must be an active SQL interactive buffer. OUTBUF may be
+SQLBUF 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
+of commands accepted by the SQLi program. COMMAND may also be a
+list of SQLi command strings."
+
+ (let* ((visible (and outbuf
+ (not (string= " " (substring outbuf 0 1))))))
+ (when visible
+ (message "Executing SQL command..."))
+ (if (consp command)
+ (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
- (toggle-read-only -1)
+ (setq-local view-no-disable-on-exit t)
+ (read-only-mode -1)
(unless save-prior
(erase-buffer))
(goto-char (point-max))
(insert "\n"))
(setq start (point)))
+ (when sql-debug-redirect
+ (message ">>SQL> %S" command))
+
;; 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
(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 (command combuf regexp &optional regexp-groups)
+(defun sql-redirect-value (sqlbuf command regexp &optional regexp-groups)
"Execute the SQL command and return part of result.
-COMBUF must be an active SQL interactive buffer. COMMAND should
+SQLBUF 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
(let ((outbuf " *SQL-Redirect-values*")
(results nil))
- (sql-redirect command combuf outbuf nil)
+ (sql-redirect sqlbuf command 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)
+ (let ((i (/ (length (match-data)) 2))
(r nil))
- (while (match-beginning i)
+ (while (> i 0)
+ (setq i (1- i))
(push (match-string i) r))
- (nreverse r)))
+ 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))))
+ (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)
(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.
+ (when sql-debug-redirect
+ (message ">>SQL> = %S" (reverse results)))
+
+ (nreverse results)))
+
+(defun sql-execute (sqlbuf outbuf command enhanced arg)
+ "Execute a command in a SQL interactive buffer and capture 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.
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. "
+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))))
+ #'(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))
(if (zerop (buffer-size outbuf))
(kill-buffer outbuf)
(get-lru-window))))
(with-current-buffer outbuf
(set-buffer-modified-p nil)
- (toggle-read-only 1))
- (view-buffer-other-window outbuf)
+ (read-only-mode +1))
+ (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)
(car command))))
- (sql-execute sqlbuf outbuf command arg)))
+ (sql-execute sqlbuf outbuf command enhanced arg)))
+
+(defvar sql-completion-object nil
+ "A list of database objects used for completion.
+
+The list is maintained in SQL interactive buffers.")
+
+(defvar sql-completion-column nil
+ "A list of column names used for completion.
+
+The list is maintained in SQL interactive buffers.")
+
+(defun sql-build-completions-1 (schema completion-list feature)
+ "Generate a list of objects in the database for use as completions."
+ (let ((f (sql-get-product-feature sql-product feature)))
+ (when f
+ (set completion-list
+ (let (cl)
+ (dolist (e (append (symbol-value completion-list)
+ (apply f (current-buffer) (cons schema nil)))
+ cl)
+ (unless (member e cl) (setq cl (cons e cl))))
+ (sort cl #'string<))))))
+
+(defun sql-build-completions (schema)
+ "Generate a list of names in the database for use as completions."
+ (sql-build-completions-1 schema 'sql-completion-object :completion-object)
+ (sql-build-completions-1 schema 'sql-completion-column :completion-column))
+
+(defvar sql-completion-sqlbuf nil)
+
+(defun sql--completion-table (string pred action)
+ (when sql-completion-sqlbuf
+ (with-current-buffer sql-completion-sqlbuf
+ (let ((schema (and (string-match "\\`\\(\\sw\\(:?\\sw\\|\\s_\\)*\\)[.]" string)
+ (downcase (match-string 1 string)))))
+
+ ;; If we haven't loaded any object name yet, load local schema
+ (unless sql-completion-object
+ (sql-build-completions nil))
+
+ ;; If they want another schema, load it if we haven't yet
+ (when schema
+ (let ((schema-dot (concat schema "."))
+ (schema-len (1+ (length schema)))
+ (names sql-completion-object)
+ has-schema)
+
+ (while (and (not has-schema) names)
+ (setq has-schema (and
+ (>= (length (car names)) schema-len)
+ (string= schema-dot
+ (downcase (substring (car names)
+ 0 schema-len))))
+ names (cdr names)))
+ (unless has-schema
+ (sql-build-completions schema)))))
+
+ ;; Try to find the completion
+ (complete-with-action action sql-completion-object string pred))))
(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))
+ (let* ((tname
+ (and (buffer-local-value 'sql-contains-names (current-buffer))
+ (thing-at-point-looking-at
+ (concat "\\_<\\sw\\(:?\\sw\\|\\s_\\)*"
+ "\\(?:[.]+\\sw\\(?:\\sw\\|\\s_\\)*\\)*\\_>"))
+ (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))
+ (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))))
(defun sql-list-all (&optional enhanced)
- "List all database objects."
+ "List all database objects.
+With optional prefix argument ENHANCED, displays additional
+details or extends the listing to include other schemas 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)))
+ (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
+ (set (make-local-variable 'sql-contains-names) t)
+ (set (make-local-variable 'sql-buffer) sqlbuf))))
(defun sql-list-table (name &optional enhanced)
- "List the details of a database table. "
+ "List the details of a database table named NAME.
+Displays the columns in the relation. With optional prefix argument
+ENHANCED, displays additional details about each column."
(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"))
+ (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
;;; SQL mode -- uses SQL interactive mode
`sql-interactive-mode'.
Note that SQL doesn't have an escape character unless you specify
-one. If you specify backslash as escape character in SQL,
-you must tell Emacs. Here's how to do that in your `~/.emacs' file:
+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
(lambda ()
(if sql-mode-menu
(easy-menu-add sql-mode-menu)); XEmacs
+ ;; (smie-setup sql-smie-grammar #'sql-smie-rules)
(set (make-local-variable 'comment-start) "--")
;; Make each buffer in sql-mode remember the "current" SQLi buffer.
(make-local-variable 'sql-buffer)
(set (make-local-variable 'paragraph-separate) "[\f]*$")
(set (make-local-variable 'paragraph-start) "[\n\f]")
;; Abbrevs
- (setq abbrev-all-caps 1)
+ (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
If you want to make SQL buffers limited in length, add the function
`comint-truncate-buffer' to `comint-output-filter-functions'.
-Here is an example for your .emacs file. It keeps the SQLi buffer a
+Here is an example for your init file. It keeps the SQLi buffer a
certain length.
\(add-hook 'sql-interactive-mode-hook
sql-product))
;; Setup the mode.
- (setq major-mode 'sql-interactive-mode) ;FIXME: Use define-derived-mode.
+ (setq major-mode 'sql-interactive-mode)
(setq mode-name
(concat "SQLi[" (or (sql-get-product-feature sql-product :name)
(symbol-name sql-product)) "]"))
;; Note that making KEYWORDS-ONLY nil will cause havoc if you try
;; SELECT 'x' FROM DUAL with SQL*Plus, because the title of the column
- ;; will have just one quote. Therefore syntactic hilighting is
+ ;; will have just one quote. Therefore syntactic highlighting is
;; disabled for interactive buffers. No imenu support.
(sql-product-font-lock t nil)
(setq abbrev-all-caps 1)
;; Exiting the process will call sql-stop.
(set-process-sentinel (get-buffer-process (current-buffer)) 'sql-stop)
- ;; Save the connection name
- (make-local-variable 'sql-connection)
- ;; Create a usefull name for renaming this buffer later.
+ ;; Save the connection and login params
+ (set (make-local-variable 'sql-user) sql-user)
+ (set (make-local-variable 'sql-database) sql-database)
+ (set (make-local-variable 'sql-server) sql-server)
+ (set (make-local-variable 'sql-port) sql-port)
+ (set (make-local-variable 'sql-connection) sql-connection)
+ (setq-default sql-connection nil)
+ ;; Contains the name of database objects
+ (set (make-local-variable 'sql-contains-names) t)
+ ;; Keep track of existing object names
+ (set (make-local-variable 'sql-completion-object) nil)
+ (set (make-local-variable 'sql-completion-column) nil)
+ ;; Create a useful name for renaming this buffer later.
(set (make-local-variable 'sql-alternate-buffer-name)
(sql-make-alternate-buffer-name))
;; User stuff. Initialize before the hook.
(set (make-local-variable 'sql-prompt-cont-regexp)
(sql-get-product-feature sql-product :prompt-cont-regexp))
(make-local-variable 'sql-output-newline-count)
- (make-local-variable 'sql-output-by-send)
+ (make-local-variable 'sql-preoutput-hold)
(add-hook 'comint-preoutput-filter-functions
'sql-interactive-remove-continuation-prompt nil t)
(make-local-variable 'sql-input-ring-separator)
"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)))
;;;###autoload
-(defun sql-connect (connection)
+(defun sql-connect (connection &optional new-name)
"Connect to an interactive session using CONNECTION settings.
See `sql-connection-alist' to see how to define connections and
;; Prompt for the connection from those defined in the alist
(interactive
(if sql-connection-alist
- (list (sql-read-connection "Connection: " nil '(nil)))
- nil))
+ (list (sql-read-connection "Connection: " nil '(nil))
+ current-prefix-arg)
+ (user-error "No SQL Connections defined")))
;; Are there connections defined
(if sql-connection-alist
;; Was one selected
(when connection
;; Get connection settings
- (let ((connect-set (assoc connection sql-connection-alist)))
+ (let ((connect-set (assoc-string connection sql-connection-alist t)))
;; Settings are defined
(if connect-set
;; Set the desired parameters
- (eval `(let*
- (,@(cdr connect-set)
- ;; :sqli-login params variable
- (param-var (sql-get-product-feature sql-product
- :sqli-login nil t))
- ;; :sqli-login params value
- (login-params (sql-get-product-feature sql-product
- :sqli-login))
- ;; which params are in the connection
- (set-params (mapcar
- (lambda (v)
- (cond
- ((eq (car v) 'sql-user) 'user)
- ((eq (car v) 'sql-password) 'password)
- ((eq (car v) 'sql-server) 'server)
- ((eq (car v) 'sql-database) 'database)
- ((eq (car v) 'sql-port) 'port)
- (t (car v))))
- (cdr connect-set)))
- ;; the remaining params (w/o the connection params)
- (rem-params (sql-for-each-login
- login-params
- (lambda (token plist)
- (unless (member token set-params)
- (if plist
- (cons token plist)
- token)))))
- ;; Remember the connection
- (sql-connection connection))
-
- ;; Set the remaining parameters and start the
- ;; interactive session
- (eval `(let ((,param-var ',rem-params))
- (sql-product-interactive sql-product)))))
- (message "SQL Connection <%s> does not exist" connection)
+ (let (param-var login-params set-params rem-params)
+
+ ;; :sqli-login params variable
+ (setq param-var
+ (sql-get-product-feature sql-product :sqli-login nil t))
+
+ ;; :sqli-login params value
+ (setq login-params
+ (sql-get-product-feature sql-product :sqli-login))
+
+ ;; 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)))
+ (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)))))
+
+ ;; Set the parameters and start the interactive session
+ (mapc
+ #'(lambda (vv)
+ (set-default (car vv) (eval (cadr vv))))
+ (cdr connect-set))
+ (setq-default sql-connection connection)
+
+ ;; Start the SQLi session with revised list of login parameters
+ (eval `(let ((,param-var ',rem-params))
+ (sql-product-interactive ',sql-product ',new-name))))
+
+ (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: ")
- (if sql-connection
- (message "This session was started by a connection; it's already been saved.")
-
- (let ((login (sql-get-product-feature sql-product :sqli-login))
- (alist sql-connection-alist)
- connect)
-
- ;; Remove the existing connection if the user says so
- (when (and (assoc name alist)
- (yes-or-no-p (format "Replace connection definition <%s>? " name)))
- (setq alist (assq-delete-all name alist)))
-
- ;; Add the new connection if it doesn't exist
- (if (assoc name alist)
- (message "Connection <%s> already exists" name)
- (setq connect
- (append (list name)
+ (unless (derived-mode-p 'sql-interactive-mode)
+ (user-error "Not in a SQL interactive mode!"))
+
+ ;; Capture the buffer local settings
+ (let* ((buf (current-buffer))
+ (connection (buffer-local-value 'sql-connection buf))
+ (product (buffer-local-value 'sql-product buf))
+ (user (buffer-local-value 'sql-user buf))
+ (database (buffer-local-value 'sql-database buf))
+ (server (buffer-local-value 'sql-server buf))
+ (port (buffer-local-value 'sql-port buf)))
+
+ (if connection
+ (message "This session was started by a connection; it's already been saved.")
+
+ (let ((login (sql-get-product-feature product :sqli-login))
+ (alist sql-connection-alist)
+ connect)
+
+ ;; Remove the existing connection if the user says so
+ (when (and (assoc name alist)
+ (yes-or-no-p (format "Replace connection definition <%s>? " name)))
+ (setq alist (assq-delete-all name alist)))
+
+ ;; Add the new connection if it doesn't exist
+ (if (assoc name alist)
+ (user-error "Connection <%s> already exists" name)
+ (setq connect
+ (cons name
(sql-for-each-login
`(product ,@login)
- (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))
- ((eq token 'port) `(sql-port ,sql-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)))
+ (setq alist (append alist (list connect)))
- ;; confirm whether we want to save the connections
- (if (yes-or-no-p "Save the connections for future sessions? ")
- (customize-save-variable 'sql-connection-alist alist)
- (customize-set-variable 'sql-connection-alist alist))))))
+ ;; confirm whether we want to save the connections
+ (if (yes-or-no-p "Save the connections for future sessions? ")
+ (customize-save-variable 'sql-connection-alist alist)
+ (customize-set-variable 'sql-connection-alist alist)))))))
(defun sql-connection-menu-filter (tail)
- "Generates menu entries for using each connection."
+ "Generate menu entries for using each connection."
(append
(mapcar
- (lambda (conn)
- (vector
- (format "Connection <%s>" (car conn))
- (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.
;; Get the value of product that we need
(setq product
(cond
- ((and product ; Product specified
- (symbolp product)) product)
((= (prefix-numeric-value product) 4) ; C-u, prompt for product
(sql-read-product "SQL product: " sql-product))
+ ((and product ; Product specified
+ (symbolp product)) product)
(t sql-product))) ; Default to sql-product
;; If we have a product and it has a interactive mode
(when (sql-get-product-feature product :sqli-comint-func)
;; If no new name specified, try to pop to an active SQL
;; interactive for the same product
- (let ((buf (sql-find-sqli-buffer product)))
+ (let ((buf (sql-find-sqli-buffer product sql-connection)))
(if (and (not new-name) buf)
(pop-to-buffer buf)
new-sqli-buffer)
;; Get credentials.
- (apply 'sql-get-login (sql-get-product-feature product :sqli-login))
+ (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))
+ (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)))
+ (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
+ (setq new-sqli-buffer (current-buffer))
(when new-name
(sql-rename-buffer new-name))
+ (set (make-local-variable 'sql-buffer)
+ (buffer-name new-sqli-buffer))
- ;; Set `sql-buffer' in the new buffer and the start buffer
- (setq sql-buffer (buffer-name new-sqli-buffer))
+ ;; Set `sql-buffer' in the start buffer
(with-current-buffer start-buffer
- (setq sql-buffer (buffer-name new-sqli-buffer))
- (run-hooks 'sql-set-sqli-hook))
-
+ (when (derived-mode-p 'sql-mode)
+ (setq sql-buffer (buffer-name new-sqli-buffer))
+ (run-hooks 'sql-set-sqli-hook)))
+
+ ;; 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)))
+ (while (and (memq (process-status proc) '(open run))
+ (accept-process-output proc 2.5)
+ (progn (goto-char (point-max))
+ (not (looking-back sql-prompt-regexp))))))
+ (run-hooks 'sql-login-hook)
;; All done.
(message "Login...done")
- (pop-to-buffer sql-buffer)))))
- (message "No default SQL product defined. Set `sql-product'.")))
+ (pop-to-buffer new-sqli-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.
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)
+ ;; Make sure we can find the program. `executable-find' does not
+ ;; 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))
- ;; Make sure buffer name is unique
+ ;; Make sure buffer name is unique.
(when (sql-buffer-live-p (format "*%s*" buf-name))
(setq buf-name (format "SQL-%s" product))
(when (sql-buffer-live-p (format "*%s*" buf-name))
(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)
;; is meaningless; database without user/password is meaningless,
;; because "@param" will ask sqlplus to interpret the script
;; "param".
- (let ((parameter nil))
+ (let (parameter nlslang coding)
(if (not (string= "" sql-user))
(if (not (string= "" sql-password))
(setq parameter (concat sql-user "/" sql-password))
(if parameter
(setq parameter (nconc (list parameter) options))
(setq parameter options))
- (sql-comint product parameter)))
+ (sql-comint product parameter)
+ ;; Set process coding system to agree with the interpreter
+ (setq nlslang (or (getenv "NLS_LANG") "")
+ coding (dolist (cs
+ ;; Are we missing any common NLS character sets
+ '(("US8PC437" . cp437)
+ ("EL8PC737" . cp737)
+ ("WE8PC850" . cp850)
+ ("EE8PC852" . cp852)
+ ("TR8PC857" . cp857)
+ ("WE8PC858" . cp858)
+ ("IS8PC861" . cp861)
+ ("IW8PC1507" . cp862)
+ ("N8PC865" . cp865)
+ ("RU8PC866" . cp866)
+ ("US7ASCII" . us-ascii)
+ ("UTF8" . utf-8)
+ ("AL32UTF8" . utf-8)
+ ("AL16UTF16" . utf-16))
+ (or coding 'utf-8))
+ (when (string-match (format "\\.%s\\'" (car cs)) nlslang)
+ (setq coding (cdr cs)))))
+ (set-buffer-process-coding-system coding coding)))
+
+(defun sql-oracle-save-settings (sqlbuf)
+ "Save most SQL*Plus settings so they may be reset by \\[sql-redirect]."
+ ;; Note: does not capture the following settings:
+ ;;
+ ;; APPINFO
+ ;; BTITLE
+ ;; COMPATIBILITY
+ ;; COPYTYPECHECK
+ ;; MARKUP
+ ;; RELEASE
+ ;; REPFOOTER
+ ;; REPHEADER
+ ;; SQLPLUSCOMPATIBILITY
+ ;; TTITLE
+ ;; USER
+ ;;
+
+ (append
+ ;; (apply #'concat (append
+ ;; '("SET")
+
+ ;; option value...
+ (sql-redirect-value
+ sqlbuf
+ (concat "SHOW ARRAYSIZE AUTOCOMMIT AUTOPRINT AUTORECOVERY AUTOTRACE"
+ " CMDSEP COLSEP COPYCOMMIT DESCRIBE ECHO EDITFILE EMBEDDED"
+ " ESCAPE FLAGGER FLUSH HEADING INSTANCE LINESIZE LNO LOBOFFSET"
+ " LOGSOURCE LONG LONGCHUNKSIZE NEWPAGE NULL NUMFORMAT NUMWIDTH"
+ " PAGESIZE PAUSE PNO RECSEP SERVEROUTPUT SHIFTINOUT SHOWMODE"
+ " SPOOL SQLBLANKLINES SQLCASE SQLCODE SQLCONTINUE SQLNUMBER"
+ " SQLPROMPT SUFFIX TAB TERMOUT TIMING TRIMOUT TRIMSPOOL VERIFY")
+ "^.+$"
+ "SET \\&")
+
+ ;; option "c" (hex xx)
+ (sql-redirect-value
+ sqlbuf
+ (concat "SHOW BLOCKTERMINATOR CONCAT DEFINE SQLPREFIX SQLTERMINATOR"
+ " UNDERLINE HEADSEP RECSEPCHAR")
+ "^\\(.+\\) (hex ..)$"
+ "SET \\1")
+
+ ;; FEEDBACK ON for 99 or more rows
+ ;; feedback OFF
+ (sql-redirect-value
+ sqlbuf
+ "SHOW FEEDBACK"
+ "^\\(?:FEEDBACK ON for \\([[:digit:]]+\\) or more rows\\|feedback \\(OFF\\)\\)"
+ "SET FEEDBACK \\1\\2")
+
+ ;; wrap : lines will be wrapped
+ ;; wrap : lines will be truncated
+ (list (concat "SET WRAP "
+ (if (string=
+ (car (sql-redirect-value
+ sqlbuf
+ "SHOW WRAP"
+ "^wrap : lines will be \\(wrapped\\|truncated\\)" 1))
+ "wrapped")
+ "ON" "OFF")))))
+
+(defun sql-oracle-restore-settings (sqlbuf saved-settings)
+ "Restore the SQL*Plus settings in SAVED-SETTINGS."
+
+ ;; Remove any settings that haven't changed
+ (mapc
+ #'(lambda (one-cur-setting)
+ (setq saved-settings (delete one-cur-setting saved-settings)))
+ (sql-oracle-save-settings sqlbuf))
+
+ ;; Restore the changed settings
+ (sql-redirect sqlbuf saved-settings))
+
+(defun sql-oracle-list-all (sqlbuf outbuf enhanced _table-name)
+ ;; Query from USER_OBJECTS or ALL_OBJECTS
+ (let ((settings (sql-oracle-save-settings sqlbuf))
+ (simple-sql
+ (concat
+ "SELECT INITCAP(x.object_type) AS SQL_EL_TYPE "
+ ", x.object_name AS SQL_EL_NAME "
+ "FROM user_objects x "
+ "WHERE x.object_type NOT LIKE '%% BODY' "
+ "ORDER BY 2, 1;"))
+ (enhanced-sql
+ (concat
+ "SELECT INITCAP(x.object_type) AS SQL_EL_TYPE "
+ ", x.owner ||'.'|| x.object_name AS SQL_EL_NAME "
+ "FROM all_objects x "
+ "WHERE x.object_type NOT LIKE '%% BODY' "
+ "AND x.owner <> 'SYS' "
+ "ORDER BY 2, 1;")))
+
+ (sql-redirect sqlbuf
+ (concat "SET LINESIZE 80 PAGESIZE 50000 TRIMOUT ON"
+ " TAB OFF TIMING OFF FEEDBACK OFF"))
+
+ (sql-redirect sqlbuf
+ (list "COLUMN SQL_EL_TYPE HEADING \"Type\" FORMAT A19"
+ "COLUMN SQL_EL_NAME HEADING \"Name\""
+ (format "COLUMN SQL_EL_NAME FORMAT A%d"
+ (if enhanced 60 35))))
+
+ (sql-redirect sqlbuf
+ (if enhanced enhanced-sql simple-sql)
+ outbuf)
+
+ (sql-redirect sqlbuf
+ '("COLUMN SQL_EL_NAME CLEAR"
+ "COLUMN SQL_EL_TYPE CLEAR"))
+
+ (sql-oracle-restore-settings sqlbuf settings)))
+
+(defun sql-oracle-list-table (sqlbuf outbuf _enhanced table-name)
+ "Implements :list-table under Oracle."
+ (let ((settings (sql-oracle-save-settings sqlbuf)))
+
+ (sql-redirect sqlbuf
+ (format
+ (concat "SET LINESIZE %d PAGESIZE 50000"
+ " DESCRIBE DEPTH 1 LINENUM OFF INDENT ON")
+ (max 65 (min 120 (window-width)))))
+
+ (sql-redirect sqlbuf (format "DESCRIBE %s" table-name)
+ outbuf)
+
+ (sql-oracle-restore-settings sqlbuf settings)))
+
+(defcustom sql-oracle-completion-types '("FUNCTION" "PACKAGE" "PROCEDURE"
+ "SEQUENCE" "SYNONYM" "TABLE" "TRIGGER"
+ "TYPE" "VIEW")
+ "List of object types to include for completion under Oracle.
+
+See the distinct values in ALL_OBJECTS.OBJECT_TYPE for possible values."
+ :version "24.1"
+ :type '(repeat string)
+ :group 'SQL)
+(defun sql-oracle-completion-object (sqlbuf schema)
+ (sql-redirect-value
+ sqlbuf
+ (concat
+ "SELECT CHR(1)||"
+ (if schema
+ (format "owner||'.'||object_name AS o FROM all_objects WHERE owner = %s AND "
+ (sql-str-literal (upcase schema)))
+ "object_name AS o FROM user_objects WHERE ")
+ "temporary = 'N' AND generated = 'N' AND secondary = 'N' AND "
+ "object_type IN ("
+ (mapconcat (function sql-str-literal) sql-oracle-completion-types ",")
+ ");")
+ "^[\001]\\(.+\\)$" 1))
\f
;;;###autoload
"Create comint buffer and connect to Sybase."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
- (let ((params options))
- (if (not (string= "" sql-server))
- (setq params (append (list "-S" sql-server) params)))
- (if (not (string= "" sql-database))
- (setq params (append (list "-D" sql-database) params)))
- (if (not (string= "" sql-password))
- (setq params (append (list "-P" sql-password) params)))
- (if (not (string= "" sql-user))
- (setq params (append (list "-U" sql-user) params)))
+ (let ((params
+ (append
+ (if (not (string= "" sql-user))
+ (list "-U" sql-user))
+ (if (not (string= "" sql-password))
+ (list "-P" sql-password))
+ (if (not (string= "" sql-database))
+ (list "-D" sql-database))
+ (if (not (string= "" sql-server))
+ (list "-S" sql-server))
+ options)))
(sql-comint product params)))
\f
"Create comint buffer and connect to SQLite."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
- (let ((params))
- (if (not (string= "" sql-database))
- (setq params (append (list (expand-file-name sql-database))
- params)))
- (setq params (append options params))
+ (let ((params
+ (append options
+ (if (not (string= "" sql-database))
+ `(,(expand-file-name sql-database))))))
(sql-comint product params)))
+(defun sql-sqlite-completion-object (sqlbuf _schema)
+ (sql-redirect-value sqlbuf ".tables" "\\sw\\(?:\\sw\\|\\s_\\)*" 0))
+
\f
;;;###autoload
"Create comint buffer and connect to MySQL."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
- (let ((params))
- (if (not (string= "" sql-database))
- (setq params (append (list sql-database) params)))
- (if (not (string= "" sql-server))
- (setq params (append (list (concat "--host=" sql-server)) params)))
- (if (not (= 0 sql-port))
- (setq params (append (list (concat "--port=" (number-to-string sql-port))) params)))
- (if (not (string= "" sql-password))
- (setq params (append (list (concat "--password=" sql-password)) params)))
- (if (not (string= "" sql-user))
- (setq params (append (list (concat "--user=" sql-user)) params)))
- (setq params (append options params))
+ (let ((params
+ (append
+ options
+ (if (not (string= "" sql-user))
+ (list (concat "--user=" sql-user)))
+ (if (not (string= "" sql-password))
+ (list (concat "--password=" sql-password)))
+ (if (not (= 0 sql-port))
+ (list (concat "--port=" (number-to-string sql-port))))
+ (if (not (string= "" sql-server))
+ (list (concat "--host=" sql-server)))
+ (if (not (string= "" sql-database))
+ (list sql-database)))))
(sql-comint product params)))
\f
"Create comint buffer and connect to Solid."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
- (let ((params options))
- ;; It only makes sense if both username and password are there.
- (if (not (or (string= "" sql-user)
- (string= "" sql-password)))
- (setq params (append (list sql-user sql-password) params)))
- (if (not (string= "" sql-server))
- (setq params (append (list sql-server) params)))
+ (let ((params
+ (append
+ (if (not (string= "" sql-server))
+ (list sql-server))
+ ;; It only makes sense if both username and password are there.
+ (if (not (or (string= "" sql-user)
+ (string= "" sql-password)))
+ (list sql-user sql-password))
+ options)))
(sql-comint product params)))
\f
"Create comint buffer and connect to Microsoft SQL Server."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
- (let ((params options))
- (if (not (string= "" sql-server))
- (setq params (append (list "-S" sql-server) params)))
- (if (not (string= "" sql-database))
- (setq params (append (list "-d" sql-database) params)))
- (if (not (string= "" sql-user))
- (setq params (append (list "-U" sql-user) params)))
- (if (not (string= "" sql-password))
- (setq params (append (list "-P" sql-password) params))
- (if (string= "" sql-user)
- ;; if neither user nor password is provided, use system
- ;; credentials.
- (setq params (append (list "-E") params))
- ;; If -P is passed to ISQL as the last argument without a
- ;; password, it's considered null.
- (setq params (append params (list "-P")))))
+ (let ((params
+ (append
+ (if (not (string= "" sql-user))
+ (list "-U" sql-user))
+ (if (not (string= "" sql-database))
+ (list "-d" sql-database))
+ (if (not (string= "" sql-server))
+ (list "-S" sql-server))
+ options)))
+ (setq params
+ (if (not (string= "" sql-password))
+ `("-P" ,sql-password ,@params)
+ (if (string= "" sql-user)
+ ;; If neither user nor password is provided, use system
+ ;; credentials.
+ `("-E" ,@params)
+ ;; If -P is passed to ISQL as the last argument without a
+ ;; password, it's considered null.
+ `(,@params "-P"))))
(sql-comint product params)))
\f
(defun sql-comint-postgres (product options)
"Create comint buffer and connect to Postgres."
- ;; username and password are ignored. Mark Stosberg suggest to add
- ;; the database at the end. Jason Beegan suggest using --pset and
+ ;; username and password are ignored. Mark Stosberg suggests to add
+ ;; the database at the end. Jason Beegan suggests using --pset and
;; pager=off instead of \\o|cat. The later was the solution by
;; Gregor Zych. Jason's suggestion is the default value for
;; sql-postgres-options.
- (let ((params options))
- (if (not (string= "" sql-database))
- (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)))
+ (let ((params
+ (append
+ (if (not (= 0 sql-port))
+ (list "-p" (number-to-string sql-port)))
+ (if (not (string= "" sql-user))
+ (list "-U" sql-user))
+ (if (not (string= "" sql-server))
+ (list "-h" sql-server))
+ options
+ (if (not (string= "" sql-database))
+ (list sql-database)))))
(sql-comint product params)))
+(defun sql-postgres-completion-object (sqlbuf schema)
+ (sql-redirect sqlbuf "\\t on")
+ (let ((aligned
+ (string= "aligned"
+ (car (sql-redirect-value
+ sqlbuf "\\a"
+ "Output format is \\(.*\\)[.]$" 1)))))
+ (when aligned
+ (sql-redirect sqlbuf "\\a"))
+ (let* ((fs (or (car (sql-redirect-value
+ sqlbuf "\\f" "Field separator is \"\\(.\\)[.]$" 1))
+ "|"))
+ (re (concat "^\\([^" fs "]*\\)" fs "\\([^" fs "]*\\)"
+ fs "[^" fs "]*" fs "[^" fs "]*$"))
+ (cl (if (not schema)
+ (sql-redirect-value sqlbuf "\\d" re '(1 2))
+ (append (sql-redirect-value
+ sqlbuf (format "\\dt %s.*" schema) re '(1 2))
+ (sql-redirect-value
+ sqlbuf (format "\\dv %s.*" schema) re '(1 2))
+ (sql-redirect-value
+ sqlbuf (format "\\ds %s.*" schema) re '(1 2))))))
+
+ ;; Restore tuples and alignment to what they were.
+ (sql-redirect sqlbuf "\\t off")
+ (when (not aligned)
+ (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))))
+ cl))))
+
\f
;;;###autoload
"Create comint buffer and connect to Interbase."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
- (let ((params options))
- (if (not (string= "" sql-user))
- (setq params (append (list "-u" sql-user) params)))
- (if (not (string= "" sql-password))
- (setq params (append (list "-p" sql-password) params)))
- (if (not (string= "" sql-database))
- (setq params (cons sql-database params))) ; add to the front!
+ (let ((params
+ (append
+ (if (not (string= "" sql-database))
+ (list sql-database)) ; Add to the front!
+ (if (not (string= "" sql-password))
+ (list "-p" sql-password))
+ (if (not (string= "" sql-user))
+ (list "-u" sql-user))
+ options)))
(sql-comint product params)))
\f
"Create comint buffer and connect to DB2."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
- (sql-comint product options)
-)
+ (sql-comint product options))
;;;###autoload
(defun sql-linter (&optional buffer)
"Create comint buffer and connect to Linter."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
- (let ((params options)
- (login nil)
- (old-mbx (getenv "LINTER_MBX")))
- (if (not (string= "" sql-user))
- (setq login (concat sql-user "/" sql-password)))
- (setq params (append (list "-u" login) params))
- (if (not (string= "" sql-server))
- (setq params (append (list "-n" sql-server) params)))
- (if (string= "" sql-database)
- (setenv "LINTER_MBX" nil)
- (setenv "LINTER_MBX" sql-database))
- (sql-comint product params)
- (setenv "LINTER_MBX" old-mbx)))
+ (let* ((login
+ (if (not (string= "" sql-user))
+ (concat sql-user "/" sql-password)))
+ (params
+ (append
+ (if (not (string= "" sql-server))
+ (list "-n" sql-server))
+ (list "-u" login)
+ options)))
+ (cl-letf (((getenv "LINTER_MBX")
+ (unless (string= "" sql-database) sql-database)))
+ (sql-comint product params))))
\f
(provide 'sql)
;;; sql.el ends here
+
+; LocalWords: sql SQL SQLite sqlite Sybase Informix MySQL
+; LocalWords: Postgres SQLServer SQLi
HCoop / bpt / emacs.git / blobdiff