;;; sql.el --- specialized comint.el for SQL interpreters
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Michael Mauger <mmaug@yahoo.com>
-;; Version: 2.3
+;; Version: 3.0
;; Keywords: comm languages processes
-;; URL: http://savannah.gnu.org/cgi-bin/viewcvs/emacs/emacs/lisp/progmodes/sql.el
-;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SqlMode
+;; URL: http://savannah.gnu.org/projects/emacs/
;; 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.
;; identifier characters.
;; (sql-set-product-feature 'xyz
-;; :syntax-alist ((?# . "w")))
+;; :syntax-alist ((?# . "_")))
;; 4) Define the interactive command interpreter for the database
;; product.
;; (defcustom my-sql-xyz-login-params '(user password server database)
;; "Login parameters to needed to connect to XyzDB."
-;; :type '(repeat (choice
-;; (const user)
-;; (const password)
-;; (const server)
-;; (const database)
-;; (const port)))
+;; :type 'sql-login-params
;; :group 'SQL)
;;
;; (sql-set-product-feature 'xyz
;; (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 ()
+;; (defun my-sql-xyz (&optional buffer)
;; "Run ixyz by XyzDB as an inferior process."
-;; (interactive)
-;; (sql-product-interactive 'xyz))
+;; (interactive "P")
+;; (sql-product-interactive 'xyz buffer))
;;; To Do:
(eval-when-compile
(require 'regexp-opt))
(require 'custom)
+(require 'thingatpt)
(eval-when-compile ;; needed in Emacs 19, 20
(setq max-specpdl-size (max max-specpdl-size 2000)))
+(defun sql-signum (n)
+ "Return 1, 0, or -1 to identify the sign of N."
+ (cond
+ ((not (numberp n)) nil)
+ ((< n 0) -1)
+ ((> n 0) 1)
+ (t 0)))
+
(defvar font-lock-keyword-face)
(defvar font-lock-set-defaults)
(defvar font-lock-string-face)
:group 'SQL
:safe 'stringp)
-(defcustom sql-port nil
- "Default server or host."
+(defcustom sql-port 0
+ "Default port."
:version "24.1"
:type 'number
:group 'SQL
:safe 'numberp)
+;; Login parameter type
+
+(define-widget 'sql-login-params 'lazy
+ "Widget definition of the login parameters list"
+ ;; FIXME: does not implement :default property for the user,
+ ;; database and server options. Anybody have some guidance on how to
+ ;; do this.
+ :tag "Login Parameters"
+ :type '(repeat (choice
+ (const user)
+ (const password)
+ (choice :tag "server"
+ (const server)
+ (list :tag "file"
+ (const :format "" server)
+ (const :format "" :file)
+ regexp)
+ (list :tag "completion"
+ (const :format "" server)
+ (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))))
+
;; SQL Product support
(defvar sql-interactive-product nil
(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-db2
:prompt-regexp "^db2 => "
:prompt-length 7
+ :prompt-cont-regexp "^db2 (cont\.) => "
:input-filter sql-escape-newlines-filter)
(informix
:sqli-login sql-ingres-login-params
:sqli-comint-func sql-comint-ingres
:prompt-regexp "^\* "
- :prompt-length 2)
+ :prompt-length 2
+ :prompt-cont-regexp "^\* ")
(interbase
:name "Interbase"
:sqli-comint-func sql-comint-ms
:prompt-regexp "^[0-9]*>"
:prompt-length 5
- :syntax-alist ((?@ . "w"))
+ :syntax-alist ((?@ . "_"))
:terminator ("^go" . "go"))
(mysql
:sqli-options sql-mysql-options
:sqli-login sql-mysql-login-params
:sqli-comint-func sql-comint-mysql
+ :list-all "SHOW TABLES;"
+ :list-table "DESCRIBE %s;"
: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
- :syntax-alist ((?$ . "w") (?# . "w"))
- :terminator ("\\(^/\\|;\\)" . "/")
+ :prompt-cont-regexp "^\\s-*[[:digit:]]+ "
+ :statement sql-oracle-statement-starters
+ :syntax-alist ((?$ . "_") (?# . "_"))
+ :terminator ("\\(^/\\|;\\)$" . "/")
:input-filter sql-placeholders-filter)
(postgres
:sqli-options sql-postgres-options
:sqli-login sql-postgres-login-params
:sqli-comint-func sql-comint-postgres
- :prompt-regexp "^.*[#>] *"
+ :list-all ("\\d+" . "\\dS+")
+ :list-table ("\\d+ %s" . "\\dS+ %s")
+ :completion-object sql-postgres-completion-object
+ :prompt-regexp "^\\w*=[#>] "
:prompt-length 5
+ :prompt-cont-regexp "^\\w*[-(][#>] "
:input-filter sql-remove-tabs-filter
- :terminator ("\\(^[\\]g\\|;\\)" . ";"))
+ :terminator ("\\(^\\s-*\\\\g$\\|;\\)" . "\\g"))
(solid
:name "Solid"
:sqli-options sql-sqlite-options
:sqli-login sql-sqlite-login-params
: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-length 8
+ :prompt-cont-regexp "^ \.\.\.> "
+ :terminator ";")
(sybase
:name "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.
+ If it's a cons cell, then the car
+ produces the standard list of objects and
+ the cdr produces an enhanced list of
+ objects. What \"enhanced\" means is
+ dependent on the SQL product and may not
+ exist. In general though, the
+ \"enhanced\" list should include visible
+ objects from other schemas.
+
+ :list-table Command string or function which produces
+ a detailed listing of a specific database
+ table. If its a cons cell, then the car
+ 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
:prompt-length length of the prompt on the line.
+ :prompt-cont-regexp regular expression string that matches
+ the continuation prompt issued by the
+ product interpreter.
+
:input-filter function which can filter strings sent to
the command interpreter. It is also used
by the `sql-send-string',
and `sql-send-buffer' functions. The
function is passed the string sent to the
command interpreter and must return the
- filtered string.
+ 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',
settings.")
(defvar sql-indirect-features
- '(:font-lock :sqli-program :sqli-options :sqli-login))
+ '(:font-lock :sqli-program :sqli-options :sqli-login :statement))
-;;;###autoload
(defcustom sql-connection-alist nil
"An alist of connection parameters for interacting with a SQL
product.
:version "24.1"
:group 'SQL)
-;;;###autoload
(defcustom sql-product 'ansi
"Select the SQL database product used so that buffers can be
highlighted properly when you open them."
sql-product-alist))
:group 'SQL
:safe 'symbolp)
+(defvaralias 'sql-dialect 'sql-product)
;; misc customization of sql.el behaviour
: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.
: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.")
+
;; Customization for Oracle
(defcustom sql-oracle-program "sqlplus"
(defcustom sql-oracle-login-params '(user password database)
"List of login parameters needed to connect to Oracle."
- :type '(repeat (choice
- (const user)
- (const password)
- (const server)
- (const database)
- (const port)))
+ :type 'sql-login-params
:version "24.1"
:group 'SQL)
+(defcustom sql-oracle-statement-starters (regexp-opt '("declare" "begin" "with"))
+ "Additional statement starting keywords in Oracle.")
+
(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 SCAN OFF"
+ SET DEFINE OFF
+
+In older versions of SQL*Plus, this was the SET SCAN OFF command."
:type 'boolean
:group 'SQL)
;; Customization for SQLite
-(defcustom sql-sqlite-program "sqlite"
+(defcustom sql-sqlite-program (or (executable-find "sqlite3")
+ (executable-find "sqlite")
+ "sqlite")
"Command to start SQLite.
Starts `sql-interactive-mode' after doing some setup."
:version "20.8"
:group 'SQL)
-(defcustom sql-sqlite-login-params '(database)
+(defcustom sql-sqlite-login-params '((database :file ".*\\.\\(db\\|sqlite[23]?\\)"))
"List of login parameters needed to connect to SQLite."
- :type '(repeat (choice
- (const user)
- (const password)
- (const server)
- (const database)
- (const port)))
+ :type 'sql-login-params
: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."
- :type '(repeat (choice
- (const user)
- (const password)
- (const server)
- (const database)
- (const port)))
+ "List of login parameters needed to connect to MySQL."
+ :type 'sql-login-params
:version "24.1"
:group 'SQL)
(defcustom sql-solid-login-params '(user password server)
"List of login parameters needed to connect to Solid."
- :type '(repeat (choice
- (const user)
- (const password)
- (const server)
- (const database)
- (const port)))
+ :type 'sql-login-params
:version "24.1"
:group 'SQL)
(defcustom sql-sybase-login-params '(server user password database)
"List of login parameters needed to connect to Sybase."
- :type '(repeat (choice
- (const user)
- (const password)
- (const server)
- (const database)
- (const port)))
+ :type 'sql-login-params
:version "24.1"
:group 'SQL)
(defcustom sql-informix-login-params '(database)
"List of login parameters needed to connect to Informix."
- :type '(repeat (choice
- (const user)
- (const password)
- (const server)
- (const database)
- (const port)))
+ :type 'sql-login-params
:version "24.1"
:group 'SQL)
(defcustom sql-ingres-login-params '(database)
"List of login parameters needed to connect to Ingres."
- :type '(repeat (choice
- (const user)
- (const password)
- (const server)
- (const database)
- (const port)))
+ :type 'sql-login-params
:version "24.1"
:group 'SQL)
(defcustom sql-ms-login-params '(user password server database)
"List of login parameters needed to connect to Microsoft."
- :type '(repeat (choice
- (const user)
- (const password)
- (const server)
- (const database)
- (const port)))
+ :type 'sql-login-params
:version "24.1"
:group 'SQL)
:version "20.8"
:group 'SQL)
-(defcustom sql-postgres-login-params '(user database server)
+(defcustom sql-postgres-login-params `((user :default ,(user-login-name))
+ (database :default ,(user-login-name))
+ server)
"List of login parameters needed to connect to Postgres."
- :type '(repeat (choice
- (const user)
- (const password)
- (const server)
- (const database)
- (const port)))
+ :type 'sql-login-params
:version "24.1"
:group 'SQL)
(defcustom sql-interbase-login-params '(user password database)
"List of login parameters needed to connect to Interbase."
- :type '(repeat (choice
- (const user)
- (const password)
- (const server)
- (const database)
- (const port)))
+ :type 'sql-login-params
:version "24.1"
:group 'SQL)
(defcustom sql-db2-login-params nil
"List of login parameters needed to connect to DB2."
- :type '(repeat (choice
- (const user)
- (const password)
- (const server)
- (const database)
- (const port)))
+ :type 'sql-login-params
:version "24.1"
:group 'SQL)
(defcustom sql-linter-login-params '(user password database server)
"Login parameters to needed to connect to Linter."
- :type '(repeat (choice
- (const user)
- (const password)
- (const server)
- (const database)
- (const port)))
+ :type 'sql-login-params
:version "24.1"
:group 'SQL)
(defvar sql-server-history nil
"History of servers used.")
-(defvar sql-port-history nil
- "History of ports used.")
-
;; Passwords are not kept in a history.
+(defvar sql-product-history nil
+ "History of products used.")
+
+(defvar sql-connection-history nil
+ "History of connections used.")
+
(defvar sql-buffer nil
"Current SQLi buffer.
You can change `sql-prompt-length' on `sql-interactive-mode-hook'.")
+(defvar sql-prompt-cont-regexp nil
+ "Prompt pattern of statement continuation prompts.")
+
(defvar sql-alternate-buffer-name nil
"Buffer-local string used to possibly rename the SQLi buffer.
Used by `sql-rename-buffer'.")
+(defun sql-buffer-live-p (buffer &optional product connection)
+ "Returns 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 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))
+ (or (not connection)
+ (eq connection sql-connection)))))))
+
;; Keymap for sql-interactive-mode.
(defvar sql-interactive-mode-map
(define-key map (kbd "O") 'sql-magic-go)
(define-key map (kbd "o") 'sql-magic-go)
(define-key map (kbd ";") 'sql-magic-semicolon)
+ (define-key map (kbd "C-c C-l a") 'sql-list-all)
+ (define-key map (kbd "C-c C-l t") 'sql-list-table)
map)
"Mode map used for `sql-interactive-mode'.
Based on `comint-mode-map'.")
(define-key map (kbd "C-c C-s") 'sql-send-string)
(define-key map (kbd "C-c C-b") 'sql-send-buffer)
(define-key map (kbd "C-c C-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'.")
sql-mode-menu sql-mode-map
"Menu for `sql-mode'."
`("SQL"
- ["Send Paragraph" sql-send-paragraph (and (buffer-live-p sql-buffer)
- (get-buffer-process sql-buffer))]
+ ["Send Paragraph" sql-send-paragraph (sql-buffer-live-p sql-buffer)]
["Send Region" sql-send-region (and mark-active
- (buffer-live-p sql-buffer)
- (get-buffer-process sql-buffer))]
- ["Send Buffer" sql-send-buffer (and (buffer-live-p sql-buffer)
- (get-buffer-process sql-buffer))]
- ["Send String" sql-send-string (and (buffer-live-p sql-buffer)
- (get-buffer-process sql-buffer))]
+ (sql-buffer-live-p sql-buffer))]
+ ["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 (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)
"Menu for `sql-interactive-mode'."
'("SQL"
["Rename Buffer" sql-rename-buffer t]
- ["Save Connection" sql-save-connection (not sql-connection)]))
+ ["Save Connection" sql-save-connection (not sql-connection)]
+ "--"
+ ["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
;; ~/.emacs file. Abbrevs have to be enabled in your ~/.emacs, too.
(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)))))
+ (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")
(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'.")
;; 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.
+ (interactive)
+ (if (or (and (not (derived-mode-p 'sql-mode))
+ (not (derived-mode-p 'sql-interactive-mode)))
+ (not sql-buffer)
+ (not (eq sql-product 'oracle)))
+ (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
- "^\\(?:\\(?:" (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)
- '("^[ \t]*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"
+"corr_k" "corr_s" "cos" "cosh" "count" "covar_pop" "covar_samp"
+"cube_table" "cume_dist" "currrent_date" "currrent_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"
"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"
+)
+
+ ;; 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.
(defvar sql-mode-postgres-font-lock-keywords
(eval-when-compile
(list
- ;; Postgres Functions
+ ;; Postgres psql commands
+ '("^\\s-*\\\\.*$" . font-lock-doc-face)
+
+ ;; Postgres unreserved words but may have meaning
+ (sql-font-lock-keywords-builder 'font-lock-builtin-face nil "a"
+"abs" "absent" "according" "ada" "alias" "allocate" "are" "array_agg"
+"asensitive" "atomic" "attribute" "attributes" "avg" "base64"
+"bernoulli" "bit_length" "bitvar" "blob" "blocked" "bom" "breadth" "c"
+"call" "cardinality" "catalog_name" "ceil" "ceiling" "char_length"
+"character_length" "character_set_catalog" "character_set_name"
+"character_set_schema" "characters" "checked" "class_origin" "clob"
+"cobol" "collation" "collation_catalog" "collation_name"
+"collation_schema" "collect" "column_name" "columns"
+"command_function" "command_function_code" "completion" "condition"
+"condition_number" "connect" "connection_name" "constraint_catalog"
+"constraint_name" "constraint_schema" "constructor" "contains"
+"control" "convert" "corr" "corresponding" "count" "covar_pop"
+"covar_samp" "cube" "cume_dist" "current_default_transform_group"
+"current_path" "current_transform_group_for_type" "cursor_name"
+"datalink" "datetime_interval_code" "datetime_interval_precision" "db"
+"defined" "degree" "dense_rank" "depth" "deref" "derived" "describe"
+"descriptor" "destroy" "destructor" "deterministic" "diagnostics"
+"disconnect" "dispatch" "dlnewcopy" "dlpreviouscopy" "dlurlcomplete"
+"dlurlcompleteonly" "dlurlcompletewrite" "dlurlpath" "dlurlpathonly"
+"dlurlpathwrite" "dlurlscheme" "dlurlserver" "dlvalue" "dynamic"
+"dynamic_function" "dynamic_function_code" "element" "empty"
+"end-exec" "equals" "every" "exception" "exec" "existing" "exp" "file"
+"filter" "final" "first_value" "flag" "floor" "fortran" "found" "free"
+"fs" "fusion" "g" "general" "generated" "get" "go" "goto" "grouping"
+"hex" "hierarchy" "host" "id" "ignore" "implementation" "import"
+"indent" "indicator" "infix" "initialize" "instance" "instantiable"
+"integrity" "intersection" "iterate" "k" "key_member" "key_type" "lag"
+"last_value" "lateral" "lead" "length" "less" "library" "like_regex"
+"link" "ln" "locator" "lower" "m" "map" "matched" "max"
+"max_cardinality" "member" "merge" "message_length"
+"message_octet_length" "message_text" "method" "min" "mod" "modifies"
+"modify" "module" "more" "multiset" "mumps" "namespace" "nclob"
+"nesting" "new" "nfc" "nfd" "nfkc" "nfkd" "nil" "normalize"
+"normalized" "nth_value" "ntile" "nullable" "number"
+"occurrences_regex" "octet_length" "octets" "old" "open" "operation"
+"ordering" "ordinality" "others" "output" "overriding" "p" "pad"
+"parameter" "parameter_mode" "parameter_name"
+"parameter_ordinal_position" "parameter_specific_catalog"
+"parameter_specific_name" "parameter_specific_schema" "parameters"
+"pascal" "passing" "passthrough" "percent_rank" "percentile_cont"
+"percentile_disc" "permission" "pli" "position_regex" "postfix"
+"power" "prefix" "preorder" "public" "rank" "reads" "recovery" "ref"
+"referencing" "regr_avgx" "regr_avgy" "regr_count" "regr_intercept"
+"regr_r2" "regr_slope" "regr_sxx" "regr_sxy" "regr_syy" "requiring"
+"respect" "restore" "result" "return" "returned_cardinality"
+"returned_length" "returned_octet_length" "returned_sqlstate" "rollup"
+"routine" "routine_catalog" "routine_name" "routine_schema"
+"row_count" "row_number" "scale" "schema_name" "scope" "scope_catalog"
+"scope_name" "scope_schema" "section" "selective" "self" "sensitive"
+"server_name" "sets" "size" "source" "space" "specific"
+"specific_name" "specifictype" "sql" "sqlcode" "sqlerror"
+"sqlexception" "sqlstate" "sqlwarning" "sqrt" "state" "static"
+"stddev_pop" "stddev_samp" "structure" "style" "subclass_origin"
+"sublist" "submultiset" "substring_regex" "sum" "system_user" "t"
+"table_name" "tablesample" "terminate" "than" "ties" "timezone_hour"
+"timezone_minute" "token" "top_level_count" "transaction_active"
+"transactions_committed" "transactions_rolled_back" "transform"
+"transforms" "translate" "translate_regex" "translation"
+"trigger_catalog" "trigger_name" "trigger_schema" "trim_array"
+"uescape" "under" "unlink" "unnamed" "unnest" "untyped" "upper" "uri"
+"usage" "user_defined_type_catalog" "user_defined_type_code"
+"user_defined_type_name" "user_defined_type_schema" "var_pop"
+"var_samp" "varbinary" "variable" "whenever" "width_bucket" "within"
+"xmlagg" "xmlbinary" "xmlcast" "xmlcomment" "xmldeclaration"
+"xmldocument" "xmlexists" "xmliterate" "xmlnamespaces" "xmlquery"
+"xmlschema" "xmltable" "xmltext" "xmlvalidate"
+)
+
+ ;; Postgres non-reserved words
(sql-font-lock-keywords-builder 'font-lock-builtin-face nil
-"abbrev" "abs" "acos" "age" "area" "ascii" "asin" "atab2" "atan"
-"atan2" "avg" "bit_length" "both" "broadcast" "btrim" "cbrt" "ceil"
-"center" "char_length" "chr" "coalesce" "col_description" "convert"
-"cos" "cot" "count" "current_database" "current_date" "current_schema"
-"current_schemas" "current_setting" "current_time" "current_timestamp"
-"current_user" "currval" "date_part" "date_trunc" "decode" "degrees"
-"diameter" "encode" "exp" "extract" "floor" "get_bit" "get_byte"
-"has_database_privilege" "has_function_privilege"
-"has_language_privilege" "has_schema_privilege" "has_table_privilege"
-"height" "host" "initcap" "isclosed" "isfinite" "isopen" "leading"
-"length" "ln" "localtime" "localtimestamp" "log" "lower" "lpad"
-"ltrim" "masklen" "max" "min" "mod" "netmask" "network" "nextval"
-"now" "npoints" "nullif" "obj_description" "octet_length" "overlay"
-"pclose" "pg_client_encoding" "pg_function_is_visible"
-"pg_get_constraintdef" "pg_get_indexdef" "pg_get_ruledef"
-"pg_get_userbyid" "pg_get_viewdef" "pg_opclass_is_visible"
-"pg_operator_is_visible" "pg_table_is_visible" "pg_type_is_visible"
-"pi" "popen" "position" "pow" "quote_ident" "quote_literal" "radians"
-"radius" "random" "repeat" "replace" "round" "rpad" "rtrim"
-"session_user" "set_bit" "set_byte" "set_config" "set_masklen"
-"setval" "sign" "sin" "split_part" "sqrt" "stddev" "strpos" "substr"
-"substring" "sum" "tan" "timeofday" "to_ascii" "to_char" "to_date"
-"to_hex" "to_number" "to_timestamp" "trailing" "translate" "trim"
-"trunc" "upper" "variance" "version" "width"
+"abort" "absolute" "access" "action" "add" "admin" "after" "aggregate"
+"also" "alter" "always" "assertion" "assignment" "at" "backward"
+"before" "begin" "between" "by" "cache" "called" "cascade" "cascaded"
+"catalog" "chain" "characteristics" "checkpoint" "class" "close"
+"cluster" "coalesce" "comment" "comments" "commit" "committed"
+"configuration" "connection" "constraints" "content" "continue"
+"conversion" "copy" "cost" "createdb" "createrole" "createuser" "csv"
+"current" "cursor" "cycle" "data" "database" "day" "deallocate" "dec"
+"declare" "defaults" "deferred" "definer" "delete" "delimiter"
+"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"
+"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"
+"location" "lock" "login" "mapping" "match" "maxvalue" "minute"
+"minvalue" "mode" "month" "move" "name" "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"
+"privileges" "procedural" "procedure" "quote" "range" "read"
+"reassign" "recheck" "recursive" "reindex" "relative" "release"
+"rename" "repeatable" "replace" "replica" "reset" "restart" "restrict"
+"returns" "revoke" "role" "rollback" "row" "rows" "rule" "savepoint"
+"schema" "scroll" "search" "second" "security" "sequence" "sequences"
+"serializable" "server" "session" "set" "setof" "share" "show"
+"simple" "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"
)
+
;; Postgres Reserved
(sql-font-lock-keywords-builder 'font-lock-keyword-face nil
-"abort" "access" "add" "after" "aggregate" "alignment" "all" "alter"
-"analyze" "and" "any" "as" "asc" "assignment" "authorization"
-"backward" "basetype" "before" "begin" "between" "binary" "by" "cache"
-"called" "cascade" "case" "cast" "characteristics" "check"
-"checkpoint" "class" "close" "cluster" "column" "comment" "commit"
-"committed" "commutator" "constraint" "constraints" "conversion"
-"copy" "create" "createdb" "createuser" "cursor" "cycle" "database"
-"deallocate" "declare" "default" "deferrable" "deferred" "definer"
-"delete" "delimiter" "desc" "distinct" "do" "domain" "drop" "each"
-"element" "else" "encoding" "encrypted" "end" "escape" "except"
-"exclusive" "execute" "exists" "explain" "extended" "external" "false"
-"fetch" "finalfunc" "for" "force" "foreign" "forward" "freeze" "from"
-"full" "function" "grant" "group" "gtcmp" "handler" "hashes" "having"
-"immediate" "immutable" "implicit" "in" "increment" "index" "inherits"
-"initcond" "initially" "input" "insensitive" "insert" "instead"
-"internallength" "intersect" "into" "invoker" "is" "isnull"
-"isolation" "join" "key" "language" "leftarg" "level" "like" "limit"
-"listen" "load" "local" "location" "lock" "ltcmp" "main" "match"
-"maxvalue" "merges" "minvalue" "mode" "move" "natural" "negator"
-"next" "nocreatedb" "nocreateuser" "none" "not" "nothing" "notify"
-"notnull" "null" "of" "offset" "oids" "on" "only" "operator" "or"
-"order" "output" "owner" "partial" "passedbyvalue" "password" "plain"
-"prepare" "primary" "prior" "privileges" "procedural" "procedure"
-"public" "read" "recheck" "references" "reindex" "relative" "rename"
-"reset" "restrict" "returns" "revoke" "rightarg" "rollback" "row"
-"rule" "schema" "scroll" "security" "select" "sequence" "serializable"
-"session" "set" "sfunc" "share" "show" "similar" "some" "sort1"
-"sort2" "stable" "start" "statement" "statistics" "storage" "strict"
-"stype" "sysid" "table" "temp" "template" "temporary" "then" "to"
-"transaction" "trigger" "true" "truncate" "trusted" "type"
-"unencrypted" "union" "unique" "unknown" "unlisten" "until" "update"
-"usage" "user" "using" "vacuum" "valid" "validator" "values"
-"variable" "verbose" "view" "volatile" "when" "where" "with" "without"
-"work"
+"all" "analyse" "analyze" "and" "any" "array" "asc" "as" "asymmetric"
+"authorization" "binary" "both" "case" "cast" "check" "collate"
+"column" "concurrently" "constraint" "create" "cross"
+"current_catalog" "current_date" "current_role" "current_schema"
+"current_time" "current_timestamp" "current_user" "default"
+"deferrable" "desc" "distinct" "do" "else" "end" "except" "false"
+"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"
+"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 Data Types
(sql-font-lock-keywords-builder 'font-lock-type-face nil
-"anyarray" "bigint" "bigserial" "bit" "boolean" "box" "bytea" "char"
-"character" "cidr" "circle" "cstring" "date" "decimal" "double"
-"float4" "float8" "inet" "int2" "int4" "int8" "integer" "internal"
-"interval" "language_handler" "line" "lseg" "macaddr" "money"
-"numeric" "oid" "opaque" "path" "point" "polygon" "precision" "real"
-"record" "regclass" "regoper" "regoperator" "regproc" "regprocedure"
-"regtype" "serial" "serial4" "serial8" "smallint" "text" "time"
-"timestamp" "varchar" "varying" "void" "zone"
+"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"
+"time" "timestamp" "timestamptz" "timetz" "tsquery" "tsvector"
+"txid_snapshot" "uuid" "varbit" "varchar" "varying" "without"
+"xml" "zone"
)))
"Postgres SQL keywords used by font-lock.
function `regexp-opt'. Therefore, take a look at the source before
you define your own `sql-mode-mysql-font-lock-keywords'.")
-(defvar sql-mode-sqlite-font-lock-keywords nil
+(defvar sql-mode-sqlite-font-lock-keywords
+ (eval-when-compile
+ (list
+ ;; SQLite commands
+ '("^[.].*$" . font-lock-doc-face)
+
+ ;; SQLite Keyword
+ (sql-font-lock-keywords-builder 'font-lock-keyword-face nil
+"abort" "action" "add" "after" "all" "alter" "analyze" "and" "as"
+"asc" "attach" "autoincrement" "before" "begin" "between" "by"
+"cascade" "case" "cast" "check" "collate" "column" "commit" "conflict"
+"constraint" "create" "cross" "database" "default" "deferrable"
+"deferred" "delete" "desc" "detach" "distinct" "drop" "each" "else"
+"end" "escape" "except" "exclusive" "exists" "explain" "fail" "for"
+"foreign" "from" "full" "glob" "group" "having" "if" "ignore"
+"immediate" "in" "index" "indexed" "initially" "inner" "insert"
+"instead" "intersect" "into" "is" "isnull" "join" "key" "left" "like"
+"limit" "match" "natural" "no" "not" "notnull" "null" "of" "offset"
+"on" "or" "order" "outer" "plan" "pragma" "primary" "query" "raise"
+"references" "regexp" "reindex" "release" "rename" "replace"
+"restrict" "right" "rollback" "row" "savepoint" "select" "set" "table"
+"temp" "temporary" "then" "to" "transaction" "trigger" "union"
+"unique" "update" "using" "vacuum" "values" "view" "virtual" "when"
+"where"
+)
+ ;; SQLite Data types
+ (sql-font-lock-keywords-builder 'font-lock-type-face nil
+"int" "integer" "tinyint" "smallint" "mediumint" "bigint" "unsigned"
+"big" "int2" "int8" "character" "varchar" "varying" "nchar" "native"
+"nvarchar" "text" "clob" "blob" "real" "double" "precision" "float"
+"numeric" "number" "decimal" "boolean" "date" "datetime"
+)
+ ;; SQLite Functions
+ (sql-font-lock-keywords-builder 'font-lock-builtin-face nil
+;; Core functions
+"abs" "changes" "coalesce" "glob" "ifnull" "hex" "last_insert_rowid"
+"length" "like" "load_extension" "lower" "ltrim" "max" "min" "nullif"
+"quote" "random" "randomblob" "replace" "round" "rtrim" "soundex"
+"sqlite_compileoption_get" "sqlite_compileoption_used"
+"sqlite_source_id" "sqlite_version" "substr" "total_changes" "trim"
+"typeof" "upper" "zeroblob"
+;; Date/time functions
+"time" "julianday" "strftime"
+"current_date" "current_time" "current_timestamp"
+;; Aggregate functions
+"avg" "count" "group_concat" "max" "min" "sum" "total"
+)))
+
"SQLite SQL keywords used by font-lock.
This variable is used by `sql-mode' and `sql-interactive-mode'. The
;;; SQL Product support functions
+(defun sql-read-product (prompt &optional initial)
+ "Read a valid SQL product."
+ (let ((init (or (and initial (symbol-name initial)) "ansi")))
+ (intern (completing-read
+ prompt
+ (mapcar (lambda (info) (symbol-name (car info)))
+ sql-product-alist)
+ nil 'require-match
+ init 'sql-product-history init))))
+
(defun sql-add-product (product display &rest plist)
"Add support for a database product in `sql-mode'.
(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.
- (setq sql-mode-font-lock-keywords
- (append
- (unless (eq sql-product 'ansi)
- (sql-get-product-feature sql-product :font-lock))
- ;; Always highlight ANSI keywords
- (sql-get-product-feature 'ansi :font-lock)
- ;; Fontify object names in CREATE, DROP and ALTER DDL
- ;; statements
- (list sql-mode-font-lock-object-name)))
+ (set (make-local-variable 'sql-mode-font-lock-keywords)
+ (append
+ (unless (eq sql-product 'ansi)
+ (sql-get-product-feature sql-product :font-lock))
+ ;; Always highlight ANSI keywords
+ (sql-get-product-feature 'ansi :font-lock)
+ ;; Fontify object names in CREATE, DROP and ALTER DDL
+ ;; statements
+ (list sql-mode-font-lock-object-name)))
;; Setup font-lock. Force re-parsing of `font-lock-defaults'.
(kill-local-variable 'font-lock-set-defaults)
- (setq font-lock-defaults (list 'sql-mode-font-lock-keywords
- keywords-only t syntax-alist))
+ (set (make-local-variable 'font-lock-defaults)
+ (list 'sql-mode-font-lock-keywords
+ keywords-only t syntax-alist))
;; Force font lock to reinitialize if it is already on
;; Otherwise, we can wait until it can be started.
(append old-val keywords)
(append keywords old-val))))))
+(defun sql-for-each-login (login-params body)
+ "Iterates through login parameters and returns 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)))
+ 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)
(defun sql-set-product (product)
"Set `sql-product' to PRODUCT and enable appropriate highlighting."
(interactive
- (list (completing-read "SQL product: "
- (mapcar (lambda (info) (symbol-name (car info)))
- sql-product-alist)
- nil 'require-match
- (or (and sql-product (symbol-name sql-product)) "ansi"))))
+ (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)
;; 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
+;;; 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)
+ "Moves the cursor 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 (sql-signum arg))))))
+
+(defun sql-end-of-statement (arg)
+ "Moves the cursor 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 (= (sql-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 (sql-signum arg))))))
+ (goto-char (if (match-data)
+ (match-end 0)
+ here))))
;;; Small functions
(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)
"Read a password using PROMPT. Optional DEFAULT is password to start with."
(read-passwd prompt nil default))
+(defun sql-get-login-ext (prompt last-value history-var plist)
+ "Prompt user with extended login parameters.
+
+If PLIST is nil, then the user is simply prompted for a string
+value.
+
+The property `:default' specifies the default value. If the
+`:number' property is non-nil then ask for a number.
+
+The `:file' property prompts for a file name that must match the
+regexp pattern specified in its 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))))))
+
(defun sql-get-login (&rest what)
"Get username, password and database from the user.
`database'. The members of WHAT are processed in the order in
which they are provided.
+Each token may also be a list with the token in the car and a
+plist of options as the cdr. The following properties are
+supported:
+
+ :file <filename-regexp>
+ :completion <list-of-strings-or-function>
+ :default <default-value>
+ :number t
+
In order to ask the user for username, password and database, call the
function like this: (sql-get-login 'user 'password 'database)."
(interactive)
- (while what
- (cond
- ((eq (car what) 'user) ; user
- (setq sql-user
- (read-from-minibuffer "User: " sql-user nil nil
- 'sql-user-history)))
- ((eq (car what) 'password) ; password
- (setq sql-password
- (sql-read-passwd "Password: " sql-password)))
-
- ((eq (car what) 'server) ; server
- (setq sql-server
- (read-from-minibuffer "Server: " sql-server nil nil
- 'sql-server-history)))
- ((eq (car what) 'port) ; port
- (setq sql-port
- (read-from-minibuffer "Port: " sql-port nil nil
- 'sql-port-history)))
- ((eq (car what) 'database) ; database
- (setq sql-database
- (read-from-minibuffer "Database: " sql-database nil nil
- 'sql-database-history))))
-
- (setq what (cdr what))))
-
-(defun sql-find-sqli-buffer ()
- "Returns the current default SQLi buffer or nil.
-In order to qualify, the SQLi buffer must be alive,
-be in `sql-interactive-mode' and have a process."
- (let ((default-buffer (default-value 'sql-buffer)))
- (if (and (buffer-live-p default-buffer)
- (get-buffer-process default-buffer))
- default-buffer
- (save-current-buffer
- (let ((buflist (buffer-list))
- (found))
- (while (not (or (null buflist)
- found))
- (let ((candidate (car buflist)))
- (set-buffer candidate)
- (if (and (derived-mode-p 'sql-interactive-mode)
- (get-buffer-process candidate))
- (setq found candidate))
- (setq buflist (cdr buflist))))
- found)))))
+ (mapcar
+ (lambda (w)
+ (let ((token (or (and (consp w) (car w)) w))
+ (plist (or (and (consp w) (cdr w)) nil)))
+
+ (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 connection)
+ "Returns the name of the current default SQLi buffer or nil.
+In order to qualify, the SQLi buffer must be alive, be in
+`sql-interactive-mode' and have a process."
+ (let ((buf sql-buffer)
+ (prod (or product sql-product)))
+ (or
+ ;; Current sql-buffer, if there is one.
+ (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 connection)
+ buf)
+ ;; Look thru each buffer
+ (car (apply 'append
+ (mapcar (lambda (b)
+ (and (sql-buffer-live-p b prod connection)
+ (list (buffer-name b))))
+ (buffer-list)))))))
(defun sql-set-sqli-buffer-generally ()
"Set SQLi buffer for all SQL buffers that have none.
(interactive)
(save-excursion
(let ((buflist (buffer-list))
- (default-sqli-buffer (sql-find-sqli-buffer)))
- (setq-default sql-buffer default-sqli-buffer)
+ (default-buffer (sql-find-sqli-buffer)))
+ (setq-default sql-buffer default-buffer)
(while (not (null buflist))
(let ((candidate (car buflist)))
(set-buffer candidate)
(if (and (derived-mode-p 'sql-mode)
- (not (buffer-live-p sql-buffer)))
+ (not (sql-buffer-live-p sql-buffer)))
(progn
- (setq sql-buffer default-sqli-buffer)
- (run-hooks 'sql-set-sqli-hook))))
+ (setq sql-buffer default-buffer)
+ (when default-buffer
+ (run-hooks 'sql-set-sqli-hook)))))
(setq buflist (cdr buflist))))))
(defun sql-set-sqli-buffer ()
(interactive)
(let ((default-buffer (sql-find-sqli-buffer)))
(if (null default-buffer)
- (error "There is no suitable SQLi buffer"))
- (let ((new-buffer
- (get-buffer
- (read-buffer "New SQLi buffer: " default-buffer t))))
- (if (null (get-buffer-process new-buffer))
- (error "Buffer %s has no process" (buffer-name new-buffer)))
- (if (null (with-current-buffer new-buffer
- (equal major-mode 'sql-interactive-mode)))
- (error "Buffer %s is no SQLi buffer" (buffer-name new-buffer)))
- (if new-buffer
- (progn
- (setq sql-buffer new-buffer)
- (run-hooks 'sql-set-sqli-hook))))))
+ (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)
+ (when new-buffer
+ (setq sql-buffer new-buffer)
+ (run-hooks 'sql-set-sqli-hook)))))))
(defun sql-show-sqli-buffer ()
"Show the name of current SQLi buffer.
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 sql-buffer))
+ (if (or (null sql-buffer)
+ (null (buffer-live-p (get-buffer sql-buffer))))
(message "%s has no SQLi buffer set." (buffer-name (current-buffer)))
(if (null (get-buffer-process sql-buffer))
- (message "Buffer %s has no process." (buffer-name sql-buffer))
- (message "Current SQLi buffer is %s." (buffer-name sql-buffer)))))
+ (message "Buffer %s has no process." sql-buffer)
+ (message "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.
(let ((name ""))
- ;; Try using the :sqli-login setting
- (when (string= "" (or name ""))
- (setq name
- (apply 'concat
- (apply 'append nil
- (mapcar
- (lambda (v)
- (cond
- ((eq v 'user) (list "/" sql-user))
- ((eq v 'server) (list "." sql-server))
- ((eq v 'database) (list "@" sql-database))
- ((eq v 'port) (list ":" sql-port))
-
- ((eq v 'password) nil)
- (t nil)))
- (sql-get-product-feature sql-product :sqli-login))))))
-
- ;; Default: username/server format
- (when (string= "" (or name ""))
- (setq name
- (concat " "
- (if (string= "" sql-user)
- (if (string= "" (user-login-name))
- ()
- (concat (user-login-name) "/"))
- (concat sql-user "/"))
- (if (string= "" sql-database)
- (if (string= "" sql-server)
- (system-name)
- sql-server)
- sql-database))))
-
- ;; Return the final string; prefixed by the connection name
+ ;; Build a name using the :sqli-login setting
+ (setq name
+ (apply 'concat
+ (cdr
+ (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))))))))
+
+ ;; If there's a connection, use it and the name thus far
(if sql-connection
(format "<%s>%s" sql-connection (or name ""))
- (substring (or name " ") 1))))
-(defun sql-rename-buffer ()
- "Rename a SQLi buffer."
- (interactive)
- (rename-buffer (format "*SQL: %s*" sql-alternate-buffer-name) t))
+ ;; If there is no name, try to create something meaningful
+ (if (string= "" (or name ""))
+ (concat
+ (if (string= "" sql-user)
+ (if (string= "" (user-login-name))
+ ()
+ (concat (user-login-name) "/"))
+ (concat sql-user "/"))
+ (if (string= "" sql-database)
+ (if (string= "" sql-server)
+ (system-name)
+ sql-server)
+ sql-database))
+
+ ;; Use the name we've got
+ name))))
+
+(defun sql-rename-buffer (&optional new-name)
+ "Rename a SQL interactive buffer.
+
+Prompts for the new name if command is preceded by
+\\[universal-argument]. If no buffer name is provided, then the
+`sql-alternate-buffer-name' is used.
+
+The actual buffer name set will be \"*SQL: NEW-NAME*\". If
+NEW-NAME is empty, then the buffer name will be \"*SQL*\"."
+ (interactive "P")
+
+ (if (not (derived-mode-p 'sql-interactive-mode))
+ (message "Current buffer is not a SQL interactive buffer")
+
+ (setq sql-alternate-buffer-name
+ (cond
+ ((stringp new-name) new-name)
+ ((consp new-name)
+ (read-string "Buffer name (\"*SQL: XXX*\"; enter `XXX'): "
+ sql-alternate-buffer-name))
+ (t sql-alternate-buffer-name)))
+
+ (rename-buffer (if (string= "" sql-alternate-buffer-name)
+ "*SQL*"
+ (format "*SQL: %s*" sql-alternate-buffer-name))
+ t)))
(defun sql-copy-column ()
"Copy current column to the end of buffer.
;;; Input sender for SQLi buffers
+(defvar sql-output-newline-count 0
+ "Number of newlines in the input string.
+
+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))
(filter (sql-get-product-feature product :input-filter)))
+ ;; Apply filter(s)
+ (cond
+ ((not filter)
+ nil)
+ ((functionp filter)
+ (setq string (funcall filter string)))
+ ((listp 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)
+
;; Send the string
- (comint-simple-send proc (if filter (funcall filter string) string))))
+ (comint-simple-send proc string)))
+
+;;; Strip out continuation prompts
+
+(defvar sql-preoutput-hold nil)
+
+(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-output-newline-count' is greater than
+zero, then an output line matching the continuation prompt is filtered
+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."
+
+ (let (did-filter)
+ (setq oline (concat (or sql-preoutput-hold "") oline)
+ sql-preoutput-hold nil)
+
+ (if (and comint-prompt-regexp
+ (integerp sql-output-newline-count)
+ (>= sql-output-newline-count 1))
+ (progn
+ (while (and (not (string= oline ""))
+ (> sql-output-newline-count 0)
+ (string-match comint-prompt-regexp oline)
+ (= (match-beginning 0) 0))
+
+ (setq oline (replace-match "" nil nil oline)
+ sql-output-newline-count (1- sql-output-newline-count)
+ did-filter t))
+
+ (if (= sql-output-newline-count 0)
+ (setq sql-output-newline-count nil
+ oline (concat "\n" oline)
+ sql-output-by-send nil)
+
+ (setq sql-preoutput-hold oline
+ oline ""))
+
+ (unless did-filter
+ (setq oline (or sql-preoutput-hold "")
+ sql-preoutput-hold nil
+ sql-output-newline-count nil)))
+
+ (setq sql-output-newline-count nil))
+
+ oline))
;;; Sending the region to the SQLi buffer.
"Send the string STR to the SQL process."
(interactive "sSQL Text: ")
- (let (comint-input-sender-no-newline proc)
- (if (buffer-live-p sql-buffer)
+ (let ((comint-input-sender-no-newline nil)
+ (s (replace-regexp-in-string "[[:space:]\n\r]+\\'" "" str)))
+ (if (sql-buffer-live-p sql-buffer)
(progn
;; Ignore the hoping around...
(save-excursion
- ;; Get the process
- (setq proc (get-buffer-process sql-buffer))
-
;; Set product context
(with-current-buffer sql-buffer
- ;; Send the string
- (sql-input-sender proc str)
-
- ;; Send a newline if there wasn't one on the end of the string
- (unless (string-equal "\n" (substring str (1- (length str))))
- (comint-send-string proc "\n"))
+ ;; Send the string (trim the trailing whitespace)
+ (sql-input-sender (get-buffer-process sql-buffer) s)
;; Send a command terminator if we must
(if sql-send-terminator
- (sql-send-magic-terminator sql-buffer str sql-send-terminator))
+ (sql-send-magic-terminator sql-buffer s sql-send-terminator))
- (message "Sent string to buffer %s." (buffer-name sql-buffer))))
+ (message "Sent string to buffer %s." sql-buffer)))
;; Display the sql buffer
(if sql-pop-to-buffer-after-send-region
(defun sql-send-magic-terminator (buf str terminator)
"Send TERMINATOR to buffer BUF if its not present in STR."
- (let (pat term)
+ (let (comint-input-sender-no-newline pat term)
;; If flag is merely on(t), get product-specific terminator
(if (eq terminator t)
(setq terminator (sql-get-product-feature sql-product :terminator)))
;; Check to see if the pattern is present in the str already sent
(unless (and pat term
- (string-match (concat pat "\n?\\'") str))
- (comint-send-string buf (concat term "\n")))))
+ (string-match (concat pat "\\'") str))
+ (comint-simple-send (get-buffer-process buf) term)
+ (setq sql-output-newline-count
+ (if sql-output-newline-count
+ (1+ sql-output-newline-count)
+ 1)))
+ (setq sql-output-by-send t)))
(defun sql-remove-tabs-filter (str)
"Replace tab characters with spaces."
\f
+;;; Redirect output functions
+
+(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.
+
+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. 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)
+ (unless save-prior
+ (erase-buffer))
+ (goto-char (point-max))
+ (unless (zerop (buffer-size))
+ (insert "\n"))
+ (setq start (point)))
+
+ (when sql-debug-redirect
+ (message ">>SQL> %S" command))
+
+ ;; Run the command
+ (comint-redirect-send-command-to-process command buf proc nil t)
+ (while (null comint-redirect-completed)
+ (accept-process-output nil 1))
+
+ ;; Clean up the output results
+ (with-current-buffer buf
+ ;; Remove trailing whitespace
+ (goto-char (point-max))
+ (when (looking-back "[ \t\f\n\r]*" start)
+ (delete-region (match-beginning 0) (match-end 0)))
+ ;; Remove echo if there was one
+ (goto-char start)
+ (when (looking-at (concat "^" (regexp-quote command) "[\\n]"))
+ (delete-region (match-beginning 0) (match-end 0)))
+ ;; Remove Ctrl-Ms
+ (goto-char start)
+ (while (re-search-forward "\r+$" nil t)
+ (replace-match "" t t))
+ (goto-char start)))))
+
+(defun sql-redirect-value (sqlbuf command regexp &optional regexp-groups)
+ "Execute the SQL command and return part of result.
+
+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
+\\[comint-redirect-results-list-from-process] but instead of
+returning a single submatch it returns a list of each submatch
+for each match."
+
+ (let ((outbuf " *SQL-Redirect-values*")
+ (results nil))
+ (sql-redirect 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 (/ (length (match-data)) 2))
+ (r nil))
+ (while (> i 0)
+ (setq i (1- i))
+ (push (match-string i) 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))))
+ regexp-groups))
+ ;; String is specified; return replacement string
+ ((stringp regexp-groups)
+ (match-substitute-replacement regexp-groups))
+ (t
+ (error "sql-redirect-value: unknown REGEXP-GROUPS value - %s"
+ regexp-groups)))
+ results)))
+
+ (when sql-debug-redirect
+ (message ">>SQL> = %S" (reverse results)))
+
+ (nreverse results)))
+
+(defun sql-execute (sqlbuf outbuf command enhanced arg)
+ "Executes a command in a SQL interactive buffer and captures the output.
+
+The commands are run in SQLBUF and the output saved in OUTBUF.
+COMMAND must be a string, a function or a list of such elements.
+Functions are called with SQLBUF, OUTBUF and ARG as parameters;
+strings are formatted with ARG and executed.
+
+If the results are empty the OUTBUF is deleted, otherwise the
+buffer is popped into a view window. "
+ (mapc
+ (lambda (c)
+ (cond
+ ((stringp c)
+ (sql-redirect 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)
+ (let ((one-win (eq (selected-window)
+ (get-lru-window))))
+ (with-current-buffer outbuf
+ (set-buffer-modified-p nil)
+ (toggle-read-only 1))
+ (view-buffer-other-window outbuf)
+ (when one-win
+ (shrink-window-if-larger-than-buffer)))))
+
+(defun sql-execute-feature (sqlbuf outbuf feature enhanced arg)
+ "List objects or details in a separate display buffer."
+ (let (command)
+ (with-current-buffer sqlbuf
+ (setq command (sql-get-product-feature sql-product feature)))
+ (unless command
+ (error "%s does not support %s" sql-product feature))
+ (when (consp command)
+ (setq command (if enhanced
+ (cdr command)
+ (car command))))
+ (sql-execute sqlbuf outbuf command 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 (function 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-try-completion (string collection &optional predicate)
+ (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
+ (cond
+ ((not predicate)
+ (try-completion string sql-completion-object))
+ ((eq predicate t)
+ (all-completions string sql-completion-object))
+ ((eq predicate 'lambda)
+ (test-completion string sql-completion-object))
+ ((eq (car predicate) 'boundaries)
+ (completion-boundaries string sql-completion-object nil (cdr predicate)))))))
+
+(defun sql-read-table-name (prompt)
+ "Read the name of a database table."
+ (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 (function sql-try-completion)
+ nil nil tname)
+ (read-from-minibuffer prompt tname))))
+
+(defun sql-list-all (&optional enhanced)
+ "List all database objects."
+ (interactive "P")
+ (let ((sqlbuf (sql-find-sqli-buffer)))
+ (unless sqlbuf
+ (error "No SQL interactive buffer found"))
+ (sql-execute-feature sqlbuf "*List All*" :list-all enhanced nil)
+ (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. "
+ (interactive
+ (list (sql-read-table-name "Table name: ")
+ current-prefix-arg))
+ (let ((sqlbuf (sql-find-sqli-buffer)))
+ (unless sqlbuf
+ (error "No SQL interactive buffer found"))
+ (unless name
+ (error "No table name specified"))
+ (sql-execute-feature sqlbuf (format "*List %s*" name)
+ :list-table enhanced name)))
+\f
+
;;; SQL mode -- uses SQL interactive mode
;;;###autoload
-(defun sql-mode ()
+(define-derived-mode sql-mode prog-mode "SQL"
"Major mode to edit SQL.
You can send SQL statements to the SQLi buffer using
\(add-hook 'sql-mode-hook
(lambda ()
(modify-syntax-entry ?\\\\ \".\" sql-mode-syntax-table)))"
- (interactive)
- (kill-all-local-variables)
- (setq major-mode 'sql-mode)
- (setq mode-name "SQL")
- (use-local-map sql-mode-map)
+ :abbrev-table sql-mode-abbrev-table
(if sql-mode-menu
(easy-menu-add sql-mode-menu)); XEmacs
- (set-syntax-table sql-mode-syntax-table)
- (make-local-variable 'font-lock-defaults)
- (make-local-variable 'sql-mode-font-lock-keywords)
- (make-local-variable 'comment-start)
- (setq comment-start "--")
+
+ (set (make-local-variable 'comment-start) "--")
;; Make each buffer in sql-mode remember the "current" SQLi buffer.
(make-local-variable 'sql-buffer)
;; Add imenu support for sql-mode. Note that imenu-generic-expression
imenu-case-fold-search t)
;; Make `sql-send-paragraph' work on paragraphs that contain indented
;; lines.
- (make-local-variable 'paragraph-separate)
- (make-local-variable 'paragraph-start)
- (setq paragraph-separate "[\f]*$"
- paragraph-start "[\n\f]")
+ (set (make-local-variable 'paragraph-separate) "[\f]*$")
+ (set (make-local-variable 'paragraph-start) "[\n\f]")
;; Abbrevs
- (setq local-abbrev-table sql-mode-abbrev-table)
(setq abbrev-all-caps 1)
- ;; Run hook
- (run-mode-hooks 'sql-mode-hook)
+ ;; Contains the name of database objects
+ (set (make-local-variable 'sql-contains-names) t)
;; Catch changes to sql-product and highlight accordingly
- (sql-highlight-product)
(add-hook 'hack-local-variables-hook 'sql-highlight-product t t))
\f
;; Setup the mode.
(setq major-mode 'sql-interactive-mode)
- (setq mode-name (concat "SQLi[" (or (sql-get-product-feature sql-product :name)
- (symbol-name sql-product)) "]"))
+ (setq mode-name
+ (concat "SQLi[" (or (sql-get-product-feature sql-product :name)
+ (symbol-name sql-product)) "]"))
(use-local-map sql-interactive-mode-map)
(if sql-interactive-mode-menu
(easy-menu-add sql-interactive-mode-menu)) ; XEmacs
(set-syntax-table sql-mode-syntax-table)
- (make-local-variable 'sql-mode-font-lock-keywords)
- (make-local-variable 'font-lock-defaults)
;; 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
(sql-product-font-lock t nil)
;; Enable commenting and uncommenting of the region.
- (make-local-variable 'comment-start)
- (setq comment-start "--")
+ (set (make-local-variable 'comment-start) "--")
;; Abbreviation table init and case-insensitive. It is not activated
;; by default.
(setq local-abbrev-table sql-mode-abbrev-table)
(setq abbrev-all-caps 1)
;; Exiting the process will call sql-stop.
- (set-process-sentinel (get-buffer-process sql-buffer) 'sql-stop)
- ;; Save the connection name
- (make-local-variable 'sql-connection)
- ;; Create a usefull name for renaming this buffer later.
- (make-local-variable 'sql-alternate-buffer-name)
- (setq sql-alternate-buffer-name (sql-make-alternate-buffer-name))
+ (set-process-sentinel (get-buffer-process (current-buffer)) 'sql-stop)
+ ;; 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)
+ ;; 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-regexp)
(sql-get-product-feature sql-product :prompt-regexp))
(set (make-local-variable 'sql-prompt-length)
(sql-get-product-feature sql-product :prompt-length))
+ (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-preoutput-hold)
+ (make-local-variable 'sql-output-by-send)
+ (add-hook 'comint-preoutput-filter-functions
+ 'sql-interactive-remove-continuation-prompt nil t)
(make-local-variable 'sql-input-ring-separator)
(make-local-variable 'sql-input-ring-file-name)
- (setq comint-process-echoes t)
;; Run the mode hook (along with comint's hooks).
(run-mode-hooks 'sql-interactive-mode-hook)
;; Set comint based on user overrides.
- (setq comint-prompt-regexp sql-prompt-regexp)
+ (setq comint-prompt-regexp
+ (if sql-prompt-cont-regexp
+ (concat "\\(" sql-prompt-regexp
+ "\\|" sql-prompt-cont-regexp "\\)")
+ sql-prompt-regexp))
(setq left-margin sql-prompt-length)
;; Install input sender
(set (make-local-variable 'comint-input-sender) 'sql-input-sender)
\f
-;;; Entry functions for different SQL interpreters.
-
-;;;###autoload
-(defun sql-product-interactive (&optional product)
- "Run PRODUCT interpreter as an inferior process.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer `*SQL*'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive "P")
-
- (setq product
- (cond
- ((equal product '(4)) ; Universal arg, prompt for product
- (intern (completing-read "SQL product: "
- (mapcar (lambda (info) (symbol-name (car info)))
- sql-product-alist)
- nil 'require-match
- (or (and sql-product (symbol-name sql-product)) "ansi"))))
- ((and product ; Product specified
- (symbolp product)) product)
- (t sql-product))) ; Default to sql-product
-
- (if product
- (when (sql-get-product-feature product :sqli-comint-func)
- (if (and sql-buffer
- (buffer-live-p sql-buffer)
- (comint-check-proc sql-buffer))
- (pop-to-buffer sql-buffer)
-
- ;; Is the current buffer in sql-mode and
- ;; there is a buffer local setting of sql-buffer
- (let* ((start-buffer
- (and (derived-mode-p 'sql-mode)
- (current-buffer)))
- (start-sql-buffer
- (and start-buffer
- (let (found)
- (dolist (var (buffer-local-variables))
- (and (consp var)
- (eq (car var) 'sql-buffer)
- (buffer-live-p (cdr var))
- (get-buffer-process (cdr var))
- (setq found (cdr var))))
- found)))
- new-sqli-buffer)
-
- ;; Get credentials.
- (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))
-
- ;; Set SQLi mode.
- (setq sql-interactive-product product
- new-sqli-buffer (current-buffer)
- sql-buffer new-sqli-buffer)
- (sql-interactive-mode)
-
- ;; Set `sql-buffer' in the start buffer
- (when (and start-buffer (not start-sql-buffer))
- (with-current-buffer start-buffer
- (setq sql-buffer new-sqli-buffer)))
-
- ;; All done.
- (message "Login...done")
- (pop-to-buffer sql-buffer))))
- (message "No default SQL product defined. Set `sql-product'.")))
-
-(defun sql-comint (product params)
- "Set up a comint buffer to run the SQL processor.
+;;; Connection handling
-PRODUCT is the SQL product. PARAMS is a list of strings which are
-passed as command line arguments."
- (let ((program (sql-get-product-feature product :sqli-program)))
- (set-buffer
- (apply 'make-comint "SQL" program nil params))))
+(defun sql-read-connection (prompt &optional initial default)
+ "Read a connection name."
+ (let ((completion-ignore-case t))
+ (completing-read prompt
+ (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
- (let ((completion-ignore-case t))
- (completing-read "Connection: "
- (mapcar (lambda (c) (car c))
- sql-connection-alist)
- nil t nil nil '(()))))
+ (list (sql-read-connection "Connection: " nil '(nil))
+ current-prefix-arg)
nil))
;; Are there connections defined
(t (car v))))
(cdr connect-set)))
;; the remaining params (w/o the connection params)
- (rem-params (delq nil
- (mapcar
- (lambda (l)
- (unless (member l set-params)
- l))
- login-params)))
- ;; Remember the connection
- (sql-connection connection))
+ (rem-params (sql-for-each-login
+ login-params
+ (lambda (token plist)
+ (unless (member token set-params)
+ (if plist
+ (cons token plist)
+ token))))))
;; Set the remaining parameters and start the
;; interactive session
- (eval `(let ((,param-var ',rem-params))
- (sql-product-interactive sql-product)))))
+ (eval `(let ((sql-connection ,connection)
+ (,param-var ',rem-params))
+ (sql-product-interactive sql-product
+ new-name)))))
+
(message "SQL Connection <%s> does not exist" connection)
nil)))
(message "No SQL Connections defined")
(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)
- (delq nil
- (mapcar
- (lambda (param)
- (cond
- ((eq param 'product) `(sql-product (quote ,sql-product)))
- ((eq param 'user) `(sql-user ,sql-user))
- ((eq param 'database) `(sql-database ,sql-database))
- ((eq param 'server) `(sql-server ,sql-server))
- ((eq param 'port) `(sql-port ,sql-port))))
- (append (list 'product) login)))))
-
- (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))))))
+ (unless (derived-mode-p 'sql-interactive-mode)
+ (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)
+ (message "Connection <%s> already exists" name)
+ (setq connect
+ (append (list name)
+ (sql-for-each-login
+ `(product ,@login)
+ (lambda (token _plist)
+ (cond
+ ((eq token 'product) `(sql-product ',product))
+ ((eq token 'user) `(sql-user ,user))
+ ((eq token 'database) `(sql-database ,database))
+ ((eq token 'server) `(sql-server ,server))
+ ((eq token 'port) `(sql-port ,port)))))))
+
+ (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)))))))
(defun sql-connection-menu-filter (tail)
"Generates menu entries for using each connection."
(mapcar
(lambda (conn)
(vector
- (format "Connection <%s>" (car conn))
+ (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-oracle ()
+(defun sql-product-interactive (&optional product new-name)
+ "Run PRODUCT interpreter as an inferior process.
+
+If buffer `*SQL*' exists but no process is running, make a new process.
+If buffer exists and a process is running, just switch to buffer `*SQL*'.
+
+To specify the SQL product, prefix the call with
+\\[universal-argument]. To set the buffer name as well, prefix
+the call to \\[sql-product-interactive] with
+\\[universal-argument] \\[universal-argument].
+
+\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
+ (interactive "P")
+
+ ;; Handle universal arguments if specified
+ (when (not (or executing-kbd-macro noninteractive))
+ (when (and (consp product)
+ (not (cdr product))
+ (numberp (car product)))
+ (when (>= (prefix-numeric-value product) 16)
+ (when (not new-name)
+ (setq new-name '(4)))
+ (setq product '(4)))))
+
+ ;; Get the value of product that we need
+ (setq product
+ (cond
+ ((= (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
+ (if product
+ (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 sql-connection)))
+ (if (and (not new-name) buf)
+ (pop-to-buffer buf)
+
+ ;; We have a new name or sql-buffer doesn't exist or match
+ ;; Start by remembering where we start
+ (let ((start-buffer (current-buffer))
+ new-sqli-buffer)
+
+ ;; Get credentials.
+ (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))
+
+ ;; Set SQLi mode.
+ (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))
+ (setq sql-buffer (buffer-name new-sqli-buffer))
+
+ ;; Set `sql-buffer' in the start buffer
+ (with-current-buffer start-buffer
+ (when (derived-mode-p 'sql-mode)
+ (setq sql-buffer (buffer-name new-sqli-buffer))
+ (run-hooks 'sql-set-sqli-hook)))
+
+ ;; All done.
+ (message "Login...done")
+ (pop-to-buffer new-sqli-buffer)))))
+ (message "No default SQL product defined. Set `sql-product'.")))
+
+(defun sql-comint (product params)
+ "Set up a comint buffer to run the SQL processor.
+
+PRODUCT is the SQL product. PARAMS is a list of strings which are
+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)
+ (error "Unable to locate SQL program \'%s\'" program))
+ ;; Make sure buffer name is unique
+ (when (sql-buffer-live-p (format "*%s*" buf-name))
+ (setq buf-name (format "SQL-%s" product))
+ (when (sql-buffer-live-p (format "*%s*" buf-name))
+ (let ((i 1))
+ (while (sql-buffer-live-p
+ (format "*%s*"
+ (setq buf-name (format "SQL-%s%d" product i))))
+ (setq i (1+ i))))))
+ (set-buffer
+ (apply 'make-comint buf-name program nil params))))
+
+;;;###autoload
+(defun sql-oracle (&optional buffer)
"Run sqlplus by Oracle as an inferior process.
If buffer `*SQL*' exists but no process is running, make a new process.
The buffer is put in SQL interactive mode, giving commands for sending
input. See `sql-interactive-mode'.
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-oracle]. Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
To specify a coding system for converting non-ASCII characters
in the input and output to the process, use \\[universal-coding-system-argument]
before \\[sql-oracle]. You can also specify this with \\[set-buffer-process-coding-system]
`default-process-coding-system'.
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive)
- (sql-product-interactive 'oracle))
+ (interactive "P")
+ (sql-product-interactive 'oracle buffer))
(defun sql-comint-oracle (product options)
"Create comint buffer and connect to Oracle."
(setq parameter options))
(sql-comint product parameter)))
+(defun sql-oracle-save-settings (sqlbuf)
+ "Saves 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")
+
+ ;; FEDDBACK 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
-(defun sql-sybase ()
+(defun sql-sybase (&optional buffer)
"Run isql by Sybase as an inferior process.
If buffer `*SQL*' exists but no process is running, make a new process.
The buffer is put in SQL interactive mode, giving commands for sending
input. See `sql-interactive-mode'.
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-sybase]. Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
To specify a coding system for converting non-ASCII characters
in the input and output to the process, use \\[universal-coding-system-argument]
before \\[sql-sybase]. You can also specify this with \\[set-buffer-process-coding-system]
`default-process-coding-system'.
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive)
- (sql-product-interactive 'sybase))
+ (interactive "P")
+ (sql-product-interactive 'sybase buffer))
(defun sql-comint-sybase (product options)
"Create comint buffer and connect to Sybase."
\f
;;;###autoload
-(defun sql-informix ()
+(defun sql-informix (&optional buffer)
"Run dbaccess by Informix as an inferior process.
If buffer `*SQL*' exists but no process is running, make a new process.
The buffer is put in SQL interactive mode, giving commands for sending
input. See `sql-interactive-mode'.
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-informix]. Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
To specify a coding system for converting non-ASCII characters
in the input and output to the process, use \\[universal-coding-system-argument]
before \\[sql-informix]. You can also specify this with \\[set-buffer-process-coding-system]
`default-process-coding-system'.
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive)
- (sql-product-interactive 'informix))
+ (interactive "P")
+ (sql-product-interactive 'informix buffer))
(defun sql-comint-informix (product options)
"Create comint buffer and connect to Informix."
\f
;;;###autoload
-(defun sql-sqlite ()
+(defun sql-sqlite (&optional buffer)
"Run sqlite as an inferior process.
SQLite is free software.
The buffer is put in SQL interactive mode, giving commands for sending
input. See `sql-interactive-mode'.
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-sqlite]. Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
To specify a coding system for converting non-ASCII characters
in the input and output to the process, use \\[universal-coding-system-argument]
before \\[sql-sqlite]. You can also specify this with \\[set-buffer-process-coding-system]
`default-process-coding-system'.
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive)
- (sql-product-interactive 'sqlite))
+ (interactive "P")
+ (sql-product-interactive 'sqlite buffer))
(defun sql-comint-sqlite (product options)
"Create comint buffer and connect to SQLite."
;; make-comint.
(let ((params))
(if (not (string= "" sql-database))
- (setq params (append (list sql-database) params)))
+ (setq params (append (list (expand-file-name sql-database))
+ params)))
(setq params (append options params))
(sql-comint product params)))
+(defun sql-sqlite-completion-object (sqlbuf schema)
+ (sql-redirect-value sqlbuf ".tables" "\\sw\\(?:\\sw\\|\\s_\\)*" 0))
+
\f
;;;###autoload
-(defun sql-mysql ()
+(defun sql-mysql (&optional buffer)
"Run mysql by TcX as an inferior process.
Mysql versions 3.23 and up are free software.
The buffer is put in SQL interactive mode, giving commands for sending
input. See `sql-interactive-mode'.
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-mysql]. Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
To specify a coding system for converting non-ASCII characters
in the input and output to the process, use \\[universal-coding-system-argument]
before \\[sql-mysql]. You can also specify this with \\[set-buffer-process-coding-system]
`default-process-coding-system'.
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive)
- (sql-product-interactive 'mysql))
+ (interactive "P")
+ (sql-product-interactive 'mysql buffer))
(defun sql-comint-mysql (product options)
"Create comint buffer and connect to MySQL."
(setq params (append (list sql-database) params)))
(if (not (string= "" sql-server))
(setq params (append (list (concat "--host=" sql-server)) params)))
- (if (and sql-port (numberp sql-port))
+ (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)))
\f
;;;###autoload
-(defun sql-solid ()
+(defun sql-solid (&optional buffer)
"Run solsql by Solid as an inferior process.
If buffer `*SQL*' exists but no process is running, make a new process.
The buffer is put in SQL interactive mode, giving commands for sending
input. See `sql-interactive-mode'.
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-solid]. Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
To specify a coding system for converting non-ASCII characters
in the input and output to the process, use \\[universal-coding-system-argument]
before \\[sql-solid]. You can also specify this with \\[set-buffer-process-coding-system]
`default-process-coding-system'.
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive)
- (sql-product-interactive 'solid))
+ (interactive "P")
+ (sql-product-interactive 'solid buffer))
(defun sql-comint-solid (product options)
"Create comint buffer and connect to Solid."
\f
;;;###autoload
-(defun sql-ingres ()
+(defun sql-ingres (&optional buffer)
"Run sql by Ingres as an inferior process.
If buffer `*SQL*' exists but no process is running, make a new process.
The buffer is put in SQL interactive mode, giving commands for sending
input. See `sql-interactive-mode'.
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-ingres]. Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
To specify a coding system for converting non-ASCII characters
in the input and output to the process, use \\[universal-coding-system-argument]
before \\[sql-ingres]. You can also specify this with \\[set-buffer-process-coding-system]
`default-process-coding-system'.
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive)
- (sql-product-interactive 'ingres))
+ (interactive "P")
+ (sql-product-interactive 'ingres buffer))
(defun sql-comint-ingres (product options)
"Create comint buffer and connect to Ingres."
\f
;;;###autoload
-(defun sql-ms ()
+(defun sql-ms (&optional buffer)
"Run osql by Microsoft as an inferior process.
If buffer `*SQL*' exists but no process is running, make a new process.
The buffer is put in SQL interactive mode, giving commands for sending
input. See `sql-interactive-mode'.
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-ms]. Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
To specify a coding system for converting non-ASCII characters
in the input and output to the process, use \\[universal-coding-system-argument]
before \\[sql-ms]. You can also specify this with \\[set-buffer-process-coding-system]
`default-process-coding-system'.
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive)
- (sql-product-interactive 'ms))
+ (interactive "P")
+ (sql-product-interactive 'ms buffer))
(defun sql-comint-ms (product options)
"Create comint buffer and connect to Microsoft SQL Server."
\f
;;;###autoload
-(defun sql-postgres ()
+(defun sql-postgres (&optional buffer)
"Run psql by Postgres as an inferior process.
If buffer `*SQL*' exists but no process is running, make a new process.
The buffer is put in SQL interactive mode, giving commands for sending
input. See `sql-interactive-mode'.
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-postgres]. Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
To specify a coding system for converting non-ASCII characters
in the input and output to the process, use \\[universal-coding-system-argument]
before \\[sql-postgres]. You can also specify this with \\[set-buffer-process-coding-system]
'(comint-strip-ctrl-m)))
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive)
- (sql-product-interactive 'postgres))
+ (interactive "P")
+ (sql-product-interactive 'postgres buffer))
(defun sql-comint-postgres (product options)
"Create comint buffer and connect to Postgres."
(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" (number-to-string sql-port)) params)))
(sql-comint product params)))
+(defun sql-postgres-completion-object (sqlbuf schema)
+ (let (cl re fs a r)
+ (sql-redirect sqlbuf "\\t on")
+ (setq a (car (sql-redirect-value sqlbuf "\\a" "Output format is \\(.*\\)[.]$" 1)))
+ (when (string= a "aligned")
+ (sql-redirect sqlbuf "\\a"))
+ (setq fs (or (car (sql-redirect-value sqlbuf "\\f" "Field separator is \"\\(.\\)[.]$" 1)) "|"))
+
+ (setq re (concat "^\\([^" fs "]*\\)" fs "\\([^" fs "]*\\)" fs "[^" fs "]*" fs "[^" fs "]*$"))
+ (setq 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 (string= a "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
-(defun sql-interbase ()
+(defun sql-interbase (&optional buffer)
"Run isql by Interbase as an inferior process.
If buffer `*SQL*' exists but no process is running, make a new process.
The buffer is put in SQL interactive mode, giving commands for sending
input. See `sql-interactive-mode'.
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-interbase]. Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
To specify a coding system for converting non-ASCII characters
in the input and output to the process, use \\[universal-coding-system-argument]
before \\[sql-interbase]. You can also specify this with \\[set-buffer-process-coding-system]
`default-process-coding-system'.
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive)
- (sql-product-interactive 'interbase))
+ (interactive "P")
+ (sql-product-interactive 'interbase buffer))
(defun sql-comint-interbase (product options)
"Create comint buffer and connect to Interbase."
\f
;;;###autoload
-(defun sql-db2 ()
+(defun sql-db2 (&optional buffer)
"Run db2 by IBM as an inferior process.
If buffer `*SQL*' exists but no process is running, make a new process.
`comint-input-sender' back to `comint-simple-send' by writing an after
advice. See the elisp manual for more information.
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-db2]. Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
To specify a coding system for converting non-ASCII characters
in the input and output to the process, use \\[universal-coding-system-argument]
before \\[sql-db2]. You can also specify this with \\[set-buffer-process-coding-system]
`default-process-coding-system'.
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive)
- (sql-product-interactive 'db2))
+ (interactive "P")
+ (sql-product-interactive 'db2 buffer))
(defun sql-comint-db2 (product options)
"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)
-)
-;; ;; Properly escape newlines when DB2 is interactive.
-;; (setq comint-input-sender 'sql-escape-newlines-and-send))
+ (sql-comint product options))
;;;###autoload
-(defun sql-linter ()
+(defun sql-linter (&optional buffer)
"Run inl by RELEX as an inferior process.
If buffer `*SQL*' exists but no process is running, make a new process.
The buffer is put in SQL interactive mode, giving commands for sending
input. See `sql-interactive-mode'.
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-linter]. Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive)
- (sql-product-interactive 'linter))
+ (interactive "P")
+ (sql-product-interactive 'linter buffer))
(defun sql-comint-linter (product options)
"Create comint buffer and connect to Linter."
(provide 'sql)
-;; arch-tag: 7e1fa1c4-9ca2-402e-87d2-83a5eccb7ac3
;;; sql.el ends here
+; LocalWords: sql SQL SQLite sqlite Sybase Informix MySQL
+; LocalWords: Postgres SQLServer SQLi
HCoop / bpt / emacs.git / blobdiff