;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Michael Mauger <mmaug@yahoo.com>
-;; Version: 2.5
+;; Version: 2.8
;; Keywords: comm languages processes
-;; URL: http://savannah.gnu.org/cgi-bin/viewcvs/emacs/emacs/lisp/progmodes/sql.el
+;; URL: http://savannah.gnu.org/projects/emacs/
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SqlMode
;; This file is part of GNU Emacs.
;; 6) Define a convienence 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:
: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
(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 :format "" server)
(const :format "" :completion)
(restricted-sexp
- :match-alternatives (listp symbolp))))
+ :match-alternatives (listp stringp))))
(choice :tag "database"
(const database)
(list :tag "file"
(const :format "" database)
(const :format "" :completion)
(restricted-sexp
- :match-alternatives (listp symbolp))))
+ :match-alternatives (listp stringp))))
(const port))))
;; SQL Product support
: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 "^ -> "
:sqli-options sql-postgres-options
:sqli-login sql-postgres-login-params
:sqli-comint-func sql-comint-postgres
+ :list-all ("\\d+" . "\\dS+")
+ :list-table ("\\d+ %s" . "\\dS+ %s")
:prompt-regexp "^.*=[#>] "
:prompt-length 5
- :prompt-cont-regexp "^.*-[#>] "
+ :prompt-cont-regexp "^.*[-(][#>] "
:input-filter sql-remove-tabs-filter
- :terminator ("\\(^[\\]g\\|;\\)" . ";"))
+ :terminator ("\\(^\\s-*\\\\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"
:prompt-regexp "^sqlite> "
:prompt-length 8
:prompt-cont-regexp "^ ...> "
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.
+
:prompt-regexp regular expression string that matches
the prompt issued by the product
interpreter.
(defvar sql-indirect-features
'(:font-lock :sqli-program :sqli-options :sqli-login))
-;;;###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
;; Customization for SQLite
-(defcustom sql-sqlite-program "sqlite3"
+(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 :file ".*\\.db"))
+(defcustom sql-sqlite-login-params '((database :file ".*\\.\\(db\\|sqlite[23]?\\)"))
"List of login parameters needed to connect to SQLite."
:type 'sql-login-params
:version "24.1"
: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 'sql-login-params
:version "24.1"
(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.
Used by `sql-rename-buffer'.")
+(defun sql-buffer-live-p (buffer &optional product)
+ "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 is specified, it's
+`sql-product' 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)))))))
+
;; 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)
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 (sql-buffer-live-p sql-buffer)]
+ ["List table details" sql-list-table (sql-buffer-live-p sql-buffer)]
"--"
["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 t]
+ ["List table details" sql-list-table t]))
;; Abbreviations -- if you want more of them, define them in your
;; ~/.emacs file. Abbrevs have to be enabled in your ~/.emacs, too.
;; Oracle SQL*Plus Commands
(cons
(concat
- "^\\(?:\\(?:" (regexp-opt '(
+ "^\\s-*\\(?:\\(?:" (regexp-opt '(
"@" "@@" "accept" "append" "archive" "attribute" "break"
"btitle" "change" "clear" "column" "connect" "copy" "define"
"del" "describe" "disconnect" "edit" "execute" "exit" "get" "help"
"\\)\\b.*"
)
'font-lock-doc-face)
- '("^[ \t]*rem\\(?:ark\\)?.*" . font-lock-comment-face)
+ '("^\\s-*rem\\(?:ark\\)?\\>.*" . font-lock-comment-face)
;; Oracle Functions
(sql-font-lock-keywords-builder 'font-lock-builtin-face nil
(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.
(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"
;;; 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'.
'((?_ . "w") (?. . "w")))))
;; 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.
(mapcar
(lambda (param)
(let ((token (or (and (listp param) (car param)) param))
- (type (or (and (listp param) (nth 1 param)) nil))
- (arg (or (and (listp param) (nth 2 param)) nil)))
+ (plist (or (and (listp param) (cdr param)) nil)))
- (funcall body token type arg)))
+ (funcall body token plist)))
login-params)))
\f
(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)
"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 type arg)
+(defun sql-get-login-ext (prompt last-value history-var plist)
"Prompt user with extended login parameters.
-If TYPE is nil, then the user is simply prompted for a string
+If PLIST is nil, then the user is simply prompted for a string
value.
-If TYPE is `:file', then the user is prompted for a file
-name that must match the regexp pattern specified in the ARG
-argument.
+The property `:default' specifies the default value. If the
+`:number' property is non-nil then ask for a number.
-If TYPE is `:completion', then the user is prompted for a string
-specified by ARG. (ARG is used as the PREDICATE argument to
-`completing-read'.)"
- (cond
- ((eq type nil)
- (read-from-minibuffer prompt last-value nil nil history-var))
+The `:file' property prompts for a file name that must match the
+regexp pattern specified in its value.
- ((eq type :file)
- (let ((use-dialog-box nil))
+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) nil t
+ (file-name-directory last-value) default t
(file-name-nondirectory last-value)
- (if arg
- `(lambda (f)
- (string-match (concat "\\<" ,arg "\\>")
- (file-name-nondirectory f)))
- nil)))))
+ (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)))
- ((eq type :completion)
- (completing-read prompt arg nil t last-value history-var))))
+ (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.
-The tokens for `database' and `server' may also be lists to
-control or limit the values that can be supplied. These can be
-of the form:
+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:
- \(database :file \".+\\\\.EXT\")
- \(database :completion FUNCTION)
-
-The `server' token supports the same forms.
+ :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)
- (mapcar
- (lambda (w)
- (let ((token (or (and (listp w) (car w)) w))
- (type (or (and (listp w) (nth 1 w)) nil))
- (arg (or (and (listp w) (nth 2 w)) nil)))
-
- (cond
- ((eq token 'user) ; user
- (setq sql-user
- (read-from-minibuffer "User: " sql-user nil nil
- 'sql-user-history)))
-
- ((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 type arg)))
-
- ((eq token 'database) ; database
- (setq sql-database
- (sql-get-login-ext "Database: " sql-database
- 'sql-database-history type arg)))
-
- ((eq token 'port) ; port
- (setq sql-port
- (read-number "Port: " sql-port))))))
- 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)
+ "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)
+ buf)
+ ;; Global sql-buffer
+ (and (setq buf (default-value 'sql-buffer))
+ (sql-buffer-live-p buf prod)
+ buf)
+ ;; Look thru each buffer
+ (car (apply 'append
+ (mapcar (lambda (b)
+ (and (sql-buffer-live-p b prod)
+ (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 (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.
(apply 'append nil
(sql-for-each-login
(sql-get-product-feature sql-product :sqli-login)
- (lambda (token type arg)
+ (lambda (token plist)
(cond
((eq token 'user)
(unless (string= "" sql-user)
(list "/" sql-user)))
((eq token 'port)
- (unless (= 0 sql-port)
- (list ":" sql-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 (eq type :file)
+ (if (plist-member plist :file)
(file-name-nondirectory sql-server)
sql-server))))
((eq token 'database)
- (when (string= "" sql-database)
+ (unless (string= "" sql-database)
(list "@"
- (if (eq type :file)
+ (if (plist-member plist :file)
(file-name-nondirectory sql-database)
sql-database))))
;; Use the name we've got
name))))
-(defun sql-rename-buffer ()
- "Rename a SQLi buffer."
- (interactive)
- (rename-buffer (format "*SQL: %s*" sql-alternate-buffer-name) t))
+(defun sql-rename-buffer (&optional new-name)
+ "Rename a SQL interactive buffer.
+
+Prompts for the new name if command is preceeded 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.
(let ((comint-input-sender-no-newline nil)
(s (replace-regexp-in-string "[[:space:]\n\r]+\\'" "" str)))
- (if (buffer-live-p sql-buffer)
+ (if (sql-buffer-live-p sql-buffer)
(progn
;; Ignore the hoping around...
(save-excursion
(if 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
\f
+;;; Redirect output functions
+
+(defun sql-redirect (command combuf &optional outbuf save-prior)
+ "Execute the SQL command and send output to OUTBUF.
+
+COMBUF must be an active SQL interactive buffer. OUTBUF may be
+an existing buffer, or the name of a non-existing buffer. If
+omitted the output is sent to a temporary buffer which will be
+killed after the command completes. COMMAND should be a string
+of commands accepted by the SQLi program."
+
+ (with-current-buffer combuf
+ (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)))
+
+ ;; Run the command
+ (message "Executing SQL command...")
+ (comint-redirect-send-command-to-process command buf proc nil t)
+ (while (null comint-redirect-completed)
+ (accept-process-output nil 1))
+ (message "Executing SQL command...done")
+
+ ;; Clean up the output results
+ (with-current-buffer buf
+ ;; 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)))
+ (goto-char start)))))
+
+(defun sql-redirect-value (command combuf regexp &optional regexp-groups)
+ "Execute the SQL command and return part of result.
+
+COMBUF 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 command combuf outbuf nil)
+ (with-current-buffer outbuf
+ (while (re-search-forward regexp nil t)
+ (push
+ (cond
+ ;; no groups-return all of them
+ ((null regexp-groups)
+ (let ((i 1)
+ (r nil))
+ (while (match-beginning i)
+ (push (match-string i) r))
+ (nreverse 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)))
+ (nreverse results)))
+
+(defun sql-execute (sqlbuf outbuf command arg)
+ "Executes a command in a SQL interacive 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 (if arg (format c arg) c) sqlbuf outbuf) t)
+ ((functionp c)
+ (apply c sqlbuf outbuf arg))
+ (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 arg)))
+
+(defun sql-read-table-name (prompt)
+ "Read the name of a database table."
+ ;; TODO: Fetch table/view names from database and provide completion.
+ ;; Also implement thing-at-point if the buffer has valid names in it
+ ;; (i.e. sql-mode, sql-interactive-mode, or sql-list-all buffers)
+ (read-from-minibuffer prompt))
+
+(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)))
+
+(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)
;; Catch changes to sql-product and highlight accordingly
- (sql-highlight-product)
(add-hook 'hack-local-variables-hook 'sql-highlight-product t t))
\f
sql-product))
;; 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 major-mode 'sql-interactive-mode) ;FIXME: Use define-derived-mode.
+ (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)
+ (set-process-sentinel (get-buffer-process (current-buffer)) 'sql-stop)
;; Save the connection name
(make-local-variable 'sql-connection)
;; Create a usefull name for renaming this buffer later.
- (make-local-variable 'sql-alternate-buffer-name)
- (setq sql-alternate-buffer-name (sql-make-alternate-buffer-name))
+ (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))
;;; Connection handling
+(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)
"Connect to an interactive session using CONNECTION settings.
;; 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)))
nil))
;; Are there connections defined
;; the remaining params (w/o the connection params)
(rem-params (sql-for-each-login
login-params
- (lambda (token type arg)
+ (lambda (token plist)
(unless (member token set-params)
- (if (or type arg)
- (list token type arg)
+ (if plist
+ (cons token plist)
token)))))
;; Remember the connection
(sql-connection connection))
(append (list name)
(sql-for-each-login
`(product ,@login)
- (lambda (token type arg)
+ (lambda (token plist)
(cond
((eq token 'product) `(sql-product ',sql-product))
((eq token 'user) `(sql-user ,sql-user))
;;; Entry functions for different SQL interpreters.
;;;###autoload
-(defun sql-product-interactive (&optional product)
+(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
- ((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)
+ ((= (prefix-numeric-value product) 4) ; C-u, prompt for product
+ (sql-read-product "SQL product: " sql-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 (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))
+ ;; If no new name specified, try to pop to an active SQL
+ ;; interactive for the same product
+ (let ((buf (sql-find-sqli-buffer product)))
+ (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.
+ (setq new-sqli-buffer (current-buffer))
+ (let ((sql-interactive-product product))
+ (sql-interactive-mode))
+
+ ;; Set the new buffer name
+ (when new-name
+ (sql-rename-buffer new-name))
+
+ ;; Set `sql-buffer' in the new buffer and the start buffer
+ (setq sql-buffer (buffer-name new-sqli-buffer))
(with-current-buffer start-buffer
- (setq sql-buffer new-sqli-buffer)))
+ (setq sql-buffer (buffer-name new-sqli-buffer))
+ (run-hooks 'sql-set-sqli-hook))
- ;; All done.
- (message "Login...done")
- (pop-to-buffer sql-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)
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)))
+ (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 "SQL" program nil params))))
+ (apply 'make-comint buf-name program nil params))))
;;;###autoload
-(defun sql-oracle ()
+(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."
\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."
\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" sql-port) params)))
(sql-comint product params)))
\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."
;; make-comint.
(sql-comint product options)
)
-;; ;; Properly escape newlines when DB2 is interactive.
-;; (setq comint-input-sender 'sql-escape-newlines-and-send))
;;;###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
HCoop / bpt / emacs.git / blobdiff