diff options
| author | Filipp Gunbin | 2022-05-03 12:35:34 +0200 |
|---|---|---|
| committer | Lars Ingebrigtsen | 2022-05-03 12:35:34 +0200 |
| commit | 0b626ff8d6a29c452bc8bbbee79f5eff11d02548 (patch) | |
| tree | 93e617a9bfae56b0ec6b57a3884132c2eefb5590 | |
| parent | 0e8fc556b669cbb4794b76b8197519f808083dac (diff) | |
| download | emacs-0b626ff8d6a29c452bc8bbbee79f5eff11d02548.tar.gz emacs-0b626ff8d6a29c452bc8bbbee79f5eff11d02548.zip | |
Rewrite sql-interactive-remove-continuation-prompt
* lisp/progmodes/sql.el (sql-starts-with-prompt-re): Remove.
(sql-ends-with-prompt-re): Remove
(sql-interactive-remove-continuation-prompt): Delete prompts from
anywhere in the process output, not just at the beginning of current
string. Streamline logic, describe it in docstring.
* test/lisp/progmodes/sql-tests.el: Add tests
| -rw-r--r-- | lisp/progmodes/sql.el | 135 | ||||
| -rw-r--r-- | test/lisp/progmodes/sql-tests.el | 80 |
2 files changed, 135 insertions, 80 deletions
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 5e5f5e13fe6..979b743a65d 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el | |||
| @@ -3648,94 +3648,69 @@ Allows the suppression of continuation prompts.") | |||
| 3648 | 3648 | ||
| 3649 | (defvar sql-preoutput-hold nil) | 3649 | (defvar sql-preoutput-hold nil) |
| 3650 | 3650 | ||
| 3651 | (defun sql-starts-with-prompt-re () | ||
| 3652 | "Anchor the prompt expression at the beginning of the output line. | ||
| 3653 | Remove the start of line regexp." | ||
| 3654 | (concat "\\`" comint-prompt-regexp)) | ||
| 3655 | |||
| 3656 | (defun sql-ends-with-prompt-re () | ||
| 3657 | "Anchor the prompt expression at the end of the output line. | ||
| 3658 | Match a SQL prompt or a password prompt." | ||
| 3659 | (concat "\\(?:\\(?:" sql-prompt-regexp "\\)\\|" | ||
| 3660 | "\\(?:" comint-password-prompt-regexp "\\)\\)\\'")) | ||
| 3661 | |||
| 3662 | (defun sql-interactive-remove-continuation-prompt (oline) | 3651 | (defun sql-interactive-remove-continuation-prompt (oline) |
| 3663 | "Strip out continuation prompts out of the OLINE. | 3652 | "Strip out continuation prompts out of the OLINE. |
| 3664 | 3653 | ||
| 3665 | Added to the `comint-preoutput-filter-functions' hook in a SQL | 3654 | Added to the `comint-preoutput-filter-functions' hook in a SQL |
| 3666 | interactive buffer. If `sql-output-newline-count' is greater than | 3655 | interactive buffer. The complication to this filter is that the |
| 3667 | zero, then an output line matching the continuation prompt is filtered | 3656 | continuation prompts may arrive in multiple chunks. If they do, |
| 3668 | out. If the count is zero, then a newline is inserted into the output | 3657 | then the function saves any unfiltered output in a buffer and |
| 3669 | to force the output from the query to appear on a new line. | 3658 | prepends that buffer to the next chunk to properly match the |
| 3670 | 3659 | broken-up prompt. | |
| 3671 | The complication to this filter is that the continuation prompts | 3660 | |
| 3672 | may arrive in multiple chunks. If they do, then the function | 3661 | The filter goes into play only if something is already |
| 3673 | saves any unfiltered output in a buffer and prepends that buffer | 3662 | accumulated, or we're waiting for continuation |
| 3674 | to the next chunk to properly match the broken-up prompt. | 3663 | prompts (`sql-output-newline-count' is positive). In this case: |
| 3675 | 3664 | - Accumulate process output into `sql-preoutput-hold'. | |
| 3676 | If the filter gets confused, it should reset and stop filtering | 3665 | - Remove any complete prompts / continuation prompts that we're waiting |
| 3677 | to avoid deleting non-prompt output." | 3666 | for. |
| 3678 | 3667 | - In case we're expecting more prompts - return all currently | |
| 3679 | ;; continue gathering lines of text iff | 3668 | accumulated _complete_ lines, leaving the rest for the next |
| 3680 | ;; + we know what a prompt looks like, and | 3669 | invocation. They will appear in the output immediately. This way we |
| 3681 | ;; + there is held text, or | 3670 | don't accumulate large chunks of data for no reason. |
| 3682 | ;; + there are continuation prompt yet to come, or | 3671 | - If we found all expected prompts - just return all current accumulated |
| 3683 | ;; + not just a prompt string | 3672 | data." |
| 3684 | (when (and comint-prompt-regexp | 3673 | (when (and comint-prompt-regexp |
| 3685 | (or (> (length (or sql-preoutput-hold "")) 0) | 3674 | ;; We either already have something held, or expect |
| 3686 | (> (or sql-output-newline-count 0) 0) | 3675 | ;; prompts |
| 3687 | (not (or (string-match sql-prompt-regexp oline) | 3676 | (or sql-preoutput-hold |
| 3688 | (and sql-prompt-cont-regexp | 3677 | (and sql-output-newline-count |
| 3689 | (string-match sql-prompt-cont-regexp oline)))))) | 3678 | (> sql-output-newline-count 0)))) |
| 3690 | |||
| 3691 | (save-match-data | 3679 | (save-match-data |
| 3692 | (let (prompt-found last-nl) | 3680 | ;; Add this text to what's left from the last pass |
| 3693 | 3681 | (setq oline (concat sql-preoutput-hold oline) | |
| 3694 | ;; Add this text to what's left from the last pass | 3682 | sql-preoutput-hold nil) |
| 3695 | (setq oline (concat sql-preoutput-hold oline) | 3683 | |
| 3696 | sql-preoutput-hold "") | 3684 | ;; If we are looking for prompts |
| 3697 | 3685 | (when (and sql-output-newline-count | |
| 3698 | ;; If we are looking for multiple prompts | 3686 | (> sql-output-newline-count 0)) |
| 3699 | (when (and (integerp sql-output-newline-count) | 3687 | ;; Loop thru each starting prompt and remove it |
| 3700 | (>= sql-output-newline-count 1)) | 3688 | (while (and (not (string-empty-p oline)) |
| 3701 | ;; Loop thru each starting prompt and remove it | 3689 | (> sql-output-newline-count 0) |
| 3702 | (let ((start-re (sql-starts-with-prompt-re))) | 3690 | (string-match comint-prompt-regexp oline)) |
| 3703 | (while (and (not (string= oline "")) | 3691 | (setq oline (replace-match "" nil nil oline) |
| 3704 | (> sql-output-newline-count 0) | 3692 | sql-output-newline-count (1- sql-output-newline-count))) |
| 3705 | (string-match start-re oline)) | 3693 | |
| 3706 | (setq oline (replace-match "" nil nil oline) | 3694 | ;; If we've found all the expected prompts, stop looking |
| 3707 | sql-output-newline-count (1- sql-output-newline-count) | 3695 | (if (= sql-output-newline-count 0) |
| 3708 | prompt-found t))) | 3696 | (setq sql-output-newline-count nil) |
| 3709 | 3697 | ;; Still more possible prompts, leave them for the next pass | |
| 3710 | ;; If we've found all the expected prompts, stop looking | 3698 | (setq sql-preoutput-hold oline |
| 3711 | (if (= sql-output-newline-count 0) | 3699 | oline ""))) |
| 3712 | (setq sql-output-newline-count nil) | 3700 | |
| 3713 | 3701 | ;; Lines that are now complete may be passed further | |
| 3714 | ;; Still more possible prompts, leave them for the next pass | 3702 | (when sql-preoutput-hold |
| 3715 | (setq sql-preoutput-hold oline | 3703 | (let ((last-nl 0)) |
| 3716 | oline ""))) | 3704 | (while (string-match "\n" sql-preoutput-hold last-nl) |
| 3717 | 3705 | (setq last-nl (match-end 0))) | |
| 3718 | ;; If no prompts were found, stop looking | 3706 | ;; Return up to last nl, hold after the last nl |
| 3719 | (unless prompt-found | 3707 | (setq oline (substring sql-preoutput-hold 0 last-nl) |
| 3720 | (setq sql-output-newline-count nil | 3708 | sql-preoutput-hold (substring sql-preoutput-hold last-nl)) |
| 3721 | oline (concat oline sql-preoutput-hold) | 3709 | (when (string-empty-p sql-preoutput-hold) |
| 3722 | sql-preoutput-hold "")) | 3710 | (setq sql-preoutput-hold nil)))))) |
| 3723 | |||
| 3724 | ;; Break up output by physical lines if we haven't hit the final prompt | ||
| 3725 | (let ((end-re (sql-ends-with-prompt-re))) | ||
| 3726 | (unless (and (not (string= oline "")) | ||
| 3727 | (string-match end-re oline) | ||
| 3728 | (>= (match-end 0) (length oline))) | ||
| 3729 | ;; Find everything upto the last nl | ||
| 3730 | (setq last-nl 0) | ||
| 3731 | (while (string-match "\n" oline last-nl) | ||
| 3732 | (setq last-nl (match-end 0))) | ||
| 3733 | ;; Hold after the last nl, return upto last nl | ||
| 3734 | (setq sql-preoutput-hold (concat (substring oline last-nl) | ||
| 3735 | sql-preoutput-hold) | ||
| 3736 | oline (substring oline 0 last-nl))))))) | ||
| 3737 | oline) | 3711 | oline) |
| 3738 | 3712 | ||
| 3713 | |||
| 3739 | ;;; Sending the region to the SQLi buffer. | 3714 | ;;; Sending the region to the SQLi buffer. |
| 3740 | (defvar sql-debug-send nil | 3715 | (defvar sql-debug-send nil |
| 3741 | "Display text sent to SQL process pragmatically.") | 3716 | "Display text sent to SQL process pragmatically.") |
diff --git a/test/lisp/progmodes/sql-tests.el b/test/lisp/progmodes/sql-tests.el index 7e36d845e2c..c644d115df6 100644 --- a/test/lisp/progmodes/sql-tests.el +++ b/test/lisp/progmodes/sql-tests.el | |||
| @@ -425,5 +425,85 @@ The ACTION will be tested after set-up of PRODUCT." | |||
| 425 | (let ((sql-password "password")) | 425 | (let ((sql-password "password")) |
| 426 | (should (equal "password" (sql-comint-automatic-password ""))))) | 426 | (should (equal "password" (sql-comint-automatic-password ""))))) |
| 427 | 427 | ||
| 428 | |||
| 429 | |||
| 430 | ;; Tests for sql-interactive-remove-continuation-prompt | ||
| 431 | |||
| 432 | (defmacro sql-tests-remove-cont-prompts-harness (&rest body) | ||
| 433 | "Set-up and tear-down for tests of | ||
| 434 | `sql-interactive-remove-continuation-prompt'." | ||
| 435 | (declare (indent 0)) | ||
| 436 | `(let ((comint-prompt-regexp "^ +\\.\\{3\\} ") | ||
| 437 | (sql-output-newline-count nil) | ||
| 438 | (sql-preoutput-hold nil)) | ||
| 439 | ,@body | ||
| 440 | (should (null sql-output-newline-count)) | ||
| 441 | (should (null sql-preoutput-hold)))) | ||
| 442 | |||
| 443 | (ert-deftest sql-tests-remove-cont-prompts-pass-through () | ||
| 444 | "Test that `sql-interactive-remove-continuation-prompt' just | ||
| 445 | passes the output line through when it doesn't expect prompts." | ||
| 446 | (sql-tests-remove-cont-prompts-harness | ||
| 447 | (should | ||
| 448 | (equal " ... " | ||
| 449 | (sql-interactive-remove-continuation-prompt | ||
| 450 | " ... "))))) | ||
| 451 | |||
| 452 | (ert-deftest sql-tests-remove-cont-prompts-anchored-successive () | ||
| 453 | "Test that `sql-interactive-remove-continuation-prompt' is able | ||
| 454 | to delete multiple prompts (anchored to bol) even if they appear | ||
| 455 | in a single line, but not more than `sql-output-newline-count'." | ||
| 456 | (sql-tests-remove-cont-prompts-harness | ||
| 457 | (setq sql-output-newline-count 2) | ||
| 458 | (should | ||
| 459 | (equal | ||
| 460 | ;; 2 of 3 prompts are deleted | ||
| 461 | "some output ... more output...\n\ | ||
| 462 | ... \n\ | ||
| 463 | output after prompt" | ||
| 464 | (sql-interactive-remove-continuation-prompt | ||
| 465 | "some output ... more output...\n\ | ||
| 466 | ... ... ... \n\ | ||
| 467 | output after prompt"))))) | ||
| 468 | |||
| 469 | (ert-deftest sql-tests-remove-cont-prompts-collect-chunked-output () | ||
| 470 | "Test that `sql-interactive-remove-continuation-prompt' properly | ||
| 471 | collects output when output arrives in chunks, with prompts | ||
| 472 | intermixed." | ||
| 473 | (sql-tests-remove-cont-prompts-harness | ||
| 474 | (setq sql-output-newline-count 2) | ||
| 475 | |||
| 476 | ;; Part of first prompt gets held. Complete line is passed | ||
| 477 | ;; through. | ||
| 478 | (should (equal "line1\n" | ||
| 479 | (sql-interactive-remove-continuation-prompt | ||
| 480 | "line1\n .."))) | ||
| 481 | (should (equal " .." sql-preoutput-hold)) | ||
| 482 | (should (equal 2 sql-output-newline-count)) | ||
| 483 | |||
| 484 | ;; First prompt is complete - remove it. Hold part of line2. | ||
| 485 | (should (equal "" | ||
| 486 | (sql-interactive-remove-continuation-prompt ". li"))) | ||
| 487 | (should (equal "li" sql-preoutput-hold)) | ||
| 488 | (should (equal 1 sql-output-newline-count)) | ||
| 489 | |||
| 490 | ;; Remove second prompt. Flush output & don't hold / process any | ||
| 491 | ;; output further on. | ||
| 492 | (should (equal "line2\nli" | ||
| 493 | (sql-interactive-remove-continuation-prompt "ne2\n ... li"))) | ||
| 494 | (should (null sql-preoutput-hold)) | ||
| 495 | (should (null sql-output-newline-count)) | ||
| 496 | (should (equal "line3\n ... " | ||
| 497 | (sql-interactive-remove-continuation-prompt "line3\n ... "))))) | ||
| 498 | |||
| 499 | (ert-deftest sql-tests-remove-cont-prompts-flush-held () | ||
| 500 | "Test that when we don't wait for prompts, | ||
| 501 | `sql-interactive-remove-continuation-prompt' just 'flushes' held | ||
| 502 | output, with no prompt processing." | ||
| 503 | (sql-tests-remove-cont-prompts-harness | ||
| 504 | (setq sql-preoutput-hold "line1\n ..") | ||
| 505 | (should (equal "line1\n ... line2 .." | ||
| 506 | (sql-interactive-remove-continuation-prompt ". line2 .."))))) | ||
| 507 | |||
| 428 | (provide 'sql-tests) | 508 | (provide 'sql-tests) |
| 429 | ;;; sql-tests.el ends here | 509 | ;;; sql-tests.el ends here |