;;; erc-d-t.el --- ERT helpers for ERC test server -*- lexical-binding: t -*-

;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;;
;; This file is part of GNU Emacs.
;;
;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see
;; <https://www.gnu.org/licenses/>.

;;; Commentary:

;;; Code:
(eval-and-compile (let ((dir (getenv "EMACS_TEST_DIRECTORY")))
                    (when dir
                      (load (concat dir "/lisp/erc/erc-d/erc-d-u") nil t))))
(require 'erc-d-u)
(require 'ert)

(defun erc-d-t-kill-related-buffers ()
  "Kill all erc- or erc-d- related buffers."
  (let (buflist)
    (dolist (buf (buffer-list))
      (with-current-buffer buf
        (when (or erc-d-u--process-buffer
                  (derived-mode-p 'erc-mode))
          (push buf buflist))))
    (dolist (buf buflist)
      (when (and (boundp 'erc-server-flood-timer)
                 (timerp erc-server-flood-timer))
        (cancel-timer erc-server-flood-timer))
      (when-let ((proc (get-buffer-process buf)))
        (delete-process proc))
      (when (buffer-live-p buf)
        (kill-buffer buf))))
  (while (when-let ((buf (pop erc-d-u--canned-buffers)))
           (kill-buffer buf))))

(defun erc-d-t-silence-around (orig &rest args)
  "Run ORIG function with ARGS silently.
Use this on `erc-handle-login' and `erc-server-connect'."
  (let ((inhibit-message t))
    (apply orig args)))

(defvar erc-d-t-cleanup-sleep-secs 0.1)

(defmacro erc-d-t-with-cleanup (bindings cleanup &rest body)
  "Execute BODY and run CLEANUP form regardless of outcome.
`let*'-bind BINDINGS and make them available in BODY and CLEANUP.
After CLEANUP, destroy any values in BINDINGS that remain bound to
buffers or processes.  Sleep `erc-d-t-cleanup-sleep-secs' before
returning."
  (declare (indent 2))
  `(let* ,bindings
     (unwind-protect
         (progn ,@body)
       ,cleanup
       (when noninteractive
         (let (bufs procs)
           (dolist (o (list ,@(mapcar (lambda (b) (or (car-safe b) b))
                                      bindings)))
             (when (bufferp o)
               (push o bufs))
             (when (processp o)
               (push o procs)))
           (dolist (proc procs)
             (delete-process proc)
             (when-let ((buf (process-buffer proc)))
               (push buf bufs)))
           (dolist (buf bufs)
             (when-let ((proc (get-buffer-process buf)))
               (delete-process proc))
             (when (bufferp buf)
               (ignore-errors (kill-buffer buf)))))
         (sleep-for erc-d-t-cleanup-sleep-secs)))))

(defmacro erc-d-t-wait-for (max-secs msg &rest body)
  "Wait for BODY to become non-nil.
Or signal error with MSG after MAX-SECS.  When MAX-SECS is negative,
signal if BODY returns nil but not if MAX-SECS elapses.  On success,
return BODY's value.

Note: this assumes BODY is waiting on a peer's output.  It tends to
artificially accelerate consumption of all process output, which may not
be desirable."
  (declare (indent 2))
  (let ((inverted (make-symbol "inverted"))
        (time-out (make-symbol "time-out"))
        (result (make-symbol "result")))
    `(ert-info ((concat "Awaiting: " ,msg))
       (let ((,time-out (abs ,max-secs))
             (,inverted (< ,max-secs 0))
             (,result ',result))
         (with-timeout (,time-out (if ,inverted
                                      (setq ,inverted nil)
                                    (error "Failed awaiting: %s" ,msg)))
           (while (not (setq ,result (progn ,@body)))
             (when (and (accept-process-output nil 0.1) (not noninteractive))
               (redisplay))))
         (when ,inverted
           (error "Failed awaiting: %s" ,msg))
         ,result))))

(defvar erc-d-t-use-regeexp-when-searching nil)

(defun erc-d-t-search-for (time-out text &optional starting-from)
  "Wait for TEXT to appear in current buffer before TIME-OUT secs.
With marker or number STARTING-FROM, only look forward from there.  When
`erc-d-t-use-regeexp-when-searching' is non-nil, TEXT can be a regular
expression."
  (save-restriction
    (widen)
    (erc-d-t-wait-for time-out (format "string: %s" text)
      (goto-char (or starting-from (point-min)))
      (funcall (if erc-d-t-use-regeexp-when-searching
                   #'search-forward-regexp
                 #'search-forward)
               text nil t))))

(defun erc-d-t-make-expecter ()
  "Return function to search for new output in buffer.
The returned function works like `erc-d-t-search-for', but it never
revisits previously covered territory.  To use a regexp, ensure
`erc-d-t-use-regeexp-when-searching' is non-nil during the actual
search.  To reset the marker position, pass it as STARTING-FROM."
  (let (positions)
    (lambda (time-out text &optional starting-from)
      (save-restriction
        (widen)
        (let ((pos (cdr (assq (current-buffer) positions))))
          (when starting-from
            (set-marker pos starting-from))
          (when (and text time-out)
            (erc-d-t-wait-for time-out (format "string: %s" text)
              (goto-char (or pos (point-min)))
              (when (funcall (if erc-d-t-use-regeexp-when-searching
                                 #'search-forward-regexp
                               #'search-forward)
                             text nil t)
                (unless pos
                  (push (cons (current-buffer) (setq pos (make-marker)))
                        positions))
                (marker-position
                 (set-marker pos (min (point) (1- (point-max)))))))))))))

(provide 'erc-d-t)
;;; erc-d-t.el ends here