;;; sql.el --- specialized comint.el for SQL interpreters -*- lexical-binding: t -*-
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2014 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Michael Mauger <michael@mauger.com>
-;; Version: 3.2
+;; Version: 3.4
;; Keywords: comm languages processes
;; URL: http://savannah.gnu.org/projects/emacs/
(require 'regexp-opt))
(require 'custom)
(require 'thingatpt)
+(require 'view)
(defvar font-lock-keyword-face)
(defvar font-lock-set-defaults)
:group 'languages
:group 'processes)
-;; These four variables will be used as defaults, if set.
+;; These five variables will be used as defaults, if set.
(defcustom sql-user ""
"Default username."
(define-widget 'sql-login-params 'lazy
"Widget definition of the login parameters list"
- ;; FIXME: does not implement :default property for the user,
- ;; database and server options. Anybody have some guidance on how to
- ;; do this.
:tag "Login Parameters"
- :type '(repeat (choice
- (const user)
- (const password)
- (choice :tag "server"
- (const server)
- (list :tag "file"
- (const :format "" server)
- (const :format "" :file)
- regexp)
- (list :tag "completion"
- (const :format "" server)
+ :type '(set :tag "Login Parameters"
+ (choice :tag "user"
+ :value user
+ (const user)
+ (list :tag "Specify a default"
+ (const user)
+ (list :tag "Default"
+ :inline t (const :default) string)))
+ (const password)
+ (choice :tag "server"
+ :value server
+ (const server)
+ (list :tag "Specify a default"
+ (const server)
+ (list :tag "Default"
+ :inline t (const :default) string))
+ (list :tag "file"
+ (const :format "" server)
+ (const :format "" :file)
+ regexp)
+ (list :tag "completion"
+ (const :format "" server)
+ (const :format "" :completion)
+ (restricted-sexp
+ :match-alternatives (listp stringp))))
+ (choice :tag "database"
+ :value database
+ (const database)
+ (list :tag "Specify a default"
+ (const database)
+ (list :tag "Default"
+ :inline t (const :default) string))
+ (list :tag "file"
+ (const :format "" database)
+ (const :format "" :file)
+ regexp)
+ (list :tag "completion"
+ (const :format "" database)
(const :format "" :completion)
(restricted-sexp
:match-alternatives (listp stringp))))
- (choice :tag "database"
- (const database)
- (list :tag "file"
- (const :format "" database)
- (const :format "" :file)
- regexp)
- (list :tag "completion"
- (const :format "" database)
- (const :format "" :completion)
- (restricted-sexp
- :match-alternatives (listp stringp))))
- (const port))))
+ (const port)))
;; SQL Product support
:completion-object sql-oracle-completion-object
:prompt-regexp "^SQL> "
:prompt-length 5
- :prompt-cont-regexp "^\\s-*[[:digit:]]+ "
+ :prompt-cont-regexp "^\\(?:[ ][ ][1-9]\\|[ ][1-9][0-9]\\|[1-9][0-9]\\{2\\}\\)[ ]\\{2\\}"
:statement sql-oracle-statement-starters
:syntax-alist ((?$ . "_") (?# . "_"))
:terminator ("\\(^/\\|;\\)$" . "/")
Globally should be set to nil; it will be non-nil in `sql-mode',
`sql-interactive-mode' and list all buffers.")
+(defvar sql-login-delay 7.5 ;; Secs
+ "Maximum number of seconds you are willing to wait for a login connection.")
(defcustom sql-pop-to-buffer-after-send-region nil
"When non-nil, pop to the buffer SQL statements are sent to.
:type 'file
:group 'SQL)
-(defcustom sql-oracle-options nil
+(defcustom sql-oracle-options '("-L")
"List of additional options for `sql-oracle-program'."
:type '(repeat string)
- :version "20.8"
+ :version "24.4"
:group 'SQL)
(defcustom sql-oracle-login-params '(user password database)
"\\)\\(?:\\s-.*\\)?\\(?:[-]\n.*\\)*$")
0 'font-lock-doc-face t)
+ '("&?&\\(?:\\sw\\|\\s_\\)+[.]?" 0 font-lock-preprocessor-face t)
;; Oracle Functions
(sql-font-lock-keywords-builder 'font-lock-builtin-face nil
(user-error "Product `%s' is already defined" product)
;; Add product to the alist
- (add-to-list 'sql-product-alist `((,product :name ,display . ,plist)))
+ (add-to-list 'sql-product-alist `(,product :name ,display . ,plist))
;; Add a menu item to the SQL->Product menu
(easy-menu-add-item sql-mode-menu '("Product")
;; Each product is represented by a radio
"]\n"))))
doc))
-;;;###autoload
-(eval
- ;; FIXME: This dynamic-docstring-function trick doesn't work for byte-compiled
- ;; functions, because of the lazy-loading of docstrings, which strips away
- ;; text properties.
- '(defun sql-help ()
- #("Show short help for the SQL modes.
+(defun sql-help ()
+ "Show short help for the SQL modes."
+ (interactive)
+ (describe-function 'sql-help))
+(put 'sql-help 'function-documentation '(sql--make-help-docstring))
+(defvar sql--help-docstring
+ "Show short help for the SQL modes.
Use an entry function to open an interactive SQL buffer. This buffer is
usually named `*SQL*'. The name of the major mode is SQLi.
In this SQL buffer (SQL mode), you can send the region or the entire
buffer to the interactive SQL buffer (SQLi mode). The results are
-appended to the SQLi buffer without disturbing your SQL buffer."
- 0 1 (dynamic-docstring-function sql--make-help-docstring))
- (interactive)
- (describe-function 'sql-help)))
-
-(defun sql--make-help-docstring (doc _fun)
- "Insert references to loaded products into the help buffer string."
-
- ;; Insert FREE software list
- (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]FREE\\s-*\n" doc 0)
- (setq doc (replace-match (sql-help-list-products (match-string 1 doc) t)
- t t doc 0)))
-
- ;; Insert non-FREE software list
- (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]NONFREE\\s-*\n" doc 0)
- (setq doc (replace-match (sql-help-list-products (match-string 1 doc) nil)
- t t doc 0)))
- doc)
+appended to the SQLi buffer without disturbing your SQL buffer.")
+
+(defun sql--make-help-docstring ()
+ "Return a docstring for `sql-help' listing loaded SQL products."
+ (let ((doc sql--help-docstring))
+ ;; Insert FREE software list
+ (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]FREE\\s-*$" doc 0)
+ (setq doc (replace-match (sql-help-list-products (match-string 1 doc) t)
+ t t doc 0)))
+ ;; Insert non-FREE software list
+ (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]NONFREE\\s-*$" doc 0)
+ (setq doc (replace-match (sql-help-list-products (match-string 1 doc) nil)
+ t t doc 0)))
+ doc))
(defun sql-default-value (var)
"Fetch the value of a variable.
Placeholders are words starting with an ampersand like &this."
(when sql-oracle-scan-on
- (while (string-match "&\\(\\sw+\\)" string)
+ (while (string-match "&?&\\(\\(?:\\sw\\|\\s_\\)+\\)[.]?" string)
(setq string (replace-match
(read-from-minibuffer
(format "Enter value for %s: " (match-string 1 string))
(defvar sql-preoutput-hold nil)
+(defun sql-starts-with-prompt-re ()
+ "Anchor the prompt expression at the beginning of the output line.
+Remove the start of line regexp."
+ (replace-regexp-in-string "\\^" "\\\\`" comint-prompt-regexp))
+
+(defun sql-ends-with-prompt-re ()
+ "Anchor the prompt expression at the end of the output line.
+Remove the start of line regexp from the prompt expression since
+it may not follow newline characters in the output line."
+ (concat (replace-regexp-in-string "\\^" "" sql-prompt-regexp) "\\'"))
+
(defun sql-interactive-remove-continuation-prompt (oline)
"Strip out continuation prompts out of the OLINE.
If the filter gets confused, it should reset and stop filtering
to avoid deleting non-prompt output."
- (let (did-filter)
- (setq oline (concat (or sql-preoutput-hold "") oline)
- sql-preoutput-hold nil)
-
- (if (and comint-prompt-regexp
- (integerp sql-output-newline-count)
- (>= sql-output-newline-count 1))
- (progn
- (while (and (not (string= oline ""))
- (> sql-output-newline-count 0)
- (string-match comint-prompt-regexp oline)
- (= (match-beginning 0) 0))
+ (when comint-prompt-regexp
+ (save-match-data
+ (let (prompt-found last-nl)
- (setq oline (replace-match "" nil nil oline)
- sql-output-newline-count (1- sql-output-newline-count)
- did-filter t))
+ ;; Add this text to what's left from the last pass
+ (setq oline (concat sql-preoutput-hold oline)
+ sql-preoutput-hold "")
+ ;; If we are looking for multiple prompts
+ (when (and (integerp sql-output-newline-count)
+ (>= sql-output-newline-count 1))
+ ;; Loop thru each starting prompt and remove it
+ (let ((start-re (sql-starts-with-prompt-re)))
+ (while (and (not (string= oline ""))
+ (> sql-output-newline-count 0)
+ (string-match start-re oline))
+ (setq oline (replace-match "" nil nil oline)
+ sql-output-newline-count (1- sql-output-newline-count)
+ prompt-found t)))
+
+ ;; If we've found all the expected prompts, stop looking
(if (= sql-output-newline-count 0)
(setq sql-output-newline-count nil
oline (concat "\n" oline))
+ ;; Still more possible prompts, leave them for the next pass
(setq sql-preoutput-hold oline
- oline ""))
-
- (unless did-filter
- (setq oline (or sql-preoutput-hold "")
- sql-preoutput-hold nil
- sql-output-newline-count nil)))
-
- (setq sql-output-newline-count nil))
-
- oline))
+ oline "")))
+
+ ;; If no prompts were found, stop looking
+ (unless prompt-found
+ (setq sql-output-newline-count nil
+ oline (concat oline sql-preoutput-hold)
+ sql-preoutput-hold ""))
+
+ ;; Break up output by physical lines if we haven't hit the final prompt
+ (unless (and (not (string= oline ""))
+ (string-match (sql-ends-with-prompt-re) oline)
+ (>= (match-end 0) (length oline)))
+ (setq last-nl 0)
+ (while (string-match "\n" oline last-nl)
+ (setq last-nl (match-end 0)))
+ (setq sql-preoutput-hold (concat (substring oline last-nl)
+ sql-preoutput-hold)
+ oline (substring oline 0 last-nl))))))
+ oline)
;;; Sending the region to the SQLi buffer.
:prompt-regexp))
(start nil))
(with-current-buffer buf
- (setq view-read-only nil)
+ (setq-local view-no-disable-on-exit t)
+ (read-only-mode -1)
(unless save-prior
(erase-buffer))
(goto-char (point-max))
(get-lru-window))))
(with-current-buffer outbuf
(set-buffer-modified-p nil)
- (setq view-read-only t))
- (view-buffer-other-window outbuf)
+ (read-only-mode +1))
+ (pop-to-buffer outbuf)
(when one-win
(shrink-window-if-larger-than-buffer)))))
(buffer-substring-no-properties (match-beginning 0)
(match-end 0))))
(sql-completion-sqlbuf (sql-find-sqli-buffer))
- (product (with-current-buffer sql-completion-sqlbuf sql-product))
+ (product (when sql-completion-sqlbuf
+ (with-current-buffer sql-completion-sqlbuf sql-product)))
(completion-ignore-case t))
- (if (sql-get-product-feature product :completion-object)
- (completing-read prompt #'sql--completion-table
- nil nil tname)
- (read-from-minibuffer prompt tname))))
+ (if product
+ (if (sql-get-product-feature product :completion-object)
+ (completing-read prompt #'sql--completion-table
+ nil nil tname)
+ (read-from-minibuffer prompt tname))
+ (user-error "There is no active SQLi buffer"))))
(defun sql-list-all (&optional enhanced)
"List all database objects.
(setq-local abbrev-all-caps 1)
;; Contains the name of database objects
(set (make-local-variable 'sql-contains-names) t)
+ ;; Set syntax and font-face highlighting
;; Catch changes to sql-product and highlight accordingly
+ (sql-set-product (or sql-product 'ansi)) ; Fixes bug#13591
(add-hook 'hack-local-variables-hook 'sql-highlight-product t t))
\f
;; People wanting a different history file for each
;; buffer/process/client/whatever can change separator and file-name
;; on the sql-interactive-mode-hook.
- (setq comint-input-ring-separator sql-input-ring-separator
- comint-input-ring-file-name sql-input-ring-file-name)
+ (setq-local comint-input-ring-separator sql-input-ring-separator)
+ (setq comint-input-ring-file-name sql-input-ring-file-name)
;; Calling the hook before calling comint-read-input-ring allows users
;; to set comint-input-ring-file-name in sql-interactive-mode-hook.
(comint-read-input-ring t))
;; We have a new name or sql-buffer doesn't exist or match
;; Start by remembering where we start
(let ((start-buffer (current-buffer))
- new-sqli-buffer)
+ new-sqli-buffer rpt)
;; Get credentials.
(apply #'sql-get-login
(sql-get-product-feature product :sqli-login))
;; Connect to database.
- (message "Login...")
+ (setq rpt (make-progress-reporter "Login"))
+
(let ((sql-user (default-value 'sql-user))
(sql-password (default-value 'sql-password))
(sql-server (default-value 'sql-server))
;; Make sure the connection is complete
;; (Sometimes start up can be slow)
;; and call the login hook
- (let ((proc (get-buffer-process new-sqli-buffer)))
+ (let ((proc (get-buffer-process new-sqli-buffer))
+ (secs sql-login-delay)
+ (step 0.3))
(while (and (memq (process-status proc) '(open run))
- (accept-process-output proc 2.5)
+ (or (accept-process-output proc step)
+ (<= 0.0 (setq secs (- secs step))))
(progn (goto-char (point-max))
- (not (looking-back sql-prompt-regexp))))))
- (run-hooks 'sql-login-hook)
+ (not (re-search-backward sql-prompt-regexp 0 t))))
+ (progress-reporter-update rpt)))
+
+ (goto-char (point-max))
+ (when (re-search-backward sql-prompt-regexp nil t)
+ (run-hooks 'sql-login-hook))
+
;; All done.
- (message "Login...done")
- (pop-to-buffer new-sqli-buffer)))))
+ (progress-reporter-done rpt)
+ (pop-to-buffer new-sqli-buffer)
+ (goto-char (point-max))
+ (current-buffer)))))
(user-error "No default SQL product defined. Set `sql-product'.")))
(defun sql-comint (product params)
(setq parameter sql-user)))
(if (and parameter (not (string= "" sql-database)))
(setq parameter (concat parameter "@" sql-database)))
+ ;; options must appear before the logon parameters
(if parameter
- (setq parameter (nconc (list parameter) options))
+ (setq parameter (append options (list parameter)))
(setq parameter options))
(sql-comint product parameter)
;; Set process coding system to agree with the interpreter
HCoop / bpt / emacs.git / blobdiff