:type 'hook
:version "27.1")
+;; This is being auditioned for possible exporting (as a custom hook
+;; option). Likewise for (public versions of) `erc--input-split' and
+;; `erc--discard-trailing-multiline-nulls'. If unneeded, we'll just
+;; run the latter on the input after `erc-pre-send-functions', and
+;; remove this hook and the struct completely. IOW, if you need this,
+;; please say so.
+
+(defvar erc--pre-send-split-functions '(erc--discard-trailing-multiline-nulls)
+ "Special hook for modifying individual lines in multiline prompt input.
+The functions are called with one argument, an `erc--input-split'
+struct, which they can optionally modify.
+
+The struct has five slots:
+
+ `string': the input string delivered by `erc-pre-send-functions'
+ `insertp': whether to insert the lines into the buffer
+ `sendp': whether the lines should be sent to the IRC server
+ `lines': a list of lines to be sent, each one a `string'
+ `cmdp': whether to interpret input as a command, like /ignore
+
+The `string' field is effectively read-only. When `cmdp' is
+non-nil, all but the first line will be discarded.")
+
(defvar erc-insert-this t
"Insert the text into the target buffer or not.
Functions on `erc-insert-pre-hook' can set this variable to nil
(point-max))
(defvar erc-last-input-time 0
- "Time of last call to `erc-send-current-line'.
+ "Time of last successful call to `erc-send-current-line'.
If that function has never been called, the value is 0.")
(defcustom erc-accidental-paste-threshold-seconds 0.2
:version "26.1"
:type '(choice number (other :tag "disabled" nil)))
+(defvar erc--input-line-delim-regexp (rx (| (: (? ?\r) ?\n) ?\r)))
+
+(defun erc--blank-in-multiline-input-p (lines)
+ "Detect whether LINES contains a blank line.
+When `erc-send-whitespace-lines' is in effect, return nil if
+LINES is multiline or the first line is non-empty. When
+`erc-send-whitespace-lines' is nil, return non-nil when any line
+is empty or consists of one or more spaces, tabs, or form-feeds."
+ (catch 'return
+ (let ((multilinep (cdr lines)))
+ (dolist (line lines)
+ (when (if erc-send-whitespace-lines
+ (and (string-empty-p line) (not multilinep))
+ (string-match (rx bot (* (in " \t\f")) eot) line))
+ (throw 'return t))))))
+
+(defun erc--check-prompt-input-for-multiline-blanks (_ lines)
+ "Return non-nil when multiline prompt input has blank LINES."
+ (when (erc--blank-in-multiline-input-p lines)
+ (if erc-warn-about-blank-lines
+ "Blank line - ignoring..."
+ 'invalid)))
+
+(defun erc--check-prompt-input-for-point-in-bounds (_ _)
+ "Return non-nil when point is before prompt."
+ (when (< (point) (erc-beg-of-input-line))
+ "Point is not in the input area"))
+
+(defun erc--check-prompt-input-for-running-process (string _)
+ "Return non-nil unless in an active ERC server buffer."
+ (unless (or (erc-server-buffer-live-p)
+ (erc-command-no-process-p string))
+ "ERC: No process running"))
+
+(defvar erc--check-prompt-input-functions
+ '(erc--check-prompt-input-for-point-in-bounds
+ erc--check-prompt-input-for-multiline-blanks
+ erc--check-prompt-input-for-running-process)
+ "Validators for user input typed at prompt.
+Called with latest input string submitted by user and the list of
+lines produced by splitting it. If any member function returns
+non-nil, processing is abandoned and input is left untouched.
+When the returned value is a string, pass it to `erc-error'.")
+
(defun erc-send-current-line ()
"Parse current line and send it to IRC."
(interactive)
(eolp))
(expand-abbrev))
(widen)
- (if (< (point) (erc-beg-of-input-line))
- (erc-error "Point is not in the input area")
+ (if-let* ((str (erc-user-input))
+ (msg (run-hook-with-args-until-success
+ 'erc--check-prompt-input-functions str
+ (split-string str erc--input-line-delim-regexp))))
+ (when (stringp msg)
+ (erc-error msg))
(let ((inhibit-read-only t)
- (str (erc-user-input))
(old-buf (current-buffer)))
- (if (and (not (erc-server-buffer-live-p))
- (not (erc-command-no-process-p str)))
- (erc-error "ERC: No process running")
+ (progn ; unprogn this during next major surgery
(erc-set-active-buffer (current-buffer))
;; Kill the input and the prompt
(delete-region (erc-beg-of-input-line)
(erc-end-of-input-line))
(unwind-protect
- (erc-send-input str)
+ (erc-send-input str 'skip-ws-chk)
;; Fix the buffer if the command didn't kill it
(when (buffer-live-p old-buf)
(with-current-buffer old-buf
(set-buffer-modified-p buffer-modified))))))
;; Only when last hook has been run...
- (run-hook-with-args 'erc-send-completed-hook str))))
- (setq erc-last-input-time now))
+ (run-hook-with-args 'erc-send-completed-hook str)))
+ (setq erc-last-input-time now)))
(switch-to-buffer "*ERC Accidental Paste Overflow*")
(lwarn 'erc :warning
"You seem to have accidentally pasted some text!"))))
(cl-defstruct erc-input
string insertp sendp)
-(defun erc-send-input (input)
+(cl-defstruct (erc--input-split (:include erc-input))
+ lines cmdp)
+
+(defun erc--discard-trailing-multiline-nulls (state)
+ "Ensure last line of STATE's string is non-null.
+But only when `erc-send-whitespace-lines' is non-nil. STATE is
+an `erc--input-split' object."
+ (when (and erc-send-whitespace-lines (erc--input-split-lines state))
+ (let ((reversed (nreverse (erc--input-split-lines state))))
+ (when (string-empty-p (car reversed))
+ (pop reversed)
+ (setf (erc--input-split-cmdp state) nil))
+ (nreverse (seq-drop-while #'string-empty-p reversed)))))
+
+(defun erc-send-input (input &optional skip-ws-chk)
"Treat INPUT as typed in by the user.
It is assumed that the input and the prompt is already deleted.
Return non-nil only if we actually send anything."
;; Handle different kinds of inputs
- (cond
- ;; Ignore empty input
- ((if erc-send-whitespace-lines
- (string= input "")
- (string-match "\\`[ \t\r\f\n]*\\'" input))
- (when erc-warn-about-blank-lines
- (message "Blank line - ignoring...")
- (beep))
- nil)
- (t
+ (if (and (not skip-ws-chk)
+ (erc--check-prompt-input-for-multiline-blanks
+ input (split-string input erc--input-line-delim-regexp)))
+ (when erc-warn-about-blank-lines
+ (message "Blank line - ignoring...") ; compat
+ (beep))
;; This dynamic variable is used by `erc-send-pre-hook'. It's
;; obsolete, and when it's finally removed, this binding should
;; also be removed.
:insertp erc-insert-this
:sendp erc-send-this))
(run-hook-with-args 'erc-pre-send-functions state)
+ (setq state (make-erc--input-split
+ :string (erc-input-string state)
+ :insertp (erc-input-insertp state)
+ :sendp (erc-input-sendp state)
+ :lines (split-string (erc-input-string state)
+ erc--input-line-delim-regexp)
+ :cmdp (string-match erc-command-regexp
+ (erc-input-string state))))
+ (run-hook-with-args 'erc--pre-send-split-functions state)
(when (and (erc-input-sendp state)
- erc-send-this)
- (let ((string (erc-input-string state)))
- (if (or (if (>= emacs-major-version 28)
- (string-search "\n" string)
- (string-match "\n" string))
- (not (string-match erc-command-regexp string)))
- (mapc
- (lambda (line)
- (mapc
- (lambda (line)
- ;; Insert what has to be inserted for this.
- (when (erc-input-insertp state)
- (erc-display-msg line))
- (erc-process-input-line (concat line "\n")
- (null erc-flood-protect) t))
- (or (and erc-flood-protect (erc-split-line line))
- (list line))))
- (split-string string "\n"))
- (erc-process-input-line (concat string "\n") t nil))
- t))))))
+ erc-send-this)
+ (let ((lines (erc--input-split-lines state)))
+ (if (and (erc--input-split-cmdp state) (not (cdr lines)))
+ (erc-process-input-line (concat (car lines) "\n") t nil)
+ (dolist (line lines)
+ (dolist (line (or (and erc-flood-protect (erc-split-line line))
+ (list line)))
+ (when (erc-input-insertp state)
+ (erc-display-msg line))
+ (erc-process-input-line (concat line "\n")
+ (null erc-flood-protect) t))))
+ t)))))
(defun erc-display-msg (line)
"Display LINE as a message of the user to the current target at point."
(kill-buffer "*erc-protocol*")
(should-not erc-debug-irc-protocol)))
+(ert-deftest erc--input-line-delim-regexp ()
+ (let ((p erc--input-line-delim-regexp))
+ ;; none
+ (should (equal '("a" "b") (split-string "a\r\nb" p)))
+ (should (equal '("a" "b") (split-string "a\nb" p)))
+ (should (equal '("a" "b") (split-string "a\rb" p)))
+
+ ;; one
+ (should (equal '("") (split-string "" p)))
+ (should (equal '("a" "" "b") (split-string "a\r\rb" p)))
+ (should (equal '("a" "" "b") (split-string "a\n\rb" p)))
+ (should (equal '("a" "" "b") (split-string "a\n\nb" p)))
+ (should (equal '("a" "" "b") (split-string "a\r\r\nb" p)))
+ (should (equal '("a" "" "b") (split-string "a\n\r\nb" p)))
+ (should (equal '("a" "") (split-string "a\n" p)))
+ (should (equal '("a" "") (split-string "a\r" p)))
+ (should (equal '("a" "") (split-string "a\r\n" p)))
+ (should (equal '("" "b") (split-string "\nb" p)))
+ (should (equal '("" "b") (split-string "\rb" p)))
+ (should (equal '("" "b") (split-string "\r\nb" p)))
+
+ ;; two
+ (should (equal '("" "") (split-string "\r" p)))
+ (should (equal '("" "") (split-string "\n" p)))
+ (should (equal '("" "") (split-string "\r\n" p)))
+
+ ;; three
+ (should (equal '("" "" "") (split-string "\r\r" p)))
+ (should (equal '("" "" "") (split-string "\n\n" p)))
+ (should (equal '("" "" "") (split-string "\n\r" p)))))
+
+(ert-deftest erc--blank-in-multiline-input-p ()
+ (let ((check (lambda (s)
+ (erc--blank-in-multiline-input-p
+ (split-string s erc--input-line-delim-regexp)))))
+
+ (ert-info ("With `erc-send-whitespace-lines'")
+ (let ((erc-send-whitespace-lines t))
+ (should (funcall check ""))
+ (should-not (funcall check "\na"))
+ (should-not (funcall check "/msg a\n")) ; real /cmd
+ (should-not (funcall check "a\n\nb")) ; "" allowed
+ (should-not (funcall check "/msg a\n\nb")) ; non-/cmd
+ (should-not (funcall check " "))
+ (should-not (funcall check "\t"))
+ (should-not (funcall check "a\nb"))
+ (should-not (funcall check "a\n "))
+ (should-not (funcall check "a\n \t"))
+ (should-not (funcall check "a\n \f"))
+ (should-not (funcall check "a\n \nb"))
+ (should-not (funcall check "a\n \t\nb"))
+ (should-not (funcall check "a\n \f\nb"))))
+
+ (should (funcall check ""))
+ (should (funcall check " "))
+ (should (funcall check "\t"))
+ (should (funcall check "a\n\nb"))
+ (should (funcall check "a\n\nb"))
+ (should (funcall check "a\n "))
+ (should (funcall check "a\n \t"))
+ (should (funcall check "a\n \f"))
+ (should (funcall check "a\n \nb"))
+ (should (funcall check "a\n \t\nb"))
+
+ (should-not (funcall check "a\rb"))
+ (should-not (funcall check "a\nb"))
+ (should-not (funcall check "a\r\nb"))))
+
+(defun erc-tests--with-process-input-spy (test)
+ (with-current-buffer (get-buffer-create "FakeNet")
+ (let* ((erc-pre-send-functions
+ (remove #'erc-add-to-input-ring erc-pre-send-functions)) ; for now
+ (inhibit-message noninteractive)
+ (erc-server-current-nick "tester")
+ (erc-last-input-time 0)
+ erc-accidental-paste-threshold-seconds
+ ;;
+ calls)
+ (cl-letf (((symbol-function 'erc-process-input-line)
+ (lambda (&rest r) (push r calls)))
+ ((symbol-function 'erc-server-buffer)
+ (lambda () (current-buffer))))
+ (erc-tests--send-prep)
+ (funcall test (lambda () (pop calls)))))
+ (when noninteractive (kill-buffer))))
+
+(ert-deftest erc--check-prompt-input-functions ()
+ (erc-tests--with-process-input-spy
+ (lambda (next)
+
+ (ert-info ("Errors when point not in prompt area") ; actually just dings
+ (insert "/msg #chan hi")
+ (forward-line -1)
+ (let ((e (should-error (erc-send-current-line))))
+ (should (equal "Point is not in the input area" (cadr e))))
+ (goto-char (point-max))
+ (ert-info ("Input remains untouched")
+ (should (save-excursion (erc-bol) (looking-at "/msg #chan hi")))))
+
+ (ert-info ("Errors when no process running")
+ (let ((e (should-error (erc-send-current-line))))
+ (should (equal "ERC: No process running" (cadr e))))
+ (ert-info ("Input remains untouched")
+ (should (save-excursion (erc-bol) (looking-at "/msg #chan hi")))))
+
+ (ert-info ("Errors when line contains empty newline")
+ (erc-bol)
+ (delete-region (point) (point-max))
+ (insert "one\n")
+ (let ((e (should-error (erc-send-current-line))))
+ (should (equal "Blank line - ignoring..." (cadr e))))
+ (goto-char (point-max))
+ (ert-info ("Input remains untouched")
+ (should (save-excursion (goto-char erc-input-marker)
+ (looking-at "one\n")))))
+
+ (should (= 0 erc-last-input-time))
+ (should-not (funcall next)))))
+
+;; These also indirectly tests `erc-send-input'
+
+(ert-deftest erc-send-current-line ()
+ (erc-tests--with-process-input-spy
+ (lambda (next)
+ (erc-tests--set-fake-server-process "sleep" "1")
+ (should (= 0 erc-last-input-time))
+
+ (ert-info ("Simple command")
+ (insert "/msg #chan hi")
+ (erc-send-current-line)
+ (ert-info ("Prompt restored")
+ (forward-line 0)
+ (should (looking-at-p erc-prompt)))
+ (ert-info ("Input cleared")
+ (erc-bol)
+ (should (eq (point) (point-max))))
+ ;; Commands are forced (no flood protection)
+ (should (equal (funcall next) '("/msg #chan hi\n" t nil))))
+
+ (ert-info ("Simple non-command")
+ (insert "hi")
+ (erc-send-current-line)
+ (should (eq (point) (point-max)))
+ (should (save-excursion (forward-line -1)
+ (search-forward "<tester> hi")))
+ ;; Non-ommands are forced only when `erc-flood-protect' is nil
+ (should (equal (funcall next) '("hi\n" nil t))))
+
+ (should (consp erc-last-input-time)))))
+
+(ert-deftest erc-send-whitespace-lines ()
+ (erc-tests--with-process-input-spy
+ (lambda (next)
+ (erc-tests--set-fake-server-process "sleep" "1")
+ (setq-local erc-send-whitespace-lines t)
+
+ (ert-info ("Multiline hunk with blank line correctly split")
+ (insert "one\n\ntwo")
+ (erc-send-current-line)
+ (ert-info ("Prompt restored")
+ (forward-line 0)
+ (should (looking-at-p erc-prompt)))
+ (ert-info ("Input cleared")
+ (erc-bol)
+ (should (eq (point) (point-max))))
+ (should (equal (funcall next) '("two\n" nil t)))
+ (should (equal (funcall next) '("\n" nil t)))
+ (should (equal (funcall next) '("one\n" nil t))))
+
+ (ert-info ("Multiline hunk with trailing newline filtered")
+ (insert "hi\n")
+ (erc-send-current-line)
+ (ert-info ("Input cleared")
+ (erc-bol)
+ (should (eq (point) (point-max))))
+ (should (equal (funcall next) '("hi\n" nil t)))
+ (should-not (funcall next)))
+
+ (ert-info ("Multiline hunk with trailing carriage filtered")
+ (insert "hi\r")
+ (erc-send-current-line)
+ (ert-info ("Input cleared")
+ (erc-bol)
+ (should (eq (point) (point-max))))
+ (should (equal (funcall next) '("hi\n" nil t)))
+ (should-not (funcall next)))
+
+ (ert-info ("Multiline command with trailing blank filtered")
+ (pcase-dolist (`(,p . ,q)
+ '(("/a b\r" "/a b\n") ("/a b\n" "/a b\n")
+ ("/a b\n\n" "/a b\n") ("/a b\r\n" "/a b\n")
+ ("a b\nc\n\n" "c\n" "a b\n")
+ ("/a b\nc\n\n" "c\n" "/a b\n")
+ ("/a b\n\nc\n\n" "c\n" "\n" "/a b\n")))
+ (insert p)
+ (erc-send-current-line)
+ (erc-bol)
+ (should (eq (point) (point-max)))
+ (while q
+ (should (equal (funcall next) (list (pop q) nil t))))
+ (should-not (funcall next))))
+
+ (ert-info ("Multiline hunk with trailing whitespace not filtered")
+ (insert "there\n ")
+ (erc-send-current-line)
+ (should (equal (funcall next) '(" \n" nil t)))
+ (should (equal (funcall next) '("there\n" nil t)))
+ (should-not (funcall next))))))
;; The point of this test is to ensure output is handled identically
;; regardless of whether a command handler is summoned.
projects / emacs.git / commitdiff