]> code.delx.au - gnu-emacs/blobdiff - lisp/progmodes/sql.el
; Spelling fix (American spelling)
[gnu-emacs] / lisp / progmodes / sql.el
index af7cb0dc2f52a18dd9d177d8ee46cdf41ae4f0c6..65e94bac5d31fd35f9d3c866be3792f23d43c68a 100644 (file)
@@ -1,10 +1,10 @@
 ;;; sql.el --- specialized comint.el for SQL interpreters  -*- lexical-binding: t -*-
 
-;; Copyright (C) 1998-2014 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2016 Free Software Foundation, Inc.
 
 ;; Author: Alex Schroeder <alex@gnu.org>
 ;; Maintainer: Michael Mauger <michael@mauger.com>
-;; Version: 3.4
+;; Version: 3.5
 ;; Keywords: comm languages processes
 ;; URL: http://savannah.gnu.org/projects/emacs/
 
@@ -360,7 +360,7 @@ file.  Since that is a plaintext file, this could be dangerous."
      :sqli-comint-func sql-comint-db2
      :prompt-regexp "^db2 => "
      :prompt-length 7
-     :prompt-cont-regexp "^db2 (cont\.) => "
+     :prompt-cont-regexp "^db2 (cont\\.) => "
      :input-filter sql-escape-newlines-filter)
 
     (informix
@@ -381,9 +381,9 @@ file.  Since that is a plaintext file, this could be dangerous."
      :sqli-options sql-ingres-options
      :sqli-login sql-ingres-login-params
      :sqli-comint-func sql-comint-ingres
-     :prompt-regexp "^\* "
+     :prompt-regexp "^\\* "
      :prompt-length 2
-     :prompt-cont-regexp "^\* ")
+     :prompt-cont-regexp "^\\* ")
 
     (interbase
      :name "Interbase"
@@ -491,7 +491,7 @@ file.  Since that is a plaintext file, this could be dangerous."
      :completion-object sql-sqlite-completion-object
      :prompt-regexp "^sqlite> "
      :prompt-length 8
-     :prompt-cont-regexp "^   \.\.\.> "
+     :prompt-cont-regexp "^   \\.\\.\\.> "
      :terminator ";")
 
     (sybase
@@ -525,7 +525,7 @@ highlighted and will not support `sql-interactive-mode'.
 
 Each element in the list is in the following format:
 
\(PRODUCT FEATURE VALUE ...)
+ (PRODUCT FEATURE VALUE ...)
 
 where PRODUCT is the appropriate value of `sql-product'.  The
 product name is then followed by FEATURE-VALUE pairs.  If a
@@ -639,7 +639,7 @@ settings.")
   "An alist of connection parameters for interacting with a SQL product.
 Each element of the alist is as follows:
 
-  \(CONNECTION \(SQL-VARIABLE VALUE) ...)
+  (CONNECTION \(SQL-VARIABLE VALUE) ...)
 
 Where CONNECTION is a case-insensitive string identifying the
 connection, SQL-VARIABLE is the symbol name of a SQL mode
@@ -1577,8 +1577,6 @@ to add functions and PL/SQL keywords.")
      ;; Oracle SQL*Plus Commands
      ;;   Only recognized in they start in column 1 and the
      ;;   abbreviation is followed by a space or the end of line.
-
-     "\\|"
      (list (concat "^" (sql-regexp-abbrev "rem~ark") "\\(?:\\s-.*\\)?$")
            0 'font-lock-comment-face t)
 
@@ -1626,6 +1624,11 @@ to add functions and PL/SQL keywords.")
       0 'font-lock-doc-face t)
      '("&?&\\(?:\\sw\\|\\s_\\)+[.]?" 0 font-lock-preprocessor-face t)
 
+     ;; Oracle PL/SQL Attributes (Declare these first to match %TYPE correctly)
+     (sql-font-lock-keywords-builder 'font-lock-builtin-face '("%" . "\\b")
+"bulk_exceptions" "bulk_rowcount" "found" "isopen" "notfound"
+"rowcount" "rowtype" "type"
+)
      ;; Oracle Functions
      (sql-font-lock-keywords-builder 'font-lock-builtin-face nil
 "abs" "acos" "add_months" "appendchildxml" "ascii" "asciistr" "asin"
@@ -1655,7 +1658,7 @@ to add functions and PL/SQL keywords.")
 "prediction" "prediction_bounds" "prediction_cost"
 "prediction_details" "prediction_probability" "prediction_set"
 "presentnnv" "presentv" "previous" "rank" "ratio_to_report" "rawtohex"
-"rawtonhex" "ref" "reftohex" "regexp_count" "regexp_instr"
+"rawtonhex" "ref" "reftohex" "regexp_count" "regexp_instr" "regexp_like"
 "regexp_replace" "regexp_substr" "regr_avgx" "regr_avgy" "regr_count"
 "regr_intercept" "regr_r2" "regr_slope" "regr_sxx" "regr_sxy"
 "regr_syy" "remainder" "replace" "round" "rowidtochar" "rowidtonchar"
@@ -1740,7 +1743,7 @@ to add functions and PL/SQL keywords.")
 "password_life_time" "password_lock_time" "password_reuse_max"
 "password_reuse_time" "password_verify_function" "pctfree"
 "pctincrease" "pctthreshold" "pctused" "pctversion" "percent"
-"performance" "permanent" "pfile" "physical" "pipelined" "plan"
+"performance" "permanent" "pfile" "physical" "pipelined" "pivot" "plan"
 "post_transaction" "pragma" "prebuilt" "preserve" "primary" "private"
 "private_sga" "privileges" "procedure" "profile" "protection" "public"
 "purge" "query" "quiesce" "quota" "range" "read" "reads" "rebuild"
@@ -1763,7 +1766,7 @@ to add functions and PL/SQL keywords.")
 "temporary" "test" "than" "then" "thread" "through" "time_zone"
 "timeout" "to" "trace" "transaction" "trigger" "triggers" "truncate"
 "trust" "type" "types" "unarchived" "under" "under_path" "undo"
-"uniform" "union" "unique" "unlimited" "unlock" "unquiesce"
+"uniform" "union" "unique" "unlimited" "unlock" "unpivot" "unquiesce"
 "unrecoverable" "until" "unusable" "unused" "update" "upgrade" "usage"
 "use" "using" "validate" "validation" "value" "values" "variable"
 "varray" "version" "view" "wait" "when" "whenever" "where" "with"
@@ -1776,12 +1779,6 @@ to add functions and PL/SQL keywords.")
 "clob" "date" "day" "float" "interval" "local" "long" "longraw"
 "minute" "month" "nchar" "nclob" "number" "nvarchar2" "raw" "rowid" "second"
 "time" "timestamp" "urowid" "varchar2" "with" "year" "zone"
-)
-
-     ;; Oracle PL/SQL Attributes
-     (sql-font-lock-keywords-builder 'font-lock-builtin-face '("%" . "\\b")
-"bulk_exceptions" "bulk_rowcount" "found" "isopen" "notfound"
-"rowcount" "rowtype" "type"
 )
 
      ;; Oracle PL/SQL Functions
@@ -2612,8 +2609,8 @@ of the current highlighting list.
 
 For example:
 
- (sql-add-product-keywords 'ms
-  '((\"\\\\b\\\\w+_t\\\\b\" . font-lock-type-face)))
+ (sql-add-product-keywords \\='ms
+  \\='((\"\\\\b\\\\w+_t\\\\b\" . font-lock-type-face)))
 
 adds a fontification pattern to fontify identifiers ending in
 `_t' as data types."
@@ -2990,7 +2987,7 @@ supported:
     :number t
 
 In order to ask the user for username, password and database, call the
-function like this: (sql-get-login 'user 'password 'database)."
+function like this: (sql-get-login \\='user \\='password \\='database)."
   (dolist (w what)
     (let ((plist (cdr-safe w)))
       (pcase (or (car-safe w) w)
@@ -3299,13 +3296,13 @@ Allows the suppression of continuation prompts.")
 (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))
+  (concat "\\`" 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) "\\'"))
+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.
@@ -3324,7 +3321,17 @@ 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."
 
-  (when comint-prompt-regexp
+  ;; 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
+  (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)
+                          (string-match sql-prompt-cont-regexp oline)))))
+
     (save-match-data
       (let (prompt-found last-nl)
 
@@ -3360,16 +3367,19 @@ to avoid deleting non-prompt output."
                 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)
+        (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)))))))
+  oline)
 
 ;;; Sending the region to the SQLi buffer.
 
@@ -3507,45 +3517,51 @@ list of SQLi command strings."
       (message "Executing SQL command...done"))))
 
 (defun sql-redirect-one (sqlbuf command outbuf save-prior)
-  (with-current-buffer sqlbuf
-    (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
-        (setq-local view-no-disable-on-exit t)
-        (read-only-mode -1)
-        (unless save-prior
-          (erase-buffer))
-        (goto-char (point-max))
-        (unless (zerop (buffer-size))
-          (insert "\n"))
-        (setq start (point)))
-
-      (when sql-debug-redirect
-        (message ">>SQL> %S" command))
-
-      ;; Run the command
-      (comint-redirect-send-command-to-process command buf proc nil t)
-      (while (null comint-redirect-completed)
-       (accept-process-output nil 1))
-
-      ;; 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)))
-        ;; Remove Ctrl-Ms
-        (goto-char start)
-        (while (re-search-forward "\r+$" nil t)
-          (replace-match "" t t))
-        (goto-char start)))))
+  (when command
+    (with-current-buffer sqlbuf
+      (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
+          (setq-local view-no-disable-on-exit t)
+          (read-only-mode -1)
+          (unless save-prior
+            (erase-buffer))
+          (goto-char (point-max))
+          (unless (zerop (buffer-size))
+            (insert "\n"))
+          (setq start (point)))
+
+        (when sql-debug-redirect
+          (message ">>SQL> %S" command))
+
+        ;; Run the command
+        (let ((inhibit-quit t)
+              comint-preoutput-filter-functions)
+          (with-local-quit
+            (comint-redirect-send-command-to-process command buf proc nil t)
+            (while (or quit-flag (null comint-redirect-completed))
+              (accept-process-output nil 1)))
+
+          (if quit-flag
+              (comint-redirect-cleanup)
+            ;; 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)))
+              ;; Remove Ctrl-Ms
+              (goto-char start)
+              (while (re-search-forward "\r+$" nil t)
+                (replace-match "" t t))
+              (goto-char start))))))))
 
 (defun sql-redirect-value (sqlbuf command regexp &optional regexp-groups)
   "Execute the SQL command and return part of result.
@@ -3783,10 +3799,12 @@ Note that SQL doesn't have an escape character unless you specify
 one.  If you specify backslash as escape character in SQL, you
 must tell Emacs.  Here's how to do that in your init file:
 
-\(add-hook 'sql-mode-hook
+\(add-hook \\='sql-mode-hook
           (lambda ()
            (modify-syntax-entry ?\\\\ \".\" sql-mode-syntax-table)))"
+  :group 'SQL
   :abbrev-table sql-mode-abbrev-table
+
   (if sql-mode-menu
       (easy-menu-add sql-mode-menu)); XEmacs
 
@@ -3817,6 +3835,7 @@ must tell Emacs.  Here's how to do that in your init file:
 ;;; SQL interactive mode
 
 (put 'sql-interactive-mode 'mode-class 'special)
+(put 'sql-interactive-mode 'custom-mode-group 'SQL)
 
 (defun sql-interactive-mode ()
   "Major mode to use a SQL interpreter interactively.
@@ -3877,15 +3896,15 @@ If you want to make SQL buffers limited in length, add the function
 Here is an example for your init file.  It keeps the SQLi buffer a
 certain length.
 
-\(add-hook 'sql-interactive-mode-hook
-    \(function (lambda ()
-        \(setq comint-output-filter-functions 'comint-truncate-buffer))))
+\(add-hook \\='sql-interactive-mode-hook
+    (function (lambda ()
+        (setq comint-output-filter-functions \\='comint-truncate-buffer))))
 
 Here is another example.  It will always put point back to the statement
 you entered, right above the output it created.
 
 \(setq comint-output-filter-functions
-       \(function (lambda (STR) (comint-show-output))))"
+       (function (lambda (STR) (comint-show-output))))"
   (delay-mode-hooks (comint-mode))
 
   ;; Get the `sql-product' for this interactive session.
@@ -3959,11 +3978,10 @@ you entered, right above the output it created.
   ;; 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-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))
+  (let
+      ((comint-input-ring-separator sql-input-ring-separator)
+       (comint-input-ring-file-name sql-input-ring-file-name))
+    (comint-read-input-ring t)))
 
 (defun sql-stop (process event)
   "Called when the SQL process is stopped.
@@ -3973,11 +3991,15 @@ Writes the input history to a history file using
 
 This function is a sentinel watching the SQL interpreter process.
 Sentinels will always get the two parameters PROCESS and EVENT."
-  (comint-write-input-ring)
-  (if (and (eq (current-buffer) sql-buffer)
-          (not buffer-read-only))
-      (insert (format "\nProcess %s %s\n" process event))
-    (message "Process %s %s" process event)))
+  (with-current-buffer (process-buffer process)
+    (let
+        ((comint-input-ring-separator sql-input-ring-separator)
+         (comint-input-ring-file-name sql-input-ring-file-name))
+      (comint-write-input-ring))
+
+    (if (not buffer-read-only)
+        (insert (format "\nProcess %s %s\n" process event))
+      (message "Process %s %s" process event))))
 
 \f
 
@@ -4254,7 +4276,7 @@ passed as command line arguments."
     ;; work for remote hosts; we suppress the check there.
     (unless (or (file-remote-p default-directory)
                (executable-find program))
-      (error "Unable to locate SQL program \'%s\'" 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))
@@ -4869,7 +4891,7 @@ your might try undecided-dos as a coding system.  If this doesn't help,
 Try to set `comint-output-filter-functions' like this:
 
 \(setq comint-output-filter-functions (append comint-output-filter-functions
-                                            '(comint-strip-ctrl-m)))
+                                            \\='(comint-strip-ctrl-m)))
 
 \(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
   (interactive "P")