[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r111130: * lisp/progmodes/sql.el: Use
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r111130: * lisp/progmodes/sql.el: Use cl-lib and lexical-binding; various cleanup. |
|
Date: |
Thu, 06 Dec 2012 12:29:30 -0500 |
|
User-agent: |
Bazaar (2.5.0) |
------------------------------------------------------------
revno: 111130
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Thu 2012-12-06 12:29:30 -0500
message:
* 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.
modified:
lisp/ChangeLog
lisp/progmodes/sql.el
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2012-12-06 16:17:11 +0000
+++ b/lisp/ChangeLog 2012-12-06 17:29:30 +0000
@@ -1,5 +1,20 @@
2012-12-06 Stefan Monnier <address@hidden>
+ * 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.
=== modified file 'lisp/progmodes/sql.el'
--- a/lisp/progmodes/sql.el 2012-11-21 21:47:10 +0000
+++ b/lisp/progmodes/sql.el 2012-12-06 17:29:30 +0000
@@ -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
-;;
<URL:ftp://ftp.ifi.uio.no/pub/emacs/emacs-20.3/lisp/emacs-lisp/regexp-opt.el>
-;; and the custom package
-;; <URL:http://www.dina.kvl.dk/~abraham/custom/>.
-
;;; Bugs:
;; sql-ms now uses osql instead of isql. Osql flushes its error
@@ -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 @@
(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 @@
: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 @@
;; 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 @@
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 @@
(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 @@
;; 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 @@
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 @@
(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 @@
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 @@
"\\>")))
(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 @@
(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 @@
(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 @@
(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 @@
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 @@
(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 @@
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))
-
- ((eq token 'password) ; password
- (setq-default sql-password
- (sql-read-passwd "Password: " sql-password)))
-
- ((eq token 'server) ; 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))
-
- ((eq token 'port) ; port
- (sql-get-login-ext 'sql-port "Port: " nil (append '(:number t)
plist))))))
- what))
+ (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))
+
+ (`password
+ (setq-default sql-password
+ (read-passwd "Password: " nil sql-password)))
+
+ (`server
+ (sql-get-login-ext 'sql-server "Server: " 'sql-server-history plist))
+
+ (`database
+ (sql-get-login-ext 'sql-database "Database: "
+ 'sql-database-history plist))
+
+ (`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 @@
(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 @@
(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 @@
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 @@
(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 @@
(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 @@
(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 @@
(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 @@
(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 @@
;; 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 @@
(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 @@
(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 @@
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 @@
(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 @@
;; 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 @@
(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 @@
"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 @@
"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 @@
"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 @@
"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 @@
"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 @@
(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 "\\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)))
+ (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"))
+ (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 @@
"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 @@
"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))))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r111130: * lisp/progmodes/sql.el: Use cl-lib and lexical-binding; various cleanup.,
Stefan Monnier <=