From 93852cb0cf22a38d75edeb840e498b3aa6a4d7c9 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 6 Dec 2012 12:29:30 -0500 Subject: [PATCH] * lisp/progmodes/sql.el: Use cl-lib and lexical-binding; various cleanup. (sql-signum): Remove. Use `cl-signum' instead. (sql-read-passwd): Remove; use read-passwd instread. (sql-get-login-ext): Use read-string. (sql-get-login): Use dolist and pcase. (sql--completion-table): Rename from sql-try-completion. Use complete-with-action. (sql-mode): Don't change abbrev-all-caps globally. (sql-connect): Don't rely on dynamic scoping for `new-name'. (sql-postgres-completion-object): Initialize vars in their `let'. (sql-comint-sybase, sql-comint-sqlite, sql-comint-mysql) (sql-comint-solid, sql-comint-ms, sql-comint-postgres) (sql-comint-interbase): Use a single append, without setq. (sql-comint-linter): Same, and unwind-protect the LINTER_MBX var. --- lisp/ChangeLog | 15 ++ lisp/progmodes/sql.el | 556 +++++++++++++++++++++--------------------- 2 files changed, 294 insertions(+), 277 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 82b311acf0d..d94ffbab67e 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,20 @@ 2012-12-06 Stefan Monnier + * progmodes/sql.el: Use cl-lib and lexical-binding; various cleanup. + (sql-signum): Remove. Use `cl-signum' instead. + (sql-read-passwd): Remove; use read-passwd instread. + (sql-get-login-ext): Use read-string. + (sql-get-login): Use dolist and pcase. + (sql--completion-table): Rename from sql-try-completion. + Use complete-with-action. + (sql-mode): Don't change abbrev-all-caps globally. + (sql-connect): Don't rely on dynamic scoping for `new-name'. + (sql-postgres-completion-object): Initialize vars in their `let'. + (sql-comint-sybase, sql-comint-sqlite, sql-comint-mysql) + (sql-comint-solid, sql-comint-ms, sql-comint-postgres) + (sql-comint-interbase): Use a single append, without setq. + (sql-comint-linter): Same, and unwind-protect the LINTER_MBX var. + * hi-lock.el: Rework the default face and the serialize regexp code. (hi-lock--auto-select-face-defaults): Remove. (hi-lock-string-serialize-serial): Remove. diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index d84d57cad22..22ba55d9a08 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -1,4 +1,4 @@ -;;; sql.el --- specialized comint.el for SQL interpreters +;;; sql.el --- specialized comint.el for SQL interpreters -*- lexical-binding: t -*- ;; Copyright (C) 1998-2012 Free Software Foundation, Inc. @@ -80,14 +80,6 @@ ;; Hint for newbies: take a look at `dabbrev-expand', `abbrev-mode', and ;; `imenu-add-menubar-index'. -;;; Requirements for Emacs 19.34: - -;; If you are using Emacs 19.34, you will have to get and install -;; the file regexp-opt.el -;; -;; and the custom package -;; . - ;;; Bugs: ;; sql-ms now uses osql instead of isql. Osql flushes its error @@ -169,15 +161,17 @@ ;; ;; ;; Do something with `sql-user', `sql-password', ;; ;; `sql-database', and `sql-server'. -;; (let ((params options)) -;; (if (not (string= "" sql-server)) -;; (setq params (append (list "-S" sql-server) params))) -;; (if (not (string= "" sql-database)) -;; (setq params (append (list "-D" sql-database) params))) -;; (if (not (string= "" sql-password)) -;; (setq params (append (list "-P" sql-password) params))) +;; (let ((params +;; (append ;; (if (not (string= "" sql-user)) -;; (setq params (append (list "-U" sql-user) params))) +;; (list "-U" sql-user)) +;; (if (not (string= "" sql-password)) +;; (list "-P" sql-password)) +;; (if (not (string= "" sql-database)) +;; (list "-D" sql-database)) +;; (if (not (string= "" sql-server)) +;; (list "-S" sql-server)) +;; options))) ;; (sql-comint product params))) ;; ;; (sql-set-product-feature 'xyz @@ -229,22 +223,13 @@ ;;; Code: +(require 'cl-lib) (require 'comint) ;; Need the following to allow GNU Emacs 19 to compile the file. (eval-when-compile (require 'regexp-opt)) (require 'custom) (require 'thingatpt) -(eval-when-compile ;; needed in Emacs 19, 20 - (setq max-specpdl-size (max max-specpdl-size 2000))) - -(defun sql-signum (n) - "Return 1, 0, or -1 to identify the sign of N." - (cond - ((not (numberp n)) nil) - ((< n 0) -1) - ((> n 0) 1) - (t 0))) (defvar font-lock-keyword-face) (defvar font-lock-set-defaults) @@ -636,12 +621,14 @@ making new SQLi sessions." (set (group (const :tag "Product" sql-product) (choice - ,@(mapcar (lambda (prod-info) - `(const :tag - ,(or (plist-get (cdr prod-info) :name) - (capitalize (symbol-name (car prod-info)))) - (quote ,(car prod-info)))) - sql-product-alist))) + ,@(mapcar + (lambda (prod-info) + `(const :tag + ,(or (plist-get (cdr prod-info) :name) + (capitalize + (symbol-name (car prod-info)))) + (quote ,(car prod-info)))) + sql-product-alist))) (group (const :tag "Username" sql-user) string) (group (const :tag "Password" sql-password) string) (group (const :tag "Server" sql-server) string) @@ -655,8 +642,8 @@ making new SQLi sessions." :group 'SQL) (defcustom sql-product 'ansi - "Select the SQL database product used so that buffers can be -highlighted properly when you open them." + "Select the SQL database product used. +This allows highlighting buffers properly when you open them." :type `(choice ,@(mapcar (lambda (prod-info) `(const :tag @@ -818,12 +805,11 @@ for the first time." ;; Customization for ANSI -(defcustom sql-ansi-statement-starters (regexp-opt '( - "create" "alter" "drop" - "select" "insert" "update" "delete" "merge" - "grant" "revoke" -)) - "Regexp of keywords that start SQL commands +(defcustom sql-ansi-statement-starters + (regexp-opt '("create" "alter" "drop" + "select" "insert" "update" "delete" "merge" + "grant" "revoke")) + "Regexp of keywords that start SQL commands. All products share this list; products should define a regexp to identify additional keywords in a variable defined by @@ -1167,10 +1153,10 @@ You can change `sql-prompt-length' on `sql-interactive-mode-hook'.") Used by `sql-rename-buffer'.") (defun sql-buffer-live-p (buffer &optional product connection) - "Returns non-nil if the process associated with buffer is live. + "Return non-nil if the process associated with buffer is live. BUFFER can be a buffer object or a buffer name. The buffer must -be a live buffer, have an running process attached to it, be in +be a live buffer, have a running process attached to it, be in `sql-interactive-mode', and, if PRODUCT or CONNECTION are specified, it's `sql-product' or `sql-connection' must match." @@ -1178,7 +1164,6 @@ specified, it's `sql-product' or `sql-connection' must match." (setq buffer (get-buffer buffer)) (and buffer (buffer-live-p buffer) - (get-buffer-process buffer) (comint-check-proc buffer) (with-current-buffer buffer (and (derived-mode-p 'sql-interactive-mode) @@ -1287,27 +1272,15 @@ Based on `comint-mode-map'.") ;; Abbreviations -- if you want more of them, define them in your init ;; file. Abbrevs have to be enabled in your init file, too. -(defvar sql-mode-abbrev-table nil +(define-abbrev-table 'sql-mode-abbrev-table + '(("ins" "insert" nil nil t) + ("upd" "update" nil nil t) + ("del" "delete" nil nil t) + ("sel" "select" nil nil t) + ("proc" "procedure" nil nil t) + ("func" "function" nil nil t) + ("cr" "create" nil nil t)) "Abbrev table used in `sql-mode' and `sql-interactive-mode'.") -(unless sql-mode-abbrev-table - (define-abbrev-table 'sql-mode-abbrev-table nil)) - -(mapc - ;; In Emacs 22+, provide SYSTEM-FLAG to define-abbrev. - (lambda (abbrev) - (let ((name (car abbrev)) - (expansion (cdr abbrev))) - (condition-case nil - (define-abbrev sql-mode-abbrev-table name expansion nil 0 t) - (error - (define-abbrev sql-mode-abbrev-table name expansion))))) - '(("ins" . "insert") - ("upd" . "update") - ("del" . "delete") - ("sel" . "select") - ("proc" . "procedure") - ("func" . "function") - ("cr" . "create"))) ;; Syntax Table @@ -1530,9 +1503,8 @@ function `regexp-opt'. Therefore, take a look at the source before you define your own `sql-mode-ansi-font-lock-keywords'. You may want to add functions and PL/SQL keywords.") -(defun sql-oracle-show-reserved-words () +(defun sql--oracle-show-reserved-words () ;; This function is for use by the maintainer of SQL.EL only. - (interactive) (if (or (and (not (derived-mode-p 'sql-mode)) (not (derived-mode-p 'sql-interactive-mode))) (not sql-buffer) @@ -2611,14 +2583,12 @@ adds a fontification pattern to fontify identifiers ending in (append keywords old-val)))))) (defun sql-for-each-login (login-params body) - "Iterates through login parameters and returns a list of results." - + "Iterate through login parameters and return a list of results." (delq nil (mapcar (lambda (param) - (let ((token (or (and (listp param) (car param)) param)) - (plist (or (and (listp param) (cdr param)) nil))) - + (let ((token (or (car-safe param) param)) + (plist (cdr-safe param))) (funcall body token plist))) login-params))) @@ -2682,6 +2652,34 @@ matching the regular expression `comint-prompt-regexp', a buffer local variable." (save-excursion (comint-bol nil) (point)))) +;;; SMIE support + +;; Needs a lot more love than I can provide. --Stef + +;; (require 'smie) + +;; (defconst sql-smie-grammar +;; (smie-prec2->grammar +;; (smie-bnf->prec2 +;; ;; Partly based on http://www.h2database.com/html/grammar.html +;; '((cmd ("SELECT" select-exp "FROM" select-table-exp) +;; ) +;; (select-exp ("*") (exp) (exp "AS" column-alias)) +;; (column-alias) +;; (select-table-exp (table-exp "WHERE" exp) (table-exp)) +;; (table-exp) +;; (exp ("CASE" exp "WHEN" exp "THEN" exp "ELSE" exp "END") +;; ("CASE" exp "WHEN" exp "THEN" exp "END")) +;; ;; Random ad-hoc additions. +;; (foo (foo "," foo)) +;; ) +;; '((assoc ","))))) + +;; (defun sql-smie-rules (kind token) +;; (pcase (cons kind token) +;; (`(:list-intro . ,_) t) +;; (`(:before . "(") (smie-rule-parent)))) + ;;; Motion Functions (defun sql-statement-regexp (prod) @@ -2694,7 +2692,7 @@ local variable." "\\>"))) (defun sql-beginning-of-statement (arg) - "Moves the cursor to the beginning of the current SQL statement." + "Move to the beginning of the current SQL statement." (interactive "p") (let ((here (point)) @@ -2721,10 +2719,10 @@ local variable." (beginning-of-line) ;; If we didn't move, try again (when (= here (point)) - (sql-beginning-of-statement (* 2 (sql-signum arg)))))) + (sql-beginning-of-statement (* 2 (cl-signum arg)))))) (defun sql-end-of-statement (arg) - "Moves the cursor to the end of the current SQL statement." + "Move to the end of the current SQL statement." (interactive "p") (let ((term (sql-get-product-feature sql-product :terminator)) (re-search (if (> 0 arg) 're-search-backward 're-search-forward)) @@ -2733,7 +2731,7 @@ local variable." (when (consp term) (setq term (car term))) ;; Iterate until we've moved the desired number of stmt ends - (while (not (= (sql-signum arg) 0)) + (while (not (= (cl-signum arg) 0)) ;; if we're looking at the terminator, jump by 2 (if (or (and (> 0 arg) (looking-back term)) (and (< 0 arg) (looking-at term))) @@ -2744,7 +2742,7 @@ local variable." (setq arg 0) ;; count it if we're not in a comment (unless (nth 7 (syntax-ppss)) - (setq arg (- arg (sql-signum arg)))))) + (setq arg (- arg (cl-signum arg)))))) (goto-char (if (match-data) (match-end 0) here)))) @@ -2857,10 +2855,6 @@ appended to the SQLi buffer without disturbing your SQL buffer." t t doc 0))) doc) -(defun sql-read-passwd (prompt &optional default) - "Read a password using PROMPT. Optional DEFAULT is password to start with." - (read-passwd prompt nil default)) - (defun sql-get-login-ext (symbol prompt history-var plist) "Prompt user with extended login parameters. @@ -2912,8 +2906,7 @@ value. (The property value is used as the PREDICATE argument to (read-number prompt (or default last-value 0))) (t - (let ((r (read-from-minibuffer prompt-def last-value nil nil history-var nil))) - (if (string= "" r) (or default "") r))))))) + (read-string prompt-def last-value history-var default)))))) (defun sql-get-login (&rest what) "Get username, password and database from the user. @@ -2943,32 +2936,29 @@ supported: In order to ask the user for username, password and database, call the function like this: (sql-get-login 'user 'password 'database)." - (interactive) - (mapcar - (lambda (w) - (let ((token (or (and (consp w) (car w)) w)) - (plist (or (and (consp w) (cdr w)) nil))) - - (cond - ((eq token 'user) ; user - (sql-get-login-ext 'sql-user "User: " 'sql-user-history plist)) + (dolist (w what) + (let ((plist (cdr-safe w))) + (pcase (or (car-safe w) w) + (`user + (sql-get-login-ext 'sql-user "User: " 'sql-user-history plist)) - ((eq token 'password) ; password - (setq-default sql-password - (sql-read-passwd "Password: " sql-password))) + (`password + (setq-default sql-password + (read-passwd "Password: " nil sql-password))) - ((eq token 'server) ; server - (sql-get-login-ext 'sql-server "Server: " 'sql-server-history plist)) + (`server + (sql-get-login-ext 'sql-server "Server: " 'sql-server-history plist)) - ((eq token 'database) ; database - (sql-get-login-ext 'sql-database "Database: " 'sql-database-history plist)) + (`database + (sql-get-login-ext 'sql-database "Database: " + 'sql-database-history plist)) - ((eq token 'port) ; port - (sql-get-login-ext 'sql-port "Port: " nil (append '(:number t) plist)))))) - what)) + (`port + (sql-get-login-ext 'sql-port "Port: " + nil (append '(:number t) plist))))))) (defun sql-find-sqli-buffer (&optional product connection) - "Returns the name of the current default SQLi buffer or nil. + "Return the name of the current default SQLi buffer or nil. In order to qualify, the SQLi buffer must be alive, be in `sql-interactive-mode' and have a process." (let ((buf sql-buffer) @@ -3072,29 +3062,29 @@ server/database name." (sql-for-each-login (sql-get-product-feature sql-product :sqli-login) (lambda (token plist) - (cond - ((eq token 'user) + (pcase token + (`user (unless (string= "" sql-user) (list "/" sql-user))) - ((eq token 'port) + (`port (unless (or (not (numberp sql-port)) (= 0 sql-port)) (list ":" (number-to-string sql-port)))) - ((eq token 'server) + (`server (unless (string= "" sql-server) (list "." (if (plist-member plist :file) (file-name-nondirectory sql-server) sql-server)))) - ((eq token 'database) + (`database (unless (string= "" sql-database) (list "@" (if (plist-member plist :file) (file-name-nondirectory sql-database) sql-database)))) - ((eq token 'password) nil) - (t nil)))))))) + ;; (`password nil) + (_ nil)))))))) ;; If there's a connection, use it and the name thus far (if sql-connection @@ -3527,7 +3517,7 @@ for each match." (nreverse results))) (defun sql-execute (sqlbuf outbuf command enhanced arg) - "Executes a command in a SQL interactive buffer and captures the output. + "Execute a command in a SQL interactive buffer and capture the output. The commands are run in SQLBUF and the output saved in OUTBUF. COMMAND must be a string, a function or a list of such elements. @@ -3535,7 +3525,7 @@ 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. " +buffer is popped into a view window." (mapc (lambda (c) (cond @@ -3600,43 +3590,35 @@ The list is maintained in SQL interactive buffers.") (defvar sql-completion-sqlbuf nil) -(defun sql-try-completion (string collection &optional predicate) +(defun sql--completion-table (string pred action) (when sql-completion-sqlbuf - (with-current-buffer sql-completion-sqlbuf - (let ((schema (and (string-match "\\`\\(\\sw\\(:?\\sw\\|\\s_\\)*\\)[.]" string) - (downcase (match-string 1 string))))) - - ;; If we haven't loaded any object name yet, load local schema - (unless sql-completion-object - (sql-build-completions nil)) - - ;; If they want another schema, load it if we haven't yet - (when schema - (let ((schema-dot (concat schema ".")) - (schema-len (1+ (length schema))) - (names sql-completion-object) - has-schema) - - (while (and (not has-schema) names) - (setq has-schema (and - (>= (length (car names)) schema-len) - (string= schema-dot - (downcase (substring (car names) - 0 schema-len)))) - names (cdr names))) - (unless has-schema - (sql-build-completions schema))))) - - ;; Try to find the completion - (cond - ((not predicate) - (try-completion string sql-completion-object)) - ((eq predicate t) - (all-completions string sql-completion-object)) - ((eq predicate 'lambda) - (test-completion string sql-completion-object)) - ((eq (car predicate) 'boundaries) - (completion-boundaries string sql-completion-object nil (cdr predicate))))))) + (with-current-buffer sql-completion-sqlbuf + (let ((schema (and (string-match "\\`\\(\\sw\\(:?\\sw\\|\\s_\\)*\\)[.]" string) + (downcase (match-string 1 string))))) + + ;; If we haven't loaded any object name yet, load local schema + (unless sql-completion-object + (sql-build-completions nil)) + + ;; If they want another schema, load it if we haven't yet + (when schema + (let ((schema-dot (concat schema ".")) + (schema-len (1+ (length schema))) + (names sql-completion-object) + has-schema) + + (while (and (not has-schema) names) + (setq has-schema (and + (>= (length (car names)) schema-len) + (string= schema-dot + (downcase (substring (car names) + 0 schema-len)))) + names (cdr names))) + (unless has-schema + (sql-build-completions schema))))) + + ;; Try to find the completion + (complete-with-action action sql-completion-object string pred)))) (defun sql-read-table-name (prompt) "Read the name of a database table." @@ -3652,7 +3634,7 @@ The list is maintained in SQL interactive buffers.") (completion-ignore-case t)) (if (sql-get-product-feature product :completion-object) - (completing-read prompt (function sql-try-completion) + (completing-read prompt #'sql--completion-table nil nil tname) (read-from-minibuffer prompt tname)))) @@ -3720,6 +3702,7 @@ must tell Emacs. Here's how to do that in your init file: (if sql-mode-menu (easy-menu-add sql-mode-menu)); XEmacs + ;; (smie-setup sql-smie-grammar #'sql-smie-rules) (set (make-local-variable 'comment-start) "--") ;; Make each buffer in sql-mode remember the "current" SQLi buffer. (make-local-variable 'sql-buffer) @@ -3733,7 +3716,7 @@ must tell Emacs. Here's how to do that in your init file: (set (make-local-variable 'paragraph-separate) "[\f]*$") (set (make-local-variable 'paragraph-start) "[\n\f]") ;; Abbrevs - (setq abbrev-all-caps 1) + (setq-local abbrev-all-caps 1) ;; Contains the name of database objects (set (make-local-variable 'sql-contains-names) t) ;; Catch changes to sql-product and highlight accordingly @@ -3959,13 +3942,13 @@ is specified in the connection settings." (setq set-params (mapcar (lambda (v) - (cond - ((eq (car v) 'sql-user) 'user) - ((eq (car v) 'sql-password) 'password) - ((eq (car v) 'sql-server) 'server) - ((eq (car v) 'sql-database) 'database) - ((eq (car v) 'sql-port) 'port) - (t (car v)))) + (pcase (car v) + (`sql-user 'user) + (`sql-password 'password) + (`sql-server 'server) + (`sql-database 'database) + (`sql-port 'port) + (s s))) (cdr connect-set))) ;; the remaining params (w/o the connection params) @@ -3984,7 +3967,7 @@ is specified in the connection settings." ;; Start the SQLi session with revised list of login parameters (eval `(let ((,param-var ',rem-params)) - (sql-product-interactive sql-product new-name)))) + (sql-product-interactive ',sql-product ',new-name)))) (message "SQL Connection <%s> does not exist" connection) nil))) @@ -4028,16 +4011,16 @@ optionally is saved to the user's init file." (if (assoc name alist) (message "Connection <%s> already exists" name) (setq connect - (append (list name) - (sql-for-each-login - `(product ,@login) - (lambda (token _plist) - (cond - ((eq token 'product) `(sql-product ',product)) - ((eq token 'user) `(sql-user ,user)) - ((eq token 'database) `(sql-database ,database)) - ((eq token 'server) `(sql-server ,server)) - ((eq token 'port) `(sql-port ,port))))))) + (cons name + (sql-for-each-login + `(product ,@login) + (lambda (token _plist) + (pcase token + (`product `(sql-product ',product)) + (`user `(sql-user ,user)) + (`database `(sql-database ,database)) + (`server `(sql-server ,server)) + (`port `(sql-port ,port))))))) (setq alist (append alist (list connect))) @@ -4047,7 +4030,7 @@ optionally is saved to the user's init file." (customize-set-variable 'sql-connection-alist alist))))))) (defun sql-connection-menu-filter (tail) - "Generates menu entries for using each connection." + "Generate menu entries for using each connection." (append (mapcar (lambda (conn) @@ -4114,7 +4097,8 @@ the call to \\[sql-product-interactive] with new-sqli-buffer) ;; Get credentials. - (apply 'sql-get-login (sql-get-product-feature product :sqli-login)) + (apply #'sql-get-login + (sql-get-product-feature product :sqli-login)) ;; Connect to database. (message "Login...") @@ -4225,7 +4209,7 @@ The default comes from `process-coding-system-alist' and (sql-comint product parameter))) (defun sql-oracle-save-settings (sqlbuf) - "Saves most SQL*Plus settings so they may be reset by \\[sql-redirect]." + "Save most SQL*Plus settings so they may be reset by \\[sql-redirect]." ;; Note: does not capture the following settings: ;; ;; APPINFO @@ -4297,7 +4281,7 @@ The default comes from `process-coding-system-alist' and ;; Restore the changed settings (sql-redirect sqlbuf saved-settings)) -(defun sql-oracle-list-all (sqlbuf outbuf enhanced table-name) +(defun sql-oracle-list-all (sqlbuf outbuf enhanced _table-name) ;; Query from USER_OBJECTS or ALL_OBJECTS (let ((settings (sql-oracle-save-settings sqlbuf)) (simple-sql @@ -4336,7 +4320,7 @@ The default comes from `process-coding-system-alist' and (sql-oracle-restore-settings sqlbuf settings))) -(defun sql-oracle-list-table (sqlbuf outbuf enhanced table-name) +(defun sql-oracle-list-table (sqlbuf outbuf _enhanced table-name) "Implements :list-table under Oracle." (let ((settings (sql-oracle-save-settings sqlbuf))) @@ -4413,15 +4397,17 @@ The default comes from `process-coding-system-alist' and "Create comint buffer and connect to Sybase." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. - (let ((params options)) - (if (not (string= "" sql-server)) - (setq params (append (list "-S" sql-server) params))) - (if (not (string= "" sql-database)) - (setq params (append (list "-D" sql-database) params))) - (if (not (string= "" sql-password)) - (setq params (append (list "-P" sql-password) params))) - (if (not (string= "" sql-user)) - (setq params (append (list "-U" sql-user) params))) + (let ((params + (append + (if (not (string= "" sql-user)) + (list "-U" sql-user)) + (if (not (string= "" sql-password)) + (list "-P" sql-password)) + (if (not (string= "" sql-database)) + (list "-D" sql-database)) + (if (not (string= "" sql-server)) + (list "-S" sql-server)) + options))) (sql-comint product params))) @@ -4506,14 +4492,13 @@ The default comes from `process-coding-system-alist' and "Create comint buffer and connect to SQLite." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. - (let ((params)) - (if (not (string= "" sql-database)) - (setq params (append (list (expand-file-name sql-database)) - params))) - (setq params (append options params)) + (let ((params + (append options + (if (not (string= "" sql-database)) + `(,(expand-file-name sql-database)))))) (sql-comint product params))) -(defun sql-sqlite-completion-object (sqlbuf schema) +(defun sql-sqlite-completion-object (sqlbuf _schema) (sql-redirect-value sqlbuf ".tables" "\\sw\\(?:\\sw\\|\\s_\\)*" 0)) @@ -4556,18 +4541,19 @@ The default comes from `process-coding-system-alist' and "Create comint buffer and connect to MySQL." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. - (let ((params)) - (if (not (string= "" sql-database)) - (setq params (append (list sql-database) params))) - (if (not (string= "" sql-server)) - (setq params (append (list (concat "--host=" sql-server)) params))) - (if (not (= 0 sql-port)) - (setq params (append (list (concat "--port=" (number-to-string sql-port))) params))) - (if (not (string= "" sql-password)) - (setq params (append (list (concat "--password=" sql-password)) params))) - (if (not (string= "" sql-user)) - (setq params (append (list (concat "--user=" sql-user)) params))) - (setq params (append options params)) + (let ((params + (append + options + (if (not (string= "" sql-user)) + (list (concat "--user=" sql-user))) + (if (not (string= "" sql-password)) + (list (concat "--password=" sql-password))) + (if (not (= 0 sql-port)) + (list (concat "--port=" (number-to-string sql-port)))) + (if (not (string= "" sql-server)) + (list (concat "--host=" sql-server))) + (if (not (string= "" sql-database)) + (list sql-database))))) (sql-comint product params))) @@ -4607,13 +4593,15 @@ The default comes from `process-coding-system-alist' and "Create comint buffer and connect to Solid." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. - (let ((params options)) - ;; It only makes sense if both username and password are there. - (if (not (or (string= "" sql-user) - (string= "" sql-password))) - (setq params (append (list sql-user sql-password) params))) - (if (not (string= "" sql-server)) - (setq params (append (list sql-server) params))) + (let ((params + (append + (if (not (string= "" sql-server)) + (list sql-server)) + ;; It only makes sense if both username and password are there. + (if (not (or (string= "" sql-user) + (string= "" sql-password))) + (list sql-user sql-password)) + options))) (sql-comint product params))) @@ -4695,22 +4683,25 @@ The default comes from `process-coding-system-alist' and "Create comint buffer and connect to Microsoft SQL Server." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. - (let ((params options)) - (if (not (string= "" sql-server)) - (setq params (append (list "-S" sql-server) params))) - (if (not (string= "" sql-database)) - (setq params (append (list "-d" sql-database) params))) - (if (not (string= "" sql-user)) - (setq params (append (list "-U" sql-user) params))) - (if (not (string= "" sql-password)) - (setq params (append (list "-P" sql-password) params)) - (if (string= "" sql-user) - ;; if neither user nor password is provided, use system - ;; credentials. - (setq params (append (list "-E") params)) - ;; If -P is passed to ISQL as the last argument without a - ;; password, it's considered null. - (setq params (append params (list "-P"))))) + (let ((params + (append + (if (not (string= "" sql-user)) + (list "-U" sql-user)) + (if (not (string= "" sql-database)) + (list "-d" sql-database)) + (if (not (string= "" sql-server)) + (list "-S" sql-server)) + options))) + (setq params + (if (not (string= "" sql-password)) + `("-P" ,sql-password ,@params) + (if (string= "" sql-user) + ;; If neither user nor password is provided, use system + ;; credentials. + `("-E" ,@params) + ;; If -P is passed to ISQL as the last argument without a + ;; password, it's considered null. + `(,@params "-P")))) (sql-comint product params))) @@ -4754,48 +4745,58 @@ Try to set `comint-output-filter-functions' like this: (defun sql-comint-postgres (product options) "Create comint buffer and connect to Postgres." - ;; username and password are ignored. Mark Stosberg suggest to add - ;; the database at the end. Jason Beegan suggest using --pset and + ;; username and password are ignored. Mark Stosberg suggests to add + ;; the database at the end. Jason Beegan suggests using --pset and ;; pager=off instead of \\o|cat. The later was the solution by ;; Gregor Zych. Jason's suggestion is the default value for ;; sql-postgres-options. - (let ((params options)) - (if (not (string= "" sql-database)) - (setq params (append params (list sql-database)))) - (if (not (string= "" sql-server)) - (setq params (append (list "-h" sql-server) params))) - (if (not (string= "" sql-user)) - (setq params (append (list "-U" sql-user) params))) - (if (not (= 0 sql-port)) - (setq params (append (list "-p" (number-to-string sql-port)) params))) + (let ((params + (append + (if (not (= 0 sql-port)) + (list "-p" (number-to-string sql-port))) + (if (not (string= "" sql-user)) + (list "-U" sql-user)) + (if (not (string= "" sql-server)) + (list "-h" sql-server)) + options + (if (not (string= "" sql-database)) + (list sql-database))))) (sql-comint product params))) (defun sql-postgres-completion-object (sqlbuf schema) - (let (cl re fs a r) - (sql-redirect sqlbuf "\\t on") - (setq a (car (sql-redirect-value sqlbuf "\\a" "Output format is \\(.*\\)[.]$" 1))) - (when (string= a "aligned") - (sql-redirect sqlbuf "\\a")) - (setq fs (or (car (sql-redirect-value sqlbuf "\\f" "Field separator is \"\\(.\\)[.]$" 1)) "|")) - - (setq re (concat "^\\([^" fs "]*\\)" fs "\\([^" fs "]*\\)" fs "[^" fs "]*" fs "[^" fs "]*$")) - (setq cl (if (not schema) - (sql-redirect-value sqlbuf "\\d" re '(1 2)) - (append (sql-redirect-value sqlbuf (format "\\dt %s.*" schema) re '(1 2)) - (sql-redirect-value sqlbuf (format "\\dv %s.*" schema) re '(1 2)) - (sql-redirect-value sqlbuf (format "\\ds %s.*" schema) re '(1 2))))) - - ;; Restore tuples and alignment to what they were - (sql-redirect sqlbuf "\\t off") - (when (not (string= a "aligned")) + (sql-redirect sqlbuf "\\t on") + (let ((aligned + (string= "aligned" + (car (sql-redirect-value + sqlbuf "\\a" + "Output format is \\(.*\\)[.]$" 1))))) + (when aligned (sql-redirect sqlbuf "\\a")) - - ;; Return the list of table names (public schema name can be omitted) - (mapcar (lambda (tbl) - (if (string= (car tbl) "public") - (cadr tbl) - (format "%s.%s" (car tbl) (cadr tbl)))) - cl))) + (let* ((fs (or (car (sql-redirect-value + sqlbuf "\\f" "Field separator is \"\\(.\\)[.]$" 1)) + "|")) + (re (concat "^\\([^" fs "]*\\)" fs "\\([^" fs "]*\\)" + fs "[^" fs "]*" fs "[^" fs "]*$")) + (cl (if (not schema) + (sql-redirect-value sqlbuf "\\d" re '(1 2)) + (append (sql-redirect-value + sqlbuf (format "\\dt %s.*" schema) re '(1 2)) + (sql-redirect-value + sqlbuf (format "\\dv %s.*" schema) re '(1 2)) + (sql-redirect-value + sqlbuf (format "\\ds %s.*" schema) re '(1 2)))))) + + ;; Restore tuples and alignment to what they were. + (sql-redirect sqlbuf "\\t off") + (when (not aligned) + (sql-redirect sqlbuf "\\a")) + + ;; Return the list of table names (public schema name can be omitted) + (mapcar (lambda (tbl) + (if (string= (car tbl) "public") + (cadr tbl) + (format "%s.%s" (car tbl) (cadr tbl)))) + cl)))) @@ -4834,13 +4835,15 @@ The default comes from `process-coding-system-alist' and "Create comint buffer and connect to Interbase." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. - (let ((params options)) - (if (not (string= "" sql-user)) - (setq params (append (list "-u" sql-user) params))) - (if (not (string= "" sql-password)) - (setq params (append (list "-p" sql-password) params))) - (if (not (string= "" sql-database)) - (setq params (cons sql-database params))) ; add to the front! + (let ((params + (append + (if (not (string= "" sql-database)) + (list sql-database)) ; Add to the front! + (if (not (string= "" sql-password)) + (list "-p" sql-password)) + (if (not (string= "" sql-user)) + (list "-u" sql-user)) + options))) (sql-comint product params))) @@ -4922,19 +4925,18 @@ buffer. "Create comint buffer and connect to Linter." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. - (let ((params options) - (login nil) - (old-mbx (getenv "LINTER_MBX"))) - (if (not (string= "" sql-user)) - (setq login (concat sql-user "/" sql-password))) - (setq params (append (list "-u" login) params)) - (if (not (string= "" sql-server)) - (setq params (append (list "-n" sql-server) params))) - (if (string= "" sql-database) - (setenv "LINTER_MBX" nil) - (setenv "LINTER_MBX" sql-database)) - (sql-comint product params) - (setenv "LINTER_MBX" old-mbx))) + (let* ((login + (if (not (string= "" sql-user)) + (concat sql-user "/" sql-password))) + (params + (append + (if (not (string= "" sql-server)) + (list "-n" sql-server)) + (list "-u" login) + options))) + (cl-letf (((getenv "LINTER_MBX") + (unless (string= "" sql-database) sql-database))) + (sql-comint product params)))) -- 2.39.5