diff options
Diffstat (limited to 'lisp/progmodes/sql.el')
| -rw-r--r-- | lisp/progmodes/sql.el | 229 |
1 files changed, 106 insertions, 123 deletions
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 6183aee20e3..8d259860901 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -481,9 +481,9 @@ file. Since that is a plaintext file, this could be dangerous." :list-all ("\\d+" . "\\dS+") :list-table ("\\d+ %s" . "\\dS+ %s") :completion-object sql-postgres-completion-object - :prompt-regexp "^[[:alnum:]_]*=[#>] " + :prompt-regexp "^[-[:alnum:]_]*[-=][#>] " :prompt-length 5 - :prompt-cont-regexp "^[[:alnum:]_]*[-(][#>] " + :prompt-cont-regexp "^[-[:alnum:]_]*[-'(][#>] " :statement sql-postgres-statement-starters :input-filter sql-remove-tabs-filter :terminator ("\\(^\\s-*\\\\g\\|;\\)" . "\\g")) @@ -700,8 +700,17 @@ making new SQLi sessions." (sexp :tag "Value Expression"))))) :version "24.1") -(defvaralias 'sql-dialect 'sql-product) +(defun sql-add-connection (connection params) + "Add a new connection to `sql-connection-alist'. +If CONNECTION already exists, it is replaced with PARAMS." + (setq sql-connection-alist + (assoc-delete-all connection sql-connection-alist)) + (push + (cons connection params) + sql-connection-alist)) + +(defvaralias 'sql-dialect 'sql-product) (defcustom sql-product 'ansi "Select the SQL database product used. This allows highlighting buffers properly when you open them." @@ -963,12 +972,7 @@ If set to \"\\n\", each line in the history file will be interpreted as one command. Multi-line commands are split into several commands when the input ring is initialized from a history file. -This variable used to initialize `comint-input-ring-separator'. -`comint-input-ring-separator' is part of Emacs 21; if your Emacs -does not have it, setting `sql-input-ring-separator' will have no -effect. In that case multiline commands will be split into several -commands when the input history is read, as if you had set -`sql-input-ring-separator' to \"\\n\"." +This variable used to initialize `comint-input-ring-separator'." :type 'string) ;; The usual hooks @@ -1357,8 +1361,6 @@ specified, it's `sql-product' or `sql-connection' must match." (defvar sql-interactive-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map comint-mode-map) - (if (fboundp 'set-keymap-name) - (set-keymap-name map 'sql-interactive-mode-map)); XEmacs (define-key map (kbd "C-j") 'sql-accumulate-and-indent) (define-key map (kbd "C-c C-w") 'sql-copy-column) (define-key map (kbd "O") 'sql-magic-go) @@ -2832,16 +2834,6 @@ configured." (font-lock-mode-internal nil) (font-lock-mode-internal t)) - (add-hook 'font-lock-mode-hook - (lambda () - ;; Provide defaults for new font-lock faces. - (defvar font-lock-builtin-face - (if (boundp 'font-lock-preprocessor-face) - font-lock-preprocessor-face - font-lock-keyword-face)) - (defvar font-lock-doc-face font-lock-string-face)) - nil t) - ;; Setup imenu; it needs the same syntax-alist. (when imenu (setq imenu-syntax-alist syntax-alist)))) @@ -3219,19 +3211,12 @@ For both `:file' and `:completion', there can also be a symbol (let* ((default (plist-get plist :default)) (last-value (sql-default-value symbol)) - (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)) + (prompt-def (format-prompt prompt default)) (use-dialog-box nil)) (cond ((plist-member plist :file) (let ((file-name - (read-file-name prompt + (read-file-name prompt-def (file-name-directory last-value) default (if (plist-member plist :must-match) @@ -3261,7 +3246,7 @@ For both `:file' and `:completion', there can also be a default)) ((plist-get plist :number) - (read-number prompt (or default last-value 0))) + (read-number (concat prompt ": ") (or default last-value 0))) (t (read-string prompt-def last-value history-var default)))))) @@ -3311,7 +3296,7 @@ function like this: (sql-get-login \\='user \\='password \\='database)." (let ((plist (cdr-safe w))) (pcase (or (car-safe w) w) ('user - (sql-get-login-ext 'sql-user "User: " 'sql-user-history plist)) + (sql-get-login-ext 'sql-user "User" 'sql-user-history plist)) ('password (setq-default sql-password @@ -3330,14 +3315,14 @@ function like this: (sql-get-login \\='user \\='password \\='database)." (read-passwd "Password: " nil (sql-default-value 'sql-password))))) ('server - (sql-get-login-ext 'sql-server "Server: " 'sql-server-history plist)) + (sql-get-login-ext 'sql-server "Server" 'sql-server-history plist)) ('database - (sql-get-login-ext 'sql-database "Database: " + (sql-get-login-ext 'sql-database "Database" 'sql-database-history plist)) ('port - (sql-get-login-ext 'sql-port "Port: " + (sql-get-login-ext 'sql-port "Port" nil (append '(:number t) plist))))))) (defun sql-find-sqli-buffer (&optional product connection) @@ -3663,94 +3648,69 @@ Allows the suppression of continuation prompts.") (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." - (concat "\\`" comint-prompt-regexp)) - -(defun sql-ends-with-prompt-re () - "Anchor the prompt expression at the end of the output line. -Match a SQL prompt or a password prompt." - (concat "\\(?:\\(?:" sql-prompt-regexp "\\)\\|" - "\\(?:" comint-password-prompt-regexp "\\)\\)\\'")) - (defun sql-interactive-remove-continuation-prompt (oline) "Strip out continuation prompts out of the OLINE. Added to the `comint-preoutput-filter-functions' hook in a SQL -interactive buffer. If `sql-output-newline-count' is greater than -zero, then an output line matching the continuation prompt is filtered -out. If the count is zero, then a newline is inserted into the output -to force the output from the query to appear on a new line. - -The complication to this filter is that the continuation prompts -may arrive in multiple chunks. If they do, then the function -saves any unfiltered output in a buffer and prepends that buffer -to the next chunk to properly match the broken-up prompt. - -If the filter gets confused, it should reset and stop filtering -to avoid deleting non-prompt output." - - ;; continue gathering lines of text iff - ;; + we know what a prompt looks like, and - ;; + there is held text, or - ;; + there are continuation prompt yet to come, or - ;; + not just a prompt string +interactive buffer. The complication to this filter is that the +continuation prompts may arrive in multiple chunks. If they do, +then the function saves any unfiltered output in a buffer and +prepends that buffer to the next chunk to properly match the +broken-up prompt. + +The filter goes into play only if something is already +accumulated, or we're waiting for continuation +prompts (`sql-output-newline-count' is positive). In this case: +- Accumulate process output into `sql-preoutput-hold'. +- Remove any complete prompts / continuation prompts that we're waiting + for. +- In case we're expecting more prompts - return all currently + accumulated _complete_ lines, leaving the rest for the next + invocation. They will appear in the output immediately. This way we + don't accumulate large chunks of data for no reason. +- If we found all expected prompts - just return all current accumulated + data." (when (and comint-prompt-regexp - (or (> (length (or sql-preoutput-hold "")) 0) - (> (or sql-output-newline-count 0) 0) - (not (or (string-match sql-prompt-regexp oline) - (and sql-prompt-cont-regexp - (string-match sql-prompt-cont-regexp oline)))))) - + ;; We either already have something held, or expect + ;; prompts + (or sql-preoutput-hold + (and sql-output-newline-count + (> sql-output-newline-count 0)))) (save-match-data - (let (prompt-found last-nl) - - ;; 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) - - ;; Still more possible prompts, leave them for the next pass - (setq sql-preoutput-hold 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 - (let ((end-re (sql-ends-with-prompt-re))) - (unless (and (not (string= oline "")) - (string-match end-re oline) - (>= (match-end 0) (length oline))) - ;; Find everything upto the last nl - (setq last-nl 0) - (while (string-match "\n" oline last-nl) - (setq last-nl (match-end 0))) - ;; Hold after the last nl, return upto last nl - (setq sql-preoutput-hold (concat (substring oline last-nl) - sql-preoutput-hold) - oline (substring oline 0 last-nl))))))) + ;; Add this text to what's left from the last pass + (setq oline (concat sql-preoutput-hold oline) + sql-preoutput-hold nil) + + ;; If we are looking for prompts + (when (and sql-output-newline-count + (> sql-output-newline-count 0)) + ;; Loop thru each starting prompt and remove it + (while (and (not (string-empty-p oline)) + (> sql-output-newline-count 0) + (string-match comint-prompt-regexp oline)) + (setq oline (replace-match "" nil nil oline) + sql-output-newline-count (1- sql-output-newline-count))) + + ;; If we've found all the expected prompts, stop looking + (if (= sql-output-newline-count 0) + (setq sql-output-newline-count nil) + ;; Still more possible prompts, leave them for the next pass + (setq sql-preoutput-hold oline + oline ""))) + + ;; Lines that are now complete may be passed further + (when sql-preoutput-hold + (let ((last-nl 0)) + (while (string-match "\n" sql-preoutput-hold last-nl) + (setq last-nl (match-end 0))) + ;; Return up to last nl, hold after the last nl + (setq oline (substring sql-preoutput-hold 0 last-nl) + sql-preoutput-hold (substring sql-preoutput-hold last-nl)) + (when (string-empty-p sql-preoutput-hold) + (setq sql-preoutput-hold nil)))))) oline) + ;;; Sending the region to the SQLi buffer. (defvar sql-debug-send nil "Display text sent to SQL process pragmatically.") @@ -4182,10 +4142,6 @@ must tell Emacs. Here's how to do that in your init file: (modify-syntax-entry ?\\\\ \"\\\\\" sql-mode-syntax-table)))" :abbrev-table sql-mode-abbrev-table - (when (and (featurep 'xemacs) - sql-mode-menu) - (easy-menu-add sql-mode-menu)) - ;; (smie-setup sql-smie-grammar #'sql-smie-rules) (setq-local comment-start "--") ;; Make each buffer in sql-mode remember the "current" SQLi buffer. @@ -4203,6 +4159,7 @@ must tell Emacs. Here's how to do that in your init file: (setq-local abbrev-all-caps 1) ;; Contains the name of database objects (setq-local sql-contains-names t) + (setq-local escaped-string-quote "'") (setq-local syntax-propertize-function (syntax-propertize-rules ;; Handle escaped apostrophes within strings. @@ -4214,7 +4171,18 @@ must tell Emacs. Here's how to do that in your init file: nil))) ;; Propertize rules to not have /- and -* start comments. ("\\(/-\\)" (1 ".")) - ("\\(-\\*\\)" (1 ".")))) + ("\\(-\\*\\)" + (1 + (if (save-excursion + (not (ppss-comment-depth + (syntax-ppss (match-beginning 1))))) + ;; If we're outside a comment, we don't let -* + ;; start a comment. + (string-to-syntax ".") + ;; Inside a comment, ignore it to avoid -*/ not + ;; being interpreted as a comment end. + (forward-char -1) + nil))))) ;; Set syntax and font-face highlighting ;; Catch changes to sql-product and highlight accordingly (sql-set-product (or sql-product 'ansi)) ; Fixes bug#13591 @@ -4308,9 +4276,6 @@ you entered, right above the output it created. (setq mode-name (concat "SQLi[" (or (sql-get-product-feature sql-product :name) (symbol-name sql-product)) "]")) - (when (and (featurep 'xemacs) - sql-interactive-mode-menu) - (easy-menu-add sql-interactive-mode-menu)) ;; 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 @@ -4655,6 +4620,9 @@ the call to \\[sql-product-interactive] with (setq sql-buffer (buffer-name new-sqli-buffer)) (run-hooks 'sql-set-sqli-hook))) + ;; Also set the global value. + (setq-default sql-buffer (buffer-name new-sqli-buffer)) + ;; Make sure the connection is complete ;; (Sometimes start up can be slow) ;; and call the login hook @@ -4681,6 +4649,14 @@ the call to \\[sql-product-interactive] with (get-buffer new-sqli-buffer))))) (user-error "No default SQL product defined: set `sql-product'"))) +(defun sql-comint-automatic-password (_) + "Intercept password prompts when we know the password. +This must also do the job of detecting password prompts." + (when (and + sql-password + (not (string= "" sql-password))) + sql-password)) + (defun sql-comint (product params &optional buf-name) "Set up a comint buffer to run the SQL processor. @@ -4705,6 +4681,13 @@ buffer. If nil, a name is chosen for it." (setq buf-name (sql-generate-unique-sqli-buffer-name product nil))) (set-text-properties 0 (length buf-name) nil buf-name) + ;; Create the buffer first, because we want to set it up before + ;; comint starts to run. + (set-buffer (get-buffer-create buf-name)) + ;; Set up the automatic population of passwords, if supported. + (when (sql-get-product-feature product :password-in-comint) + (setq comint-password-function #'sql-comint-automatic-password)) + ;; Start the command interpreter in the buffer ;; PROC-NAME is BUF-NAME without enclosing asterisks (let ((proc-name (replace-regexp-in-string "\\`[*]\\(.*\\)[*]\\'" "\\1" buf-name))) |