X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/b0126eac41487b9bca5af5cbb2212ff5b2c58b80..175069efeb080517afefdd44a06f7a779ea8c25c:/lisp/progmodes/sql.el?ds=sidebyside diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index e44504688f..053816d028 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -5,9 +5,9 @@ ;; Author: Alex Schroeder ;; Maintainer: Michael Mauger -;; 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. @@ -187,10 +187,10 @@ ;; 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: @@ -275,8 +275,8 @@ Customizing your password will store it in your ~/.emacs file." :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 @@ -286,6 +286,9 @@ Customizing your password will store it in your ~/.emacs file." (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) @@ -300,7 +303,7 @@ Customizing your password will store it in your ~/.emacs file." (const :format "" server) (const :format "" :completion) (restricted-sexp - :match-alternatives (listp symbolp)))) + :match-alternatives (listp stringp)))) (choice :tag "database" (const database) (list :tag "file" @@ -311,7 +314,7 @@ Customizing your password will store it in your ~/.emacs file." (const :format "" database) (const :format "" :completion) (restricted-sexp - :match-alternatives (listp symbolp)))) + :match-alternatives (listp stringp)))) (const port)))) ;; SQL Product support @@ -401,6 +404,8 @@ Customizing your password will store it in your ~/.emacs file." :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 "^ -> " @@ -428,11 +433,13 @@ Customizing your password will store it in your ~/.emacs file." :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" @@ -452,6 +459,8 @@ Customizing your password will store it in your ~/.emacs file." :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 "^ ...> " @@ -510,6 +519,23 @@ may be any one of the following: 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. @@ -551,7 +577,6 @@ settings.") (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. @@ -600,7 +625,6 @@ prompted for during login." :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." @@ -613,6 +637,7 @@ highlighted properly when you open them." sql-product-alist)) :group 'SQL :safe 'symbolp) +(defvaralias 'sql-dialect 'sql-product) ;; misc customization of sql.el behaviour @@ -788,7 +813,9 @@ to be safe: ;; 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." @@ -801,7 +828,7 @@ 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" @@ -940,7 +967,9 @@ add your name with a \"-U\" prefix (such as \"-Umark\") to the list." :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" @@ -1022,11 +1051,14 @@ Starts `sql-interactive-mode' after doing some setup." (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. @@ -1054,6 +1086,25 @@ You can change `sql-prompt-length' on `sql-interactive-mode-hook'.") 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 @@ -1069,6 +1120,8 @@ Used by `sql-rename-buffer'.") (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'.") @@ -1082,6 +1135,8 @@ 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'.") @@ -1091,15 +1146,14 @@ Based on `comint-mode-map'.") 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) @@ -1139,7 +1193,10 @@ Based on `comint-mode-map'.") "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. @@ -1364,7 +1421,7 @@ to add functions and PL/SQL keywords.") ;; 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" @@ -1403,7 +1460,7 @@ to add functions and PL/SQL keywords.") "\\)\\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 @@ -1585,81 +1642,153 @@ to add functions and PL/SQL keywords.") (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. @@ -1979,6 +2108,9 @@ you define your own `sql-mode-mysql-font-lock-keywords'.") (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" @@ -2047,6 +2179,16 @@ highlighting rules in SQL mode.") ;;; 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'. @@ -2161,20 +2303,21 @@ also be configured." '((?_ . "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. @@ -2237,10 +2380,9 @@ adds a fontification pattern to fontify identifiers ending in (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))) @@ -2260,11 +2402,7 @@ adds a fontification pattern to fontify identifiers ending in (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) @@ -2404,37 +2542,53 @@ appended to the SQLi buffer without disturbing your SQL buffer." "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. @@ -2453,69 +2607,69 @@ symbol `password', for the server if it contains the symbol `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 + :completion + :default + :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. @@ -2527,16 +2681,17 @@ using `sql-find-sqli-buffer'. If `sql-buffer' is set, (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 () @@ -2554,19 +2709,13 @@ If you call it from anywhere else, it sets the global copy of (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. @@ -2574,11 +2723,11 @@ If you call it from anywhere else, it sets the global copy of 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. @@ -2604,24 +2753,25 @@ server/database name." (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)))) @@ -2649,10 +2799,32 @@ server/database name." ;; 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. @@ -2801,7 +2973,7 @@ to force the output from the query to appear on a new line." (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 @@ -2814,7 +2986,7 @@ to force the output from the query to appear on a new line." (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 @@ -2893,10 +3065,175 @@ If given the optional parameter VALUE, sets +;;; 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))) + + + ;;; 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 @@ -2923,18 +3260,11 @@ you must tell Emacs. Here's how to do that in your `~/.emacs' file: \(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 @@ -2944,17 +3274,11 @@ you must tell Emacs. Here's how to do that in your `~/.emacs' file: 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)) @@ -3039,15 +3363,14 @@ you entered, right above the output it created. 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 @@ -3056,19 +3379,18 @@ you entered, right above the output it created. (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)) @@ -3120,6 +3442,14 @@ Sentinels will always get the two parameters PROCESS and EVENT." ;;; 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. @@ -3133,12 +3463,7 @@ is specified in the 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 @@ -3172,10 +3497,10 @@ is specified in the connection settings." ;; 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)) @@ -3216,7 +3541,7 @@ optionally is saved to the user's init file." (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)) @@ -3248,74 +3573,80 @@ optionally is saved to the user's init file." ;;; 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) @@ -3323,12 +3654,25 @@ If buffer exists and a process is running, just switch to buffer `*SQL*'. 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. @@ -3343,6 +3687,11 @@ the list `sql-oracle-options'. 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] @@ -3351,8 +3700,8 @@ The default comes from `process-coding-system-alist' and `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." @@ -3375,7 +3724,7 @@ The default comes from `process-coding-system-alist' and ;;;###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. @@ -3390,6 +3739,11 @@ can be stored in the list `sql-sybase-options'. 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] @@ -3398,8 +3752,8 @@ The default comes from `process-coding-system-alist' and `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." @@ -3419,7 +3773,7 @@ The default comes from `process-coding-system-alist' and ;;;###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. @@ -3432,6 +3786,11 @@ the variable `sql-database' as default, if set. 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] @@ -3440,8 +3799,8 @@ The default comes from `process-coding-system-alist' and `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." @@ -3456,7 +3815,7 @@ The default comes from `process-coding-system-alist' and ;;;###autoload -(defun sql-sqlite () +(defun sql-sqlite (&optional buffer) "Run sqlite as an inferior process. SQLite is free software. @@ -3473,6 +3832,11 @@ can be stored in the list `sql-sqlite-options'. 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] @@ -3481,8 +3845,8 @@ The default comes from `process-coding-system-alist' and `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." @@ -3498,7 +3862,7 @@ The default comes from `process-coding-system-alist' and ;;;###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. @@ -3515,6 +3879,11 @@ can be stored in the list `sql-mysql-options'. 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] @@ -3523,8 +3892,8 @@ The default comes from `process-coding-system-alist' and `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." @@ -3535,7 +3904,7 @@ The default comes from `process-coding-system-alist' and (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))) @@ -3547,7 +3916,7 @@ The default comes from `process-coding-system-alist' and ;;;###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. @@ -3561,6 +3930,11 @@ defaults, if set. 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] @@ -3569,8 +3943,8 @@ The default comes from `process-coding-system-alist' and `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." @@ -3588,7 +3962,7 @@ The default comes from `process-coding-system-alist' and ;;;###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. @@ -3601,6 +3975,11 @@ the variable `sql-database' as default, if set. 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] @@ -3609,8 +3988,8 @@ The default comes from `process-coding-system-alist' and `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." @@ -3624,7 +4003,7 @@ The default comes from `process-coding-system-alist' and ;;;###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. @@ -3639,6 +4018,11 @@ in the list `sql-ms-options'. 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] @@ -3647,8 +4031,8 @@ The default comes from `process-coding-system-alist' and `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." @@ -3675,7 +4059,7 @@ The default comes from `process-coding-system-alist' and ;;;###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. @@ -3690,6 +4074,11 @@ Additional command line parameters can be stored in the list 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] @@ -3703,8 +4092,8 @@ Try to set `comint-output-filter-functions' like this: '(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." @@ -3720,12 +4109,14 @@ Try to set `comint-output-filter-functions' like this: (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))) ;;;###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. @@ -3739,6 +4130,11 @@ defaults, if set. 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] @@ -3747,8 +4143,8 @@ The default comes from `process-coding-system-alist' and `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." @@ -3766,7 +4162,7 @@ The default comes from `process-coding-system-alist' and ;;;###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. @@ -3784,6 +4180,11 @@ db2, newlines will be escaped if necessary. If you don't want that, set `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] @@ -3792,8 +4193,8 @@ The default comes from `process-coding-system-alist' and `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." @@ -3801,11 +4202,9 @@ The default comes from `process-coding-system-alist' and ;; 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. @@ -3827,9 +4226,14 @@ an empty password. 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." @@ -3853,6 +4257,5 @@ input. See `sql-interactive-mode'. (provide 'sql) -;; arch-tag: 7e1fa1c4-9ca2-402e-87d2-83a5eccb7ac3 ;;; sql.el ends here