-;;; sql.el --- specialized comint.el for SQL interpreters
+;;; sql.el --- specialized comint.el for SQL interpreters -*- lexical-binding: t -*-
-;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2014 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
-;; Maintainer: Michael Mauger <mmaug@yahoo.com>
-;; Version: 3.1
+;; Maintainer: Michael Mauger <michael@mauger.com>
+;; Version: 3.4
;; Keywords: comm languages processes
;; URL: http://savannah.gnu.org/projects/emacs/
;; Hint for newbies: take a look at `dabbrev-expand', `abbrev-mode', and
;; `imenu-add-menubar-index'.
-;;; Requirements for Emacs 19.34:
-
-;; If you are using Emacs 19.34, you will have to get and install
-;; the file regexp-opt.el
-;; <URL:ftp://ftp.ifi.uio.no/pub/emacs/emacs-20.3/lisp/emacs-lisp/regexp-opt.el>
-;; and the custom package
-;; <URL:http://www.dina.kvl.dk/~abraham/custom/>.
-
;;; Bugs:
;; sql-ms now uses osql instead of isql. Osql flushes its error
;;
;; ;; Do something with `sql-user', `sql-password',
;; ;; `sql-database', and `sql-server'.
-;; (let ((params options))
-;; (if (not (string= "" sql-server))
-;; (setq params (append (list "-S" sql-server) params)))
-;; (if (not (string= "" sql-database))
-;; (setq params (append (list "-D" sql-database) params)))
-;; (if (not (string= "" sql-password))
-;; (setq params (append (list "-P" sql-password) params)))
+;; (let ((params
+;; (append
;; (if (not (string= "" sql-user))
-;; (setq params (append (list "-U" sql-user) params)))
+;; (list "-U" sql-user))
+;; (if (not (string= "" sql-password))
+;; (list "-P" sql-password))
+;; (if (not (string= "" sql-database))
+;; (list "-D" sql-database))
+;; (if (not (string= "" sql-server))
+;; (list "-S" sql-server))
+;; options)))
;; (sql-comint product params)))
;;
;; (sql-set-product-feature 'xyz
;; nino <nino@inform.dk>
;; Berend de Boer <berend@pobox.com>
;; Adam Jenkins <adam@thejenkins.org>
-;; Michael Mauger <mmaug@yahoo.com> -- improved product support
+;; Michael Mauger <michael@mauger.com> -- improved product support
;; Drew Adams <drew.adams@oracle.com> -- Emacs 20 support
;; Harald Maier <maierh@myself.com> -- sql-send-string
;; Stefan Monnier <monnier@iro.umontreal.ca> -- font-lock corrections;
;; Andrew Schein <andrew@andrewschein.com> -- sql-port bug
;; Ian Bjorhovde <idbjorh@dataproxy.com> -- db2 escape newlines
;; incorrectly enabled by default
+;; Roman Scherer <roman.scherer@nugg.ad> -- Connection documentation
+;; Mark Wilkinson <wilkinsonmr@gmail.com> -- file-local variables ignored
+;;
\f
;;; Code:
+(require 'cl-lib)
(require 'comint)
;; Need the following to allow GNU Emacs 19 to compile the file.
(eval-when-compile
(require 'regexp-opt))
(require 'custom)
(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)))
+(require 'view)
(defvar font-lock-keyword-face)
(defvar font-lock-set-defaults)
:group 'languages
:group 'processes)
-;; These four variables will be used as defaults, if set.
+;; These five variables will be used as defaults, if set.
(defcustom sql-user ""
"Default username."
(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)
+ :type '(set :tag "Login Parameters"
+ (choice :tag "user"
+ :value user
+ (const user)
+ (list :tag "Specify a default"
+ (const user)
+ (list :tag "Default"
+ :inline t (const :default) string)))
+ (const password)
+ (choice :tag "server"
+ :value server
+ (const server)
+ (list :tag "Specify a default"
+ (const server)
+ (list :tag "Default"
+ :inline t (const :default) string))
+ (list :tag "file"
+ (const :format "" server)
+ (const :format "" :file)
+ regexp)
+ (list :tag "completion"
+ (const :format "" server)
+ (const :format "" :completion)
+ (restricted-sexp
+ :match-alternatives (listp stringp))))
+ (choice :tag "database"
+ :value database
+ (const database)
+ (list :tag "Specify a default"
+ (const database)
+ (list :tag "Default"
+ :inline t (const :default) string))
+ (list :tag "file"
+ (const :format "" database)
+ (const :format "" :file)
+ regexp)
+ (list :tag "completion"
+ (const :format "" database)
(const :format "" :completion)
(restricted-sexp
:match-alternatives (listp stringp))))
- (const port))))
+ (const port)))
;; SQL Product support
:completion-object sql-oracle-completion-object
:prompt-regexp "^SQL> "
:prompt-length 5
- :prompt-cont-regexp "^\\s-*[[:digit:]]+ "
+ :prompt-cont-regexp "^\\(?:[ ][ ][1-9]\\|[ ][1-9][0-9]\\|[1-9][0-9]\\{2\\}\\)[ ]\\{2\\}"
:statement sql-oracle-statement-starters
:syntax-alist ((?$ . "_") (?# . "_"))
:terminator ("\\(^/\\|;\\)$" . "/")
\(CONNECTION \(SQL-VARIABLE VALUE) ...)
-Where CONNECTION is a symbol identifying the connection, SQL-VARIABLE
-is the symbol name of a SQL mode variable, and VALUE is the value to
-be assigned to the variable. The most common SQL-VARIABLE settings
-associated with a connection are: `sql-product', `sql-user',
-`sql-password', `sql-port', `sql-server', and `sql-database'.
+Where CONNECTION is a case-insensitive string identifying the
+connection, SQL-VARIABLE is the symbol name of a SQL mode
+variable, and VALUE is the value to be assigned to the variable.
+The most common SQL-VARIABLE settings associated with a
+connection are: `sql-product', `sql-user', `sql-password',
+`sql-port', `sql-server', and `sql-database'.
If a SQL-VARIABLE is part of the connection, it will not be
prompted for during login. The command `sql-connect' starts a
(set
(group (const :tag "Product" sql-product)
(choice
- ,@(mapcar (lambda (prod-info)
- `(const :tag
- ,(or (plist-get (cdr prod-info) :name)
- (capitalize (symbol-name (car prod-info))))
- (quote ,(car prod-info))))
- sql-product-alist)))
+ ,@(mapcar
+ (lambda (prod-info)
+ `(const :tag
+ ,(or (plist-get (cdr prod-info) :name)
+ (capitalize
+ (symbol-name (car prod-info))))
+ (quote ,(car prod-info))))
+ sql-product-alist)))
(group (const :tag "Username" sql-user) string)
(group (const :tag "Password" sql-password) string)
(group (const :tag "Server" sql-server) string)
:group 'SQL)
(defcustom sql-product 'ansi
- "Select the SQL database product used so that buffers can be
-highlighted properly when you open them."
+ "Select the SQL database product used.
+This allows highlighting buffers properly when you open them."
:type `(choice
,@(mapcar (lambda (prod-info)
`(const :tag
Globally should be set to nil; it will be non-nil in `sql-mode',
`sql-interactive-mode' and list all buffers.")
+(defvar sql-login-delay 7.5 ;; Secs
+ "Maximum number of seconds you are willing to wait for a login connection.")
(defcustom sql-pop-to-buffer-after-send-region nil
"When non-nil, pop to the buffer SQL statements are sent to.
(defvar sql-imenu-generic-expression
;; Items are in reverse order because they are rendered in reverse.
- '(("Rules/Defaults" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*\\(rule\\|default\\)\\s-+\\(\\w+\\)" 3)
- ("Sequences" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*sequence\\s-+\\(\\w+\\)" 2)
- ("Triggers" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*trigger\\s-+\\(\\w+\\)" 2)
- ("Functions" "^\\s-*\\(create\\s-+\\(\\w+\\s-+\\)*\\)?function\\s-+\\(\\w+\\)" 3)
- ("Procedures" "^\\s-*\\(create\\s-+\\(\\w+\\s-+\\)*\\)?proc\\(edure\\)?\\s-+\\(\\w+\\)" 4)
- ("Packages" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*package\\s-+\\(body\\s-+\\)?\\(\\w+\\)" 3)
- ("Types" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*type\\s-+\\(body\\s-+\\)?\\(\\w+\\)" 3)
- ("Indexes" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*index\\s-+\\(\\w+\\)" 2)
- ("Tables/Views" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*\\(table\\|view\\)\\s-+\\(\\w+\\)" 3))
+ '(("Rules/Defaults" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*\\(?:rule\\|default\\)\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\s-+\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1)
+ ("Sequences" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*sequence\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1)
+ ("Triggers" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*trigger\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1)
+ ("Functions" "^\\s-*\\(?:create\\s-+\\(?:\\w+\\s-+\\)*\\)?function\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1)
+ ("Procedures" "^\\s-*\\(?:create\\s-+\\(?:\\w+\\s-+\\)*\\)?proc\\(?:edure\\)?\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1)
+ ("Packages" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*package\\s-+\\(?:body\\s-+\\)?\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1)
+ ("Types" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*type\\s-+\\(?:body\\s-+\\)?\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1)
+ ("Indexes" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*index\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1)
+ ("Tables/Views" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*\\(?:table\\|view\\)\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1))
"Define interesting points in the SQL buffer for `imenu'.
This is used to set `imenu-generic-expression' when SQL mode is
;; 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
+(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
:type 'file
:group 'SQL)
-(defcustom sql-oracle-options nil
+(defcustom sql-oracle-options '("-L")
"List of additional options for `sql-oracle-program'."
:type '(repeat string)
- :version "20.8"
+ :version "24.4"
:group 'SQL)
(defcustom sql-oracle-login-params '(user password database)
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.
+ "Return non-nil if the process associated with buffer is live.
BUFFER can be a buffer object or a buffer name. The buffer must
-be a live buffer, have an running process attached to it, be in
+be a live buffer, have a running process attached to it, be in
`sql-interactive-mode', and, if PRODUCT or CONNECTION are
specified, it's `sql-product' or `sql-connection' must match."
(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)
;; Abbreviations -- if you want more of them, define them in your init
;; file. Abbrevs have to be enabled in your init file, too.
-(defvar sql-mode-abbrev-table nil
+(define-abbrev-table 'sql-mode-abbrev-table
+ '(("ins" "insert" nil nil t)
+ ("upd" "update" nil nil t)
+ ("del" "delete" nil nil t)
+ ("sel" "select" nil nil t)
+ ("proc" "procedure" nil nil t)
+ ("func" "function" nil nil t)
+ ("cr" "create" nil nil t))
"Abbrev table used in `sql-mode' and `sql-interactive-mode'.")
-(unless sql-mode-abbrev-table
- (define-abbrev-table 'sql-mode-abbrev-table nil))
-
-(mapc
- ;; In Emacs 22+, provide SYSTEM-FLAG to define-abbrev.
- (lambda (abbrev)
- (let ((name (car abbrev))
- (expansion (cdr abbrev)))
- (condition-case nil
- (define-abbrev sql-mode-abbrev-table name expansion nil 0 t)
- (error
- (define-abbrev sql-mode-abbrev-table name expansion)))))
- '(("ins" . "insert")
- ("upd" . "update")
- ("del" . "delete")
- ("sel" . "select")
- ("proc" . "procedure")
- ("func" . "function")
- ("cr" . "create")))
;; Syntax Table
;; double quotes (") don't delimit strings
(modify-syntax-entry ?\" "." table)
;; Make these all punctuation
- (mapc (lambda (c) (modify-syntax-entry c "." table))
+ (mapc #'(lambda (c) (modify-syntax-entry c "." table))
(string-to-list "!#$%&+,.:;<=>?@\\|"))
table)
"Syntax table used in `sql-mode' and `sql-interactive-mode'.")
"\\(?:\\w+\\s-+\\)*" ;; optional intervening keywords
"\\(?:table\\|view\\|\\(?:package\\|type\\)\\(?:\\s-+body\\)?\\|proc\\(?:edure\\)?"
"\\|function\\|trigger\\|sequence\\|rule\\|default\\)\\s-+"
- "\\(\\w+\\)")
+ "\\(?:if\\s-+not\\s-+exists\\s-+\\)?" ;; IF NOT EXISTS
+ "\\(\\w+\\(?:\\s-*[.]\\s-*\\w+\\)*\\)")
1 'font-lock-function-name-face))
"Pattern to match the names of top-level objects.
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 ()
+(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")
+ (user-error "Not an Oracle buffer")
(let ((b "*RESERVED WORDS*"))
(sql-execute sql-buffer b
"\\)\\(?:\\s-.*\\)?\\(?:[-]\n.*\\)*$")
0 'font-lock-doc-face t)
+ '("&?&\\(?:\\sw\\|\\s_\\)+[.]?" 0 font-lock-preprocessor-face t)
;; Oracle Functions
(sql-font-lock-keywords-builder 'font-lock-builtin-face nil
"noswitch" "not" "nothing" "notimeout" "novalidate" "nowait" "null"
"nulls" "object" "of" "off" "offline" "oidindex" "old" "on" "online"
"only" "open" "operator" "optimal" "option" "or" "order"
-"organization" "out" "outer" "outline" "overflow" "overriding"
+"organization" "out" "outer" "outline" "over" "overflow" "overriding"
"package" "packages" "parallel" "parallel_enable" "parameters"
"parent" "partition" "partitions" "password" "password_grace_time"
"password_life_time" "password_lock_time" "password_reuse_max"
;; Oracle PL/SQL Functions
(sql-font-lock-keywords-builder 'font-lock-builtin-face nil
"delete" "trim" "extend" "exists" "first" "last" "count" "limit"
-"prior" "next"
+"prior" "next" "sqlcode" "sqlerrm"
)
;; Oracle PL/SQL Reserved words
;; Postgres non-reserved words
(sql-font-lock-keywords-builder 'font-lock-builtin-face nil
"abort" "absolute" "access" "action" "add" "admin" "after" "aggregate"
-"also" "alter" "always" "assertion" "assignment" "at" "backward"
+"also" "alter" "always" "assertion" "assignment" "at" "attribute" "backward"
"before" "begin" "between" "by" "cache" "called" "cascade" "cascaded"
"catalog" "chain" "characteristics" "checkpoint" "class" "close"
"cluster" "coalesce" "comment" "comments" "commit" "committed"
"delimiters" "dictionary" "disable" "discard" "document" "domain"
"drop" "each" "enable" "encoding" "encrypted" "enum" "escape"
"exclude" "excluding" "exclusive" "execute" "exists" "explain"
-"external" "extract" "family" "first" "float" "following" "force"
+"extension" "external" "extract" "family" "first" "float" "following" "force"
"forward" "function" "functions" "global" "granted" "greatest"
"handler" "header" "hold" "hour" "identity" "if" "immediate"
"immutable" "implicit" "including" "increment" "index" "indexes"
"inherit" "inherits" "inline" "inout" "input" "insensitive" "insert"
-"instead" "invoker" "isolation" "key" "language" "large" "last"
-"lc_collate" "lc_ctype" "least" "level" "listen" "load" "local"
+"instead" "invoker" "isolation" "key" "label" "language" "large" "last"
+"lc_collate" "lc_ctype" "leakproof" "least" "level" "listen" "load" "local"
"location" "lock" "login" "mapping" "match" "maxvalue" "minute"
-"minvalue" "mode" "month" "move" "name" "names" "national" "nchar"
+"minvalue" "mode" "month" "move" "names" "national" "nchar"
"next" "no" "nocreatedb" "nocreaterole" "nocreateuser" "noinherit"
-"nologin" "none" "nosuperuser" "nothing" "notify" "nowait" "nullif"
-"nulls" "object" "of" "oids" "operator" "option" "options" "out"
-"overlay" "owned" "owner" "parser" "partial" "partition" "password"
-"plans" "position" "preceding" "prepare" "prepared" "preserve" "prior"
+"nologin" "none" "noreplication" "nosuperuser" "nothing" "notify" "nowait" "nullif"
+"nulls" "object" "of" "off" "oids" "operator" "option" "options" "out"
+"overlay" "owned" "owner" "parser" "partial" "partition" "passing" "password"
+"plans" "position" "preceding" "precision" "prepare" "prepared" "preserve" "prior"
"privileges" "procedural" "procedure" "quote" "range" "read"
-"reassign" "recheck" "recursive" "reindex" "relative" "release"
-"rename" "repeatable" "replace" "replica" "reset" "restart" "restrict"
+"reassign" "recheck" "recursive" "ref" "reindex" "relative" "release"
+"rename" "repeatable" "replace" "replica" "replication" "reset" "restart" "restrict"
"returns" "revoke" "role" "rollback" "row" "rows" "rule" "savepoint"
-"schema" "scroll" "search" "second" "security" "sequence" "sequences"
+"schema" "scroll" "search" "second" "security" "sequence"
"serializable" "server" "session" "set" "setof" "share" "show"
-"simple" "stable" "standalone" "start" "statement" "statistics"
+"simple" "snapshot" "stable" "standalone" "start" "statement" "statistics"
"stdin" "stdout" "storage" "strict" "strip" "substring" "superuser"
"sysid" "system" "tables" "tablespace" "temp" "template" "temporary"
-"transaction" "treat" "trigger" "trim" "truncate" "trusted" "type"
-"unbounded" "uncommitted" "unencrypted" "unknown" "unlisten" "until"
-"update" "vacuum" "valid" "validator" "value" "values" "version"
-"view" "volatile" "whitespace" "work" "wrapper" "write"
-"xmlattributes" "xmlconcat" "xmlelement" "xmlforest" "xmlparse"
-"xmlpi" "xmlroot" "xmlserialize" "year" "yes"
+"transaction" "treat" "trim" "truncate" "trusted" "type" "types"
+"unbounded" "uncommitted" "unencrypted" "unlisten" "unlogged" "until"
+"update" "vacuum" "valid" "validate" "validator" "value" "values" "varying" "version"
+"view" "volatile" "whitespace" "without" "work" "wrapper" "write"
+"xmlattributes" "xmlconcat" "xmlelement" "xmlexists" "xmlforest" "xmlparse"
+"xmlpi" "xmlroot" "xmlserialize" "year" "yes" "zone"
)
;; Postgres Reserved
(sql-font-lock-keywords-builder 'font-lock-keyword-face nil
-"all" "analyse" "analyze" "and" "any" "array" "asc" "as" "asymmetric"
+"all" "analyse" "analyze" "and" "array" "asc" "as" "asymmetric"
"authorization" "binary" "both" "case" "cast" "check" "collate"
"column" "concurrently" "constraint" "create" "cross"
"current_catalog" "current_date" "current_role" "current_schema"
"fetch" "foreign" "for" "freeze" "from" "full" "grant" "group"
"having" "ilike" "initially" "inner" "in" "intersect" "into" "isnull"
"is" "join" "leading" "left" "like" "limit" "localtime"
-"localtimestamp" "natural" "notnull" "not" "null" "off" "offset"
+"localtimestamp" "natural" "notnull" "not" "null" "offset"
"only" "on" "order" "or" "outer" "overlaps" "over" "placing" "primary"
"references" "returning" "right" "select" "session_user" "similar"
"some" "symmetric" "table" "then" "to" "trailing" "true" "union"
"unique" "user" "using" "variadic" "verbose" "when" "where" "window"
"with"
+)
+
+ ;; Postgres PL/pgSQL
+ (sql-font-lock-keywords-builder 'font-lock-keyword-face nil
+"assign" "if" "case" "loop" "while" "for" "foreach" "exit" "elsif" "return"
+"raise" "execsql" "dynexecute" "perform" "getdiag" "open" "fetch" "move" "close"
)
;; Postgres Data Types
"bigint" "bigserial" "bit" "bool" "boolean" "box" "bytea" "char"
"character" "cidr" "circle" "date" "decimal" "double" "float4"
"float8" "inet" "int" "int2" "int4" "int8" "integer" "interval" "line"
-"lseg" "macaddr" "money" "numeric" "path" "point" "polygon"
-"precision" "real" "serial" "serial4" "serial8" "smallint" "text"
+"lseg" "macaddr" "money" "name" "numeric" "path" "point" "polygon"
+"precision" "real" "serial" "serial4" "serial8" "sequences" "smallint" "text"
"time" "timestamp" "timestamptz" "timetz" "tsquery" "tsvector"
-"txid_snapshot" "uuid" "varbit" "varchar" "varying" "without"
+"txid_snapshot" "unknown" "uuid" "varbit" "varchar" "varying" "without"
"xml" "zone"
)))
(let ((init (or (and initial (symbol-name initial)) "ansi")))
(intern (completing-read
prompt
- (mapcar (lambda (info) (symbol-name (car info)))
+ (mapcar #'(lambda (info) (symbol-name (car info)))
sql-product-alist)
nil 'require-match
init 'sql-product-history init))))
;; Don't do anything if the product is already supported
(if (assoc product sql-product-alist)
- (message "Product `%s' is already defined" product)
+ (user-error "Product `%s' is already defined" product)
;; Add product to the alist
- (add-to-list 'sql-product-alist `((,product :name ,display . ,plist)))
+ (add-to-list 'sql-product-alist `(,product :name ,display . ,plist))
;; Add a menu item to the SQL->Product menu
(easy-menu-add-item sql-mode-menu '("Product")
;; Each product is represented by a radio
;; after this product's name.
(let ((next-item)
(down-display (downcase display)))
- (map-keymap (lambda (k b)
- (when (and (not next-item)
- (string-lessp down-display
- (downcase (cadr b))))
- (setq next-item k)))
+ (map-keymap #'(lambda (k b)
+ (when (and (not next-item)
+ (string-lessp down-display
+ (downcase (cadr b))))
+ (setq next-item k)))
(easy-menu-get-map sql-mode-menu '("Product")))
next-item))
product))
(symbolp v))
(set v newvalue)
(setcdr p (plist-put (cdr p) feature newvalue)))
- (message "`%s' is not a known product; use `sql-add-product' to add it first." product))))
+ (error "`%s' is not a known product; use `sql-add-product' to add it first." product))))
(defun sql-get-product-feature (product feature &optional fallback not-indirect)
"Lookup FEATURE associated with a SQL PRODUCT.
(symbolp v))
(symbol-value v)
v))
- (message "`%s' is not a known product; use `sql-add-product' to add it first." product)
+ (error "`%s' is not a known product; use `sql-add-product' to add it first." product)
nil)))
(defun sql-product-font-lock (keywords-only imenu)
(font-lock-mode-internal t))
(add-hook 'font-lock-mode-hook
- (lambda ()
- ;; Provide defaults for new font-lock faces.
- (defvar font-lock-builtin-face
- (if (boundp 'font-lock-preprocessor-face)
- font-lock-preprocessor-face
- font-lock-keyword-face))
- (defvar font-lock-doc-face font-lock-string-face))
+ #'(lambda ()
+ ;; Provide defaults for new font-lock faces.
+ (defvar font-lock-builtin-face
+ (if (boundp 'font-lock-preprocessor-face)
+ font-lock-preprocessor-face
+ font-lock-keyword-face))
+ (defvar font-lock-doc-face font-lock-string-face))
nil t)
;; Setup imenu; it needs the same syntax-alist.
(append keywords old-val))))))
(defun sql-for-each-login (login-params body)
- "Iterates through login parameters and returns a list of results."
-
+ "Iterate through login parameters and return a list of results."
(delq nil
(mapcar
- (lambda (param)
- (let ((token (or (and (listp param) (car param)) param))
- (plist (or (and (listp param) (cdr param)) nil)))
-
- (funcall body token plist)))
+ #'(lambda (param)
+ (let ((token (or (car-safe param) param))
+ (plist (cdr-safe param)))
+ (funcall body token plist)))
login-params)))
\f
(defun sql-product-syntax-table ()
(let ((table (copy-syntax-table sql-mode-syntax-table)))
- (mapc (lambda (entry)
- (modify-syntax-entry (car entry) (cdr entry) table))
+ (mapc #'(lambda (entry)
+ (modify-syntax-entry (car entry) (cdr entry) table))
(sql-get-product-feature sql-product :syntax-alist))
table))
(append
;; Change all symbol character to word characters
(mapcar
- (lambda (entry) (if (string= (substring (cdr entry) 0 1) "_")
- (cons (car entry)
- (concat "w" (substring (cdr entry) 1)))
- entry))
+ #'(lambda (entry) (if (string= (substring (cdr entry) 0 1) "_")
+ (cons (car entry)
+ (concat "w" (substring (cdr entry) 1)))
+ entry))
(sql-get-product-feature sql-product :syntax-alist))
'((?_ . "w"))))
(list (sql-read-product "SQL product: ")))
(if (stringp product) (setq product (intern product)))
(when (not (assoc product sql-product-alist))
- (error "SQL product %s is not supported; treated as ANSI" product)
+ (user-error "SQL product %s is not supported; treated as ANSI" product)
(setq product 'ansi))
;; Save product setting and fontify.
local variable."
(save-excursion (comint-bol nil) (point))))
+;;; SMIE support
+
+;; Needs a lot more love than I can provide. --Stef
+
+;; (require 'smie)
+
+;; (defconst sql-smie-grammar
+;; (smie-prec2->grammar
+;; (smie-bnf->prec2
+;; ;; Partly based on http://www.h2database.com/html/grammar.html
+;; '((cmd ("SELECT" select-exp "FROM" select-table-exp)
+;; )
+;; (select-exp ("*") (exp) (exp "AS" column-alias))
+;; (column-alias)
+;; (select-table-exp (table-exp "WHERE" exp) (table-exp))
+;; (table-exp)
+;; (exp ("CASE" exp "WHEN" exp "THEN" exp "ELSE" exp "END")
+;; ("CASE" exp "WHEN" exp "THEN" exp "END"))
+;; ;; Random ad-hoc additions.
+;; (foo (foo "," foo))
+;; )
+;; '((assoc ",")))))
+
+;; (defun sql-smie-rules (kind token)
+;; (pcase (cons kind token)
+;; (`(:list-intro . ,_) t)
+;; (`(:before . "(") (smie-rule-parent))))
+
;;; Motion Functions
(defun sql-statement-regexp (prod)
"\\>")))
(defun sql-beginning-of-statement (arg)
- "Moves the cursor to the beginning of the current SQL statement."
+ "Move to the beginning of the current SQL statement."
(interactive "p")
(let ((here (point))
(beginning-of-line)
;; If we didn't move, try again
(when (= here (point))
- (sql-beginning-of-statement (* 2 (sql-signum arg))))))
+ (sql-beginning-of-statement (* 2 (cl-signum arg))))))
(defun sql-end-of-statement (arg)
- "Moves the cursor to the end of the current SQL statement."
+ "Move to the end of the current SQL statement."
(interactive "p")
(let ((term (sql-get-product-feature sql-product :terminator))
(re-search (if (> 0 arg) 're-search-backward 're-search-forward))
(when (consp term)
(setq term (car term)))
;; Iterate until we've moved the desired number of stmt ends
- (while (not (= (sql-signum arg) 0))
+ (while (not (= (cl-signum arg) 0))
;; if we're looking at the terminator, jump by 2
(if (or (and (> 0 arg) (looking-back term))
(and (< 0 arg) (looking-at term)))
(setq arg 0)
;; count it if we're not in a comment
(unless (nth 7 (syntax-ppss))
- (setq arg (- arg (sql-signum arg))))))
+ (setq arg (- arg (cl-signum arg))))))
(goto-char (if (match-data)
(match-end 0)
here))))
(comint-bol nil)
(looking-at "go\\b")))
(comint-send-input)))
+(put 'sql-magic-go 'delete-selection t)
(defun sql-magic-semicolon (arg)
"Insert semicolon and call `comint-send-input'.
(self-insert-command (prefix-numeric-value arg))
(if (equal sql-electric-stuff 'semicolon)
(comint-send-input)))
+(put 'sql-magic-semicolon 'delete-selection t)
(defun sql-accumulate-and-indent ()
"Continue SQL statement on the next line."
"]\n"))))
doc))
-;;;###autoload
-(eval
- ;; FIXME: This dynamic-docstring-function trick doesn't work for byte-compiled
- ;; functions, because of the lazy-loading of docstrings, which strips away
- ;; text properties.
- '(defun sql-help ()
- #("Show short help for the SQL modes.
+(defun sql-help ()
+ "Show short help for the SQL modes."
+ (interactive)
+ (describe-function 'sql-help))
+(put 'sql-help 'function-documentation '(sql--make-help-docstring))
+(defvar sql--help-docstring
+ "Show short help for the SQL modes.
Use an entry function to open an interactive SQL buffer. This buffer is
usually named `*SQL*'. The name of the major mode is SQLi.
In this SQL buffer (SQL mode), you can send the region or the entire
buffer to the interactive SQL buffer (SQLi mode). The results are
-appended to the SQLi buffer without disturbing your SQL buffer."
- 0 1 (dynamic-docstring-function sql--make-help-docstring))
- (interactive)
- (describe-function 'sql-help)))
-
-(defun sql--make-help-docstring (doc _fun)
- "Insert references to loaded products into the help buffer string."
-
- ;; Insert FREE software list
- (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]FREE\\s-*\n" doc 0)
- (setq doc (replace-match (sql-help-list-products (match-string 1 doc) t)
- t t doc 0)))
+appended to the SQLi buffer without disturbing your SQL buffer.")
+
+(defun sql--make-help-docstring ()
+ "Return a docstring for `sql-help' listing loaded SQL products."
+ (let ((doc sql--help-docstring))
+ ;; Insert FREE software list
+ (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]FREE\\s-*$" doc 0)
+ (setq doc (replace-match (sql-help-list-products (match-string 1 doc) t)
+ t t doc 0)))
+ ;; Insert non-FREE software list
+ (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]NONFREE\\s-*$" doc 0)
+ (setq doc (replace-match (sql-help-list-products (match-string 1 doc) nil)
+ t t doc 0)))
+ doc))
- ;; Insert non-FREE software list
- (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]NONFREE\\s-*\n" doc 0)
- (setq doc (replace-match (sql-help-list-products (match-string 1 doc) nil)
- t t doc 0)))
- doc)
+(defun sql-default-value (var)
+ "Fetch the value of a variable.
-(defun sql-read-passwd (prompt &optional default)
- "Read a password using PROMPT. Optional DEFAULT is password to start with."
- (read-passwd prompt nil default))
+If the current buffer is in `sql-interactive-mode', then fetch
+the global value, otherwise use the buffer local value."
+ (if (derived-mode-p 'sql-interactive-mode)
+ (default-value var)
+ (buffer-local-value var (current-buffer))))
(defun sql-get-login-ext (symbol prompt history-var plist)
"Prompt user with extended login parameters.
(set-default
symbol
(let* ((default (plist-get plist :default))
- (last-value (default-value symbol))
+ (last-value (sql-default-value symbol))
(prompt-def
(if default
(if (string-match "\\(\\):[ \t]*\\'" prompt)
(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)))))))
+ (read-string prompt-def last-value history-var default))))))
(defun sql-get-login (&rest what)
"Get username, password and database from the user.
In order to ask the user for username, password and database, call the
function like this: (sql-get-login 'user 'password 'database)."
- (interactive)
- (mapcar
- (lambda (w)
- (let ((token (or (and (consp w) (car w)) w))
- (plist (or (and (consp w) (cdr w)) nil)))
-
- (cond
- ((eq token 'user) ; user
- (sql-get-login-ext 'sql-user "User: " 'sql-user-history plist))
+ (dolist (w what)
+ (let ((plist (cdr-safe w)))
+ (pcase (or (car-safe w) w)
+ (`user
+ (sql-get-login-ext 'sql-user "User: " 'sql-user-history plist))
- ((eq token 'password) ; password
- (setq-default sql-password
- (sql-read-passwd "Password: " sql-password)))
+ (`password
+ (setq-default sql-password
+ (read-passwd "Password: " nil (sql-default-value 'sql-password))))
- ((eq token 'server) ; server
- (sql-get-login-ext 'sql-server "Server: " 'sql-server-history plist))
+ (`server
+ (sql-get-login-ext 'sql-server "Server: " 'sql-server-history plist))
- ((eq token 'database) ; database
- (sql-get-login-ext 'sql-database "Database: " 'sql-database-history plist))
+ (`database
+ (sql-get-login-ext 'sql-database "Database: "
+ 'sql-database-history plist))
- ((eq token 'port) ; port
- (sql-get-login-ext 'sql-port "Port: " nil (append '(:number t) plist))))))
- what))
+ (`port
+ (sql-get-login-ext 'sql-port "Port: "
+ nil (append '(:number t) plist)))))))
(defun sql-find-sqli-buffer (&optional product connection)
- "Returns the name of the current default SQLi buffer or nil.
+ "Return the name of the current default SQLi buffer or nil.
In order to qualify, the SQLi buffer must be alive, be in
`sql-interactive-mode' and have a process."
(let ((buf sql-buffer)
(sql-buffer-live-p buf prod connection)
buf)
;; Look thru each buffer
- (car (apply 'append
- (mapcar (lambda (b)
- (and (sql-buffer-live-p b prod connection)
- (list (buffer-name b))))
+ (car (apply #'append
+ (mapcar #'(lambda (b)
+ (and (sql-buffer-live-p b prod connection)
+ (list (buffer-name b))))
(buffer-list)))))))
(defun sql-set-sqli-buffer-generally ()
(interactive)
(let ((default-buffer (sql-find-sqli-buffer)))
(if (null default-buffer)
- (error "There is no suitable SQLi buffer")
+ (user-error "There is no suitable SQLi buffer")
(let ((new-buffer (read-buffer "New SQLi buffer: " default-buffer t)))
(if (null (sql-buffer-live-p new-buffer))
- (error "Buffer %s is not a working SQLi buffer" new-buffer)
+ (user-error "Buffer %s is not a working SQLi buffer" new-buffer)
(when new-buffer
(setq sql-buffer new-buffer)
(run-hooks 'sql-set-sqli-hook)))))))
(interactive)
(if (or (null sql-buffer)
(null (buffer-live-p (get-buffer sql-buffer))))
- (message "%s has no SQLi buffer set." (buffer-name (current-buffer)))
+ (user-error "%s has no SQLi buffer set" (buffer-name (current-buffer)))
(if (null (get-buffer-process sql-buffer))
- (message "Buffer %s has no process." sql-buffer)
- (message "Current SQLi buffer is %s." sql-buffer))))
+ (user-error "Buffer %s has no process" sql-buffer)
+ (user-error "Current SQLi buffer is %s" sql-buffer))))
(defun sql-make-alternate-buffer-name ()
"Return a string that can be used to rename a SQLi buffer.
;; Build a name using the :sqli-login setting
(setq name
- (apply 'concat
+ (apply #'concat
(cdr
- (apply 'append nil
+ (apply #'append nil
(sql-for-each-login
(sql-get-product-feature sql-product :sqli-login)
- (lambda (token plist)
- (cond
- ((eq token 'user)
- (unless (string= "" sql-user)
- (list "/" sql-user)))
- ((eq token 'port)
- (unless (or (not (numberp sql-port))
- (= 0 sql-port))
- (list ":" (number-to-string sql-port))))
- ((eq token 'server)
- (unless (string= "" sql-server)
- (list "."
- (if (plist-member plist :file)
- (file-name-nondirectory sql-server)
- sql-server))))
- ((eq token 'database)
- (unless (string= "" sql-database)
- (list "@"
- (if (plist-member plist :file)
- (file-name-nondirectory sql-database)
- sql-database))))
-
- ((eq token 'password) nil)
- (t nil))))))))
+ #'(lambda (token plist)
+ (pcase token
+ (`user
+ (unless (string= "" sql-user)
+ (list "/" sql-user)))
+ (`port
+ (unless (or (not (numberp sql-port))
+ (= 0 sql-port))
+ (list ":" (number-to-string sql-port))))
+ (`server
+ (unless (string= "" sql-server)
+ (list "."
+ (if (plist-member plist :file)
+ (file-name-nondirectory sql-server)
+ sql-server))))
+ (`database
+ (unless (string= "" sql-database)
+ (list "@"
+ (if (plist-member plist :file)
+ (file-name-nondirectory sql-database)
+ sql-database))))
+
+ ;; (`password nil)
+ (_ nil))))))))
;; If there's a connection, use it and the name thus far
(if sql-connection
(interactive "P")
(if (not (derived-mode-p 'sql-interactive-mode))
- (message "Current buffer is not a SQL interactive buffer")
+ (user-error "Current buffer is not a SQL interactive buffer")
(setq sql-alternate-buffer-name
(cond
sql-alternate-buffer-name))
(t sql-alternate-buffer-name)))
+ (setq sql-alternate-buffer-name (substring-no-properties sql-alternate-buffer-name))
(rename-buffer (if (string= "" sql-alternate-buffer-name)
"*SQL*"
(format "*SQL: %s*" sql-alternate-buffer-name))
Placeholders are words starting with an ampersand like &this."
(when sql-oracle-scan-on
- (while (string-match "&\\(\\sw+\\)" string)
+ (while (string-match "&?&\\(\\(?:\\sw\\|\\s_\\)+\\)[.]?" string)
(setq string (replace-match
(read-from-minibuffer
(format "Enter value for %s: " (match-string 1 string))
Allows the suppression of continuation prompts.")
-(defvar sql-output-by-send nil
- "Non-nil if the command in the input was generated by `sql-send-string'.")
-
(defun sql-input-sender (proc string)
"Send STRING to PROC after applying filters."
- (let* ((product (with-current-buffer (process-buffer proc) sql-product))
+ (let* ((product (buffer-local-value 'sql-product (process-buffer proc)))
(filter (sql-get-product-feature product :input-filter)))
;; Apply filter(s)
((functionp filter)
(setq string (funcall filter string)))
((listp filter)
- (mapc (lambda (f) (setq string (funcall f string))) filter))
+ (mapc #'(lambda (f) (setq string (funcall f string))) filter))
(t nil))
;; Count how many newlines in the string
- (setq sql-output-newline-count 0)
- (mapc (lambda (ch)
- (when (eq ch ?\n)
- (setq sql-output-newline-count (1+ sql-output-newline-count))))
- string)
+ (setq sql-output-newline-count
+ (apply #'+ (mapcar #'(lambda (ch)
+ (if (eq ch ?\n) 1 0)) string)))
;; Send the string
(comint-simple-send proc string)))
(defvar sql-preoutput-hold nil)
+(defun sql-starts-with-prompt-re ()
+ "Anchor the prompt expression at the beginning of the output line.
+Remove the start of line regexp."
+ (replace-regexp-in-string "\\^" "\\\\`" comint-prompt-regexp))
+
+(defun sql-ends-with-prompt-re ()
+ "Anchor the prompt expression at the end of the output line.
+Remove the start of line regexp from the prompt expression since
+it may not follow newline characters in the output line."
+ (concat (replace-regexp-in-string "\\^" "" sql-prompt-regexp) "\\'"))
+
(defun sql-interactive-remove-continuation-prompt (oline)
"Strip out continuation prompts out of the OLINE.
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)
+ (when comint-prompt-regexp
+ (save-match-data
+ (let (prompt-found last-nl)
- (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))
+ ;; Add this text to what's left from the last pass
+ (setq oline (concat sql-preoutput-hold oline)
+ sql-preoutput-hold "")
+ ;; If we are looking for multiple prompts
+ (when (and (integerp sql-output-newline-count)
+ (>= sql-output-newline-count 1))
+ ;; Loop thru each starting prompt and remove it
+ (let ((start-re (sql-starts-with-prompt-re)))
+ (while (and (not (string= oline ""))
+ (> sql-output-newline-count 0)
+ (string-match start-re oline))
+ (setq oline (replace-match "" nil nil oline)
+ sql-output-newline-count (1- sql-output-newline-count)
+ prompt-found t)))
+
+ ;; If we've found all the expected prompts, stop looking
(if (= sql-output-newline-count 0)
(setq sql-output-newline-count nil
- oline (concat "\n" oline)
- sql-output-by-send nil)
+ oline (concat "\n" oline))
+ ;; Still more possible prompts, leave them for the next pass
(setq sql-preoutput-hold oline
- oline ""))
-
- (unless did-filter
- (setq oline (or sql-preoutput-hold "")
- sql-preoutput-hold nil
- sql-output-newline-count nil)))
-
- (setq sql-output-newline-count nil))
-
- oline))
+ oline "")))
+
+ ;; If no prompts were found, stop looking
+ (unless prompt-found
+ (setq sql-output-newline-count nil
+ oline (concat oline sql-preoutput-hold)
+ sql-preoutput-hold ""))
+
+ ;; Break up output by physical lines if we haven't hit the final prompt
+ (unless (and (not (string= oline ""))
+ (string-match (sql-ends-with-prompt-re) oline)
+ (>= (match-end 0) (length oline)))
+ (setq last-nl 0)
+ (while (string-match "\n" oline last-nl)
+ (setq last-nl (match-end 0)))
+ (setq sql-preoutput-hold (concat (substring oline last-nl)
+ sql-preoutput-hold)
+ oline (substring oline 0 last-nl))))))
+ oline)
;;; Sending the region to the SQLi buffer.
(if sql-send-terminator
(sql-send-magic-terminator sql-buffer s sql-send-terminator))
- (message "Sent string to buffer %s." sql-buffer)))
+ (message "Sent string to buffer %s" sql-buffer)))
;; Display the sql buffer
(if sql-pop-to-buffer-after-send-region
(display-buffer sql-buffer)))
;; We don't have no stinkin' sql
- (message "No SQL process started."))))
+ (user-error "No SQL process started"))))
(defun sql-send-region (start end)
"Send a region to the SQL process."
(setq sql-output-newline-count
(if sql-output-newline-count
(1+ sql-output-newline-count)
- 1)))
- (setq sql-output-by-send t)))
+ 1)))))
(defun sql-remove-tabs-filter (str)
"Replace tab characters with spaces."
(when visible
(message "Executing SQL command..."))
(if (consp command)
- (mapc (lambda (c) (sql-redirect-one sqlbuf c outbuf save-prior))
+ (mapc #'(lambda (c) (sql-redirect-one sqlbuf c outbuf save-prior))
command)
(sql-redirect-one sqlbuf command outbuf save-prior))
(when visible
:prompt-regexp))
(start nil))
(with-current-buffer buf
- (setq view-read-only nil)
+ (setq-local view-no-disable-on-exit t)
+ (read-only-mode -1)
(unless save-prior
(erase-buffer))
(goto-char (point-max))
(match-string regexp-groups))
;; list of numbers; return the specified matches only
((consp regexp-groups)
- (mapcar (lambda (c)
- (cond
- ((numberp c) (match-string c))
- ((stringp c) (match-substitute-replacement c))
- (t (error "sql-redirect-value: unknown REGEXP-GROUPS value - %s" c))))
+ (mapcar #'(lambda (c)
+ (cond
+ ((numberp c) (match-string c))
+ ((stringp c) (match-substitute-replacement c))
+ (t (error "sql-redirect-value: unknown REGEXP-GROUPS value - %s" c))))
regexp-groups))
;; String is specified; return replacement string
((stringp regexp-groups)
(nreverse results)))
(defun sql-execute (sqlbuf outbuf command enhanced arg)
- "Executes a command in a SQL interactive buffer and captures the output.
+ "Execute a command in a SQL interactive buffer and capture the output.
The commands are run in SQLBUF and the output saved in OUTBUF.
COMMAND must be a string, a function or a list of such elements.
strings are formatted with ARG and executed.
If the results are empty the OUTBUF is deleted, otherwise the
-buffer is popped into a view window. "
+buffer is popped into a view window."
(mapc
- (lambda (c)
- (cond
- ((stringp c)
- (sql-redirect sqlbuf (if arg (format c arg) c) outbuf) t)
- ((functionp c)
- (apply c sqlbuf outbuf enhanced arg nil))
- (t (error "Unknown sql-execute item %s" c))))
+ #'(lambda (c)
+ (cond
+ ((stringp c)
+ (sql-redirect sqlbuf (if arg (format c arg) c) outbuf) t)
+ ((functionp c)
+ (apply c sqlbuf outbuf enhanced arg nil))
+ (t (error "Unknown sql-execute item %s" c))))
(if (consp command) command (cons command nil)))
-
+
(setq outbuf (get-buffer outbuf))
(if (zerop (buffer-size outbuf))
(kill-buffer outbuf)
(get-lru-window))))
(with-current-buffer outbuf
(set-buffer-modified-p nil)
- (setq view-read-only t))
- (view-buffer-other-window outbuf)
+ (read-only-mode +1))
+ (pop-to-buffer outbuf)
(when one-win
(shrink-window-if-larger-than-buffer)))))
(defun sql-execute-feature (sqlbuf outbuf feature enhanced arg)
"List objects or details in a separate display buffer."
- (let (command)
- (with-current-buffer sqlbuf
- (setq command (sql-get-product-feature sql-product feature)))
+ (let (command
+ (product (buffer-local-value 'sql-product (get-buffer sqlbuf))))
+ (setq command (sql-get-product-feature product feature))
(unless command
- (error "%s does not support %s" sql-product feature))
+ (error "%s does not support %s" product feature))
(when (consp command)
(setq command (if enhanced
(cdr command)
(apply f (current-buffer) (cons schema nil)))
cl)
(unless (member e cl) (setq cl (cons e cl))))
- (sort cl (function string<)))))))
+ (sort cl #'string<))))))
(defun sql-build-completions (schema)
"Generate a list of names in the database for use as completions."
(defvar sql-completion-sqlbuf nil)
-(defun sql-try-completion (string collection &optional predicate)
+(defun sql--completion-table (string pred action)
(when sql-completion-sqlbuf
- (with-current-buffer sql-completion-sqlbuf
- (let ((schema (and (string-match "\\`\\(\\sw\\(:?\\sw\\|\\s_\\)*\\)[.]" string)
- (downcase (match-string 1 string)))))
-
- ;; If we haven't loaded any object name yet, load local schema
- (unless sql-completion-object
- (sql-build-completions nil))
-
- ;; If they want another schema, load it if we haven't yet
- (when schema
- (let ((schema-dot (concat schema "."))
- (schema-len (1+ (length schema)))
- (names sql-completion-object)
- has-schema)
-
- (while (and (not has-schema) names)
- (setq has-schema (and
- (>= (length (car names)) schema-len)
- (string= schema-dot
- (downcase (substring (car names)
- 0 schema-len))))
- names (cdr names)))
- (unless has-schema
- (sql-build-completions schema)))))
-
- ;; Try to find the completion
- (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)))))))
+ (with-current-buffer sql-completion-sqlbuf
+ (let ((schema (and (string-match "\\`\\(\\sw\\(:?\\sw\\|\\s_\\)*\\)[.]" string)
+ (downcase (match-string 1 string)))))
+
+ ;; If we haven't loaded any object name yet, load local schema
+ (unless sql-completion-object
+ (sql-build-completions nil))
+
+ ;; If they want another schema, load it if we haven't yet
+ (when schema
+ (let ((schema-dot (concat schema "."))
+ (schema-len (1+ (length schema)))
+ (names sql-completion-object)
+ has-schema)
+
+ (while (and (not has-schema) names)
+ (setq has-schema (and
+ (>= (length (car names)) schema-len)
+ (string= schema-dot
+ (downcase (substring (car names)
+ 0 schema-len))))
+ names (cdr names)))
+ (unless has-schema
+ (sql-build-completions schema)))))
+
+ ;; Try to find the completion
+ (complete-with-action action sql-completion-object string pred))))
(defun sql-read-table-name (prompt)
"Read the name of a database table."
(buffer-substring-no-properties (match-beginning 0)
(match-end 0))))
(sql-completion-sqlbuf (sql-find-sqli-buffer))
- (product (with-current-buffer sql-completion-sqlbuf sql-product))
+ (product (when sql-completion-sqlbuf
+ (with-current-buffer sql-completion-sqlbuf sql-product)))
(completion-ignore-case t))
- (if (sql-get-product-feature product :completion-object)
- (completing-read prompt (function sql-try-completion)
- nil nil tname)
- (read-from-minibuffer prompt tname))))
+ (if product
+ (if (sql-get-product-feature product :completion-object)
+ (completing-read prompt #'sql--completion-table
+ nil nil tname)
+ (read-from-minibuffer prompt tname))
+ (user-error "There is no active SQLi buffer"))))
(defun sql-list-all (&optional enhanced)
"List all database objects.
(interactive "P")
(let ((sqlbuf (sql-find-sqli-buffer)))
(unless sqlbuf
- (error "No SQL interactive buffer found"))
+ (user-error "No SQL interactive buffer found"))
(sql-execute-feature sqlbuf "*List All*" :list-all enhanced nil)
(with-current-buffer sqlbuf
;; Contains the name of database objects
current-prefix-arg))
(let ((sqlbuf (sql-find-sqli-buffer)))
(unless sqlbuf
- (error "No SQL interactive buffer found"))
+ (user-error "No SQL interactive buffer found"))
(unless name
- (error "No table name specified"))
+ (user-error "No table name specified"))
(sql-execute-feature sqlbuf (format "*List %s*" name)
:list-table enhanced name)))
\f
(if sql-mode-menu
(easy-menu-add sql-mode-menu)); XEmacs
+ ;; (smie-setup sql-smie-grammar #'sql-smie-rules)
(set (make-local-variable 'comment-start) "--")
;; Make each buffer in sql-mode remember the "current" SQLi buffer.
(make-local-variable 'sql-buffer)
(set (make-local-variable 'paragraph-separate) "[\f]*$")
(set (make-local-variable 'paragraph-start) "[\n\f]")
;; Abbrevs
- (setq abbrev-all-caps 1)
+ (setq-local abbrev-all-caps 1)
;; Contains the name of database objects
(set (make-local-variable 'sql-contains-names) t)
+ ;; Set syntax and font-face highlighting
;; Catch changes to sql-product and highlight accordingly
+ (sql-set-product (or sql-product 'ansi)) ; Fixes bug#13591
(add-hook 'hack-local-variables-hook 'sql-highlight-product t t))
\f
(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)
;; People wanting a different history file for each
;; buffer/process/client/whatever can change separator and file-name
;; on the sql-interactive-mode-hook.
- (setq comint-input-ring-separator sql-input-ring-separator
- comint-input-ring-file-name sql-input-ring-file-name)
+ (setq-local comint-input-ring-separator sql-input-ring-separator)
+ (setq comint-input-ring-file-name sql-input-ring-file-name)
;; Calling the hook before calling comint-read-input-ring allows users
;; to set comint-input-ring-file-name in sql-interactive-mode-hook.
(comint-read-input-ring t))
"Read a connection name."
(let ((completion-ignore-case t))
(completing-read prompt
- (mapcar (lambda (c) (car c))
+ (mapcar #'(lambda (c) (car c))
sql-connection-alist)
nil t initial 'sql-connection-history default)))
(if sql-connection-alist
(list (sql-read-connection "Connection: " nil '(nil))
current-prefix-arg)
- nil))
+ (user-error "No SQL Connections defined")))
;; Are there connections defined
(if sql-connection-alist
;; Was one selected
(when connection
;; Get connection settings
- (let ((connect-set (assoc connection sql-connection-alist)))
+ (let ((connect-set (assoc-string connection sql-connection-alist t)))
;; Settings are defined
(if connect-set
;; Set the desired parameters
;; Params in the connection
(setq set-params
(mapcar
- (lambda (v)
- (cond
- ((eq (car v) 'sql-user) 'user)
- ((eq (car v) 'sql-password) 'password)
- ((eq (car v) 'sql-server) 'server)
- ((eq (car v) 'sql-database) 'database)
- ((eq (car v) 'sql-port) 'port)
- (t (car v))))
+ #'(lambda (v)
+ (pcase (car v)
+ (`sql-user 'user)
+ (`sql-password 'password)
+ (`sql-server 'server)
+ (`sql-database 'database)
+ (`sql-port 'port)
+ (s s)))
(cdr connect-set)))
;; the remaining params (w/o the connection params)
(setq rem-params
(sql-for-each-login login-params
- (lambda (token plist)
- (unless (member token set-params)
- (if plist (cons token plist) token)))))
+ #'(lambda (token plist)
+ (unless (member token set-params)
+ (if plist (cons token plist) token)))))
;; Set the parameters and start the interactive session
(mapc
- (lambda (vv)
- (set-default (car vv) (eval (cadr vv))))
+ #'(lambda (vv)
+ (set-default (car vv) (eval (cadr vv))))
(cdr connect-set))
(setq-default sql-connection connection)
;; Start the SQLi session with revised list of login parameters
(eval `(let ((,param-var ',rem-params))
- (sql-product-interactive sql-product new-name))))
+ (sql-product-interactive ',sql-product ',new-name))))
- (message "SQL Connection <%s> does not exist" connection)
+ (user-error "SQL Connection <%s> does not exist" connection)
nil)))
- (message "No SQL Connections defined")
+ (user-error "No SQL Connections defined")
nil))
(defun sql-save-connection (name)
(interactive "sNew connection name: ")
(unless (derived-mode-p 'sql-interactive-mode)
- (error "Not in a SQL interactive mode!"))
+ (user-error "Not in a SQL interactive mode!"))
;; Capture the buffer local settings
(let* ((buf (current-buffer))
;; Add the new connection if it doesn't exist
(if (assoc name alist)
- (message "Connection <%s> already exists" name)
+ (user-error "Connection <%s> already exists" name)
(setq connect
- (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)))))))
+ (cons name
+ (sql-for-each-login
+ `(product ,@login)
+ #'(lambda (token _plist)
+ (pcase token
+ (`product `(sql-product ',product))
+ (`user `(sql-user ,user))
+ (`database `(sql-database ,database))
+ (`server `(sql-server ,server))
+ (`port `(sql-port ,port)))))))
(setq alist (append alist (list connect)))
(customize-set-variable 'sql-connection-alist alist)))))))
(defun sql-connection-menu-filter (tail)
- "Generates menu entries for using each connection."
+ "Generate menu entries for using each connection."
(append
(mapcar
- (lambda (conn)
- (vector
- (format "Connection <%s>\t%s" (car conn)
- (let ((sql-user "") (sql-database "")
- (sql-server "") (sql-port 0))
- (eval `(let ,(cdr conn) (sql-make-alternate-buffer-name)))))
- (list 'sql-connect (car conn))
- t))
+ #'(lambda (conn)
+ (vector
+ (format "Connection <%s>\t%s" (car conn)
+ (let ((sql-user "") (sql-database "")
+ (sql-server "") (sql-port 0))
+ (eval `(let ,(cdr conn) (sql-make-alternate-buffer-name)))))
+ (list 'sql-connect (car conn))
+ t))
sql-connection-alist)
tail))
\f
;;; Entry functions for different SQL interpreters.
-
;;;###autoload
(defun sql-product-interactive (&optional product new-name)
"Run PRODUCT interpreter as an inferior process.
;; We have a new name or sql-buffer doesn't exist or match
;; Start by remembering where we start
(let ((start-buffer (current-buffer))
- new-sqli-buffer)
+ new-sqli-buffer rpt)
;; Get credentials.
- (apply 'sql-get-login (sql-get-product-feature product :sqli-login))
+ (apply #'sql-get-login
+ (sql-get-product-feature product :sqli-login))
;; Connect to database.
- (message "Login...")
+ (setq rpt (make-progress-reporter "Login"))
+
(let ((sql-user (default-value 'sql-user))
(sql-password (default-value 'sql-password))
(sql-server (default-value 'sql-server))
(setq sql-buffer (buffer-name new-sqli-buffer))
(run-hooks 'sql-set-sqli-hook)))
+ ;; Make sure the connection is complete
+ ;; (Sometimes start up can be slow)
+ ;; and call the login hook
+ (let ((proc (get-buffer-process new-sqli-buffer))
+ (secs sql-login-delay)
+ (step 0.3))
+ (while (and (memq (process-status proc) '(open run))
+ (or (accept-process-output proc step)
+ (<= 0.0 (setq secs (- secs step))))
+ (progn (goto-char (point-max))
+ (not (re-search-backward sql-prompt-regexp 0 t))))
+ (progress-reporter-update rpt)))
+
+ (goto-char (point-max))
+ (when (re-search-backward sql-prompt-regexp nil t)
+ (run-hooks 'sql-login-hook))
+
;; All done.
- (message "Login...done")
- (run-hooks 'sql-login-hook)
- (pop-to-buffer new-sqli-buffer)))))
- (message "No default SQL product defined. Set `sql-product'.")))
+ (progress-reporter-done rpt)
+ (pop-to-buffer new-sqli-buffer)
+ (goto-char (point-max))
+ (current-buffer)))))
+ (user-error "No default SQL product defined. Set `sql-product'.")))
(defun sql-comint (product params)
"Set up a comint buffer to run the SQL processor.
(setq buf-name (format "SQL-%s%d" product i))))
(setq i (1+ i))))))
(set-buffer
- (apply 'make-comint buf-name program nil params))))
+ (apply #'make-comint buf-name program nil params))))
;;;###autoload
(defun sql-oracle (&optional buffer)
;; is meaningless; database without user/password is meaningless,
;; because "@param" will ask sqlplus to interpret the script
;; "param".
- (let ((parameter nil))
+ (let (parameter nlslang coding)
(if (not (string= "" sql-user))
(if (not (string= "" sql-password))
(setq parameter (concat sql-user "/" sql-password))
(setq parameter sql-user)))
(if (and parameter (not (string= "" sql-database)))
(setq parameter (concat parameter "@" sql-database)))
+ ;; options must appear before the logon parameters
(if parameter
- (setq parameter (nconc (list parameter) options))
+ (setq parameter (append options (list parameter)))
(setq parameter options))
- (sql-comint product parameter)))
+ (sql-comint product parameter)
+ ;; Set process coding system to agree with the interpreter
+ (setq nlslang (or (getenv "NLS_LANG") "")
+ coding (dolist (cs
+ ;; Are we missing any common NLS character sets
+ '(("US8PC437" . cp437)
+ ("EL8PC737" . cp737)
+ ("WE8PC850" . cp850)
+ ("EE8PC852" . cp852)
+ ("TR8PC857" . cp857)
+ ("WE8PC858" . cp858)
+ ("IS8PC861" . cp861)
+ ("IW8PC1507" . cp862)
+ ("N8PC865" . cp865)
+ ("RU8PC866" . cp866)
+ ("US7ASCII" . us-ascii)
+ ("UTF8" . utf-8)
+ ("AL32UTF8" . utf-8)
+ ("AL16UTF16" . utf-16))
+ (or coding 'utf-8))
+ (when (string-match (format "\\.%s\\'" (car cs)) nlslang)
+ (setq coding (cdr cs)))))
+ (set-buffer-process-coding-system coding coding)))
(defun sql-oracle-save-settings (sqlbuf)
- "Saves most SQL*Plus settings so they may be reset by \\[sql-redirect]."
+ "Save most SQL*Plus settings so they may be reset by \\[sql-redirect]."
;; Note: does not capture the following settings:
;;
;; APPINFO
;;
(append
- ;; (apply 'concat (append
+ ;; (apply #'concat (append
;; '("SET")
;; option value...
;; Remove any settings that haven't changed
(mapc
- (lambda (one-cur-setting)
- (setq saved-settings (delete one-cur-setting saved-settings)))
+ #'(lambda (one-cur-setting)
+ (setq saved-settings (delete one-cur-setting saved-settings)))
(sql-oracle-save-settings sqlbuf))
;; Restore the changed settings
(sql-redirect sqlbuf saved-settings))
-(defun sql-oracle-list-all (sqlbuf outbuf enhanced table-name)
+(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
(sql-oracle-restore-settings sqlbuf settings)))
-(defun sql-oracle-list-table (sqlbuf outbuf enhanced table-name)
+(defun sql-oracle-list-table (sqlbuf outbuf _enhanced table-name)
"Implements :list-table under Oracle."
(let ((settings (sql-oracle-save-settings sqlbuf)))
"Create comint buffer and connect to Sybase."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
- (let ((params options))
- (if (not (string= "" sql-server))
- (setq params (append (list "-S" sql-server) params)))
- (if (not (string= "" sql-database))
- (setq params (append (list "-D" sql-database) params)))
- (if (not (string= "" sql-password))
- (setq params (append (list "-P" sql-password) params)))
- (if (not (string= "" sql-user))
- (setq params (append (list "-U" sql-user) params)))
+ (let ((params
+ (append
+ (if (not (string= "" sql-user))
+ (list "-U" sql-user))
+ (if (not (string= "" sql-password))
+ (list "-P" sql-password))
+ (if (not (string= "" sql-database))
+ (list "-D" sql-database))
+ (if (not (string= "" sql-server))
+ (list "-S" sql-server))
+ options)))
(sql-comint product params)))
\f
"Create comint buffer and connect to SQLite."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
- (let ((params))
- (if (not (string= "" sql-database))
- (setq params (append (list (expand-file-name sql-database))
- params)))
- (setq params (append options params))
+ (let ((params
+ (append options
+ (if (not (string= "" sql-database))
+ `(,(expand-file-name sql-database))))))
(sql-comint product params)))
-(defun sql-sqlite-completion-object (sqlbuf schema)
+(defun sql-sqlite-completion-object (sqlbuf _schema)
(sql-redirect-value sqlbuf ".tables" "\\sw\\(?:\\sw\\|\\s_\\)*" 0))
\f
"Create comint buffer and connect to MySQL."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
- (let ((params))
- (if (not (string= "" sql-database))
- (setq params (append (list sql-database) params)))
- (if (not (string= "" sql-server))
- (setq params (append (list (concat "--host=" sql-server)) params)))
- (if (not (= 0 sql-port))
- (setq params (append (list (concat "--port=" (number-to-string sql-port))) params)))
- (if (not (string= "" sql-password))
- (setq params (append (list (concat "--password=" sql-password)) params)))
- (if (not (string= "" sql-user))
- (setq params (append (list (concat "--user=" sql-user)) params)))
- (setq params (append options params))
+ (let ((params
+ (append
+ options
+ (if (not (string= "" sql-user))
+ (list (concat "--user=" sql-user)))
+ (if (not (string= "" sql-password))
+ (list (concat "--password=" sql-password)))
+ (if (not (= 0 sql-port))
+ (list (concat "--port=" (number-to-string sql-port))))
+ (if (not (string= "" sql-server))
+ (list (concat "--host=" sql-server)))
+ (if (not (string= "" sql-database))
+ (list sql-database)))))
(sql-comint product params)))
\f
"Create comint buffer and connect to Solid."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
- (let ((params options))
- ;; It only makes sense if both username and password are there.
- (if (not (or (string= "" sql-user)
- (string= "" sql-password)))
- (setq params (append (list sql-user sql-password) params)))
- (if (not (string= "" sql-server))
- (setq params (append (list sql-server) params)))
+ (let ((params
+ (append
+ (if (not (string= "" sql-server))
+ (list sql-server))
+ ;; It only makes sense if both username and password are there.
+ (if (not (or (string= "" sql-user)
+ (string= "" sql-password)))
+ (list sql-user sql-password))
+ options)))
(sql-comint product params)))
\f
"Create comint buffer and connect to Microsoft SQL Server."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
- (let ((params options))
- (if (not (string= "" sql-server))
- (setq params (append (list "-S" sql-server) params)))
- (if (not (string= "" sql-database))
- (setq params (append (list "-d" sql-database) params)))
- (if (not (string= "" sql-user))
- (setq params (append (list "-U" sql-user) params)))
- (if (not (string= "" sql-password))
- (setq params (append (list "-P" sql-password) params))
- (if (string= "" sql-user)
- ;; if neither user nor password is provided, use system
- ;; credentials.
- (setq params (append (list "-E") params))
- ;; If -P is passed to ISQL as the last argument without a
- ;; password, it's considered null.
- (setq params (append params (list "-P")))))
+ (let ((params
+ (append
+ (if (not (string= "" sql-user))
+ (list "-U" sql-user))
+ (if (not (string= "" sql-database))
+ (list "-d" sql-database))
+ (if (not (string= "" sql-server))
+ (list "-S" sql-server))
+ options)))
+ (setq params
+ (if (not (string= "" sql-password))
+ `("-P" ,sql-password ,@params)
+ (if (string= "" sql-user)
+ ;; If neither user nor password is provided, use system
+ ;; credentials.
+ `("-E" ,@params)
+ ;; If -P is passed to ISQL as the last argument without a
+ ;; password, it's considered null.
+ `(,@params "-P"))))
(sql-comint product params)))
\f
(defun sql-comint-postgres (product options)
"Create comint buffer and connect to Postgres."
- ;; username and password are ignored. Mark Stosberg suggest to add
- ;; the database at the end. Jason Beegan suggest using --pset and
+ ;; username and password are ignored. Mark Stosberg suggests to add
+ ;; the database at the end. Jason Beegan suggests using --pset and
;; pager=off instead of \\o|cat. The later was the solution by
;; Gregor Zych. Jason's suggestion is the default value for
;; sql-postgres-options.
- (let ((params options))
- (if (not (string= "" sql-database))
- (setq params (append params (list sql-database))))
- (if (not (string= "" sql-server))
- (setq params (append (list "-h" sql-server) params)))
- (if (not (string= "" sql-user))
- (setq params (append (list "-U" sql-user) params)))
- (if (not (= 0 sql-port))
- (setq params (append (list "-p" (number-to-string sql-port)) params)))
+ (let ((params
+ (append
+ (if (not (= 0 sql-port))
+ (list "-p" (number-to-string sql-port)))
+ (if (not (string= "" sql-user))
+ (list "-U" sql-user))
+ (if (not (string= "" sql-server))
+ (list "-h" sql-server))
+ options
+ (if (not (string= "" sql-database))
+ (list sql-database)))))
(sql-comint product params)))
(defun sql-postgres-completion-object (sqlbuf schema)
- (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 "\\t on")
+ (let ((aligned
+ (string= "aligned"
+ (car (sql-redirect-value
+ sqlbuf "\\a"
+ "Output format is \\(.*\\)[.]$" 1)))))
+ (when 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)))
+ (let* ((fs (or (car (sql-redirect-value
+ sqlbuf "\\f" "Field separator is \"\\(.\\)[.]$" 1))
+ "|"))
+ (re (concat "^\\([^" fs "]*\\)" fs "\\([^" fs "]*\\)"
+ fs "[^" fs "]*" fs "[^" fs "]*$"))
+ (cl (if (not schema)
+ (sql-redirect-value sqlbuf "\\d" re '(1 2))
+ (append (sql-redirect-value
+ sqlbuf (format "\\dt %s.*" schema) re '(1 2))
+ (sql-redirect-value
+ sqlbuf (format "\\dv %s.*" schema) re '(1 2))
+ (sql-redirect-value
+ sqlbuf (format "\\ds %s.*" schema) re '(1 2))))))
+
+ ;; Restore tuples and alignment to what they were.
+ (sql-redirect sqlbuf "\\t off")
+ (when (not aligned)
+ (sql-redirect sqlbuf "\\a"))
+
+ ;; Return the list of table names (public schema name can be omitted)
+ (mapcar #'(lambda (tbl)
+ (if (string= (car tbl) "public")
+ (cadr tbl)
+ (format "%s.%s" (car tbl) (cadr tbl))))
+ cl))))
\f
"Create comint buffer and connect to Interbase."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
- (let ((params options))
- (if (not (string= "" sql-user))
- (setq params (append (list "-u" sql-user) params)))
- (if (not (string= "" sql-password))
- (setq params (append (list "-p" sql-password) params)))
- (if (not (string= "" sql-database))
- (setq params (cons sql-database params))) ; add to the front!
+ (let ((params
+ (append
+ (if (not (string= "" sql-database))
+ (list sql-database)) ; Add to the front!
+ (if (not (string= "" sql-password))
+ (list "-p" sql-password))
+ (if (not (string= "" sql-user))
+ (list "-u" sql-user))
+ options)))
(sql-comint product params)))
\f
"Create comint buffer and connect to Linter."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
- (let ((params options)
- (login nil)
- (old-mbx (getenv "LINTER_MBX")))
- (if (not (string= "" sql-user))
- (setq login (concat sql-user "/" sql-password)))
- (setq params (append (list "-u" login) params))
- (if (not (string= "" sql-server))
- (setq params (append (list "-n" sql-server) params)))
- (if (string= "" sql-database)
- (setenv "LINTER_MBX" nil)
- (setenv "LINTER_MBX" sql-database))
- (sql-comint product params)
- (setenv "LINTER_MBX" old-mbx)))
+ (let* ((login
+ (if (not (string= "" sql-user))
+ (concat sql-user "/" sql-password)))
+ (params
+ (append
+ (if (not (string= "" sql-server))
+ (list "-n" sql-server))
+ (list "-u" login)
+ options)))
+ (cl-letf (((getenv "LINTER_MBX")
+ (unless (string= "" sql-database) sql-database)))
+ (sql-comint product params))))
\f
HCoop / bpt / emacs.git / blobdiff