[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/android 259bec95de1: Merge remote-tracking branch 'origin/master
|
From: |
Po Lu |
|
Subject: |
feature/android 259bec95de1: Merge remote-tracking branch 'origin/master' into feature/android |
|
Date: |
Sun, 25 Jun 2023 20:17:33 -0400 (EDT) |
branch: feature/android
commit 259bec95de1f2786c0e642ba5b9efb4a750bc432
Merge: 7b5d32fa871 a6de0d22e42
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Merge remote-tracking branch 'origin/master' into feature/android
---
doc/lispintro/emacs-lisp-intro.texi | 2 +-
doc/misc/erc.texi | 4 +-
etc/ERC-NEWS | 8 -
lisp/emacs-lisp/bytecomp.el | 8 +
lisp/emacs-lisp/cconv.el | 5 -
lisp/emacs-lisp/cl-macs.el | 27 ++--
lisp/erc/erc-button.el | 12 +-
lisp/erc/erc.el | 64 ++------
lisp/progmodes/cc-engine.el | 17 +-
test/lisp/erc/erc-tests.el | 303 ------------------------------------
10 files changed, 54 insertions(+), 396 deletions(-)
diff --git a/doc/lispintro/emacs-lisp-intro.texi
b/doc/lispintro/emacs-lisp-intro.texi
index 90eb92ca7ea..fce7583fe91 100644
--- a/doc/lispintro/emacs-lisp-intro.texi
+++ b/doc/lispintro/emacs-lisp-intro.texi
@@ -6827,7 +6827,7 @@ their code.
However, lists in Lisp are built using a lower-level structure known
as ``cons cells'' (@pxref{List Implementation}), in which there is no
-such thing as ``first'' or ``rest,''and the @sc{car} and the @sc{cdr}
+such thing as ``first'' or ``rest'', and the @sc{car} and the @sc{cdr}
are symmetrical. Lisp does not try to hide the existence of cons
cells, and programs do use them for things other than lists. For this
reason, the names are helpful for reminding programmers that
diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index e848ed21a50..ddfdb2e2b64 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -1531,7 +1531,9 @@ If you do so, please help keep it up to date.
@item
You can ask questions about using ERC on the Emacs mailing list,
-@uref{https://lists.gnu.org/mailman/listinfo/help-gnu-emacs}.
+@uref{https://lists.gnu.org/mailman/listinfo/help-gnu-emacs}, as well
+as on ERC's own low-volume list,
+@uref{https://lists.gnu.org/mailman/listinfo/emacs-erc}.
@item
You can visit the IRC Libera.Chat channel @samp{#emacs}. Many of the
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 68f1083621c..68cf0e2d6ca 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -82,14 +82,6 @@ connectivity before attempting to reconnect in earnest. See
options
'erc-server-reconnect-function' and 'erc-nickname-in-use-functions' to
get started.
-** Easily constrain all ERC-related business to a dedicated frame.
-The option 'erc-reuse-frames' can now be set to 'displayed', which
-tells ERC to show new buffers in frames already occupied by buffers
-from the same connection. This customization depends on the option
-'erc-buffer-display' (formerly 'erc-join-buffer') being set to
-'frame'. If you find the name 'displayed' unhelpful, please suggest
-an alternative by writing to the mailing list.
-
** Module 'fill' can add a bit of space between messages.
On graphical displays, it's now possible to add some breathing room
around certain messages via the new option 'erc-fill-line-spacing'.
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 64a57948017..659d698b603 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -3082,6 +3082,14 @@ If FORM is a lambda or a macro, byte-compile it as a
function."
(byte-compile-warn-x
arg "repeated variable %s in lambda-list" arg))
(t
+ (when (and lexical-binding
+ (cconv--not-lexical-var-p
+ arg byte-compile-bound-variables)
+ (byte-compile-warning-enabled-p 'lexical arg))
+ (byte-compile-warn-x
+ arg
+ "Lexical argument shadows the dynamic variable %S"
+ arg))
(push arg vars))))
(setq list (cdr list)))))
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 601e2c13d61..3e75020a013 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -682,11 +682,6 @@ FORM is the parent form that binds this var."
(when lexical-binding
(dolist (arg args)
(cond
- ((cconv--not-lexical-var-p arg cconv--dynbound-variables)
- (byte-compile-warn-x
- arg
- "Lexical argument shadows the dynamic variable %S"
- arg))
((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ...
(t (let ((varstruct (list arg nil nil nil nil)))
(cl-pushnew arg byte-compile-lexical-variables)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 1de5409f7ee..aadb498609a 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -243,17 +243,20 @@ The name is made by appending a number to PREFIX, default
\"T\"."
(defvar cl--bind-enquote) ;Non-nil if &cl-quote was in the formal arglist!
(defvar cl--bind-lets) (defvar cl--bind-forms)
-(defun cl--slet (bindings body)
+(defun cl--slet (bindings body &optional nowarn)
"Like `cl--slet*' but for \"parallel let\"."
- (let ((dyn nil)) ;Is there a var declared as dynbound among the bindings?
+ (let ((dyns nil)) ;Vars declared as dynbound among the bindings?
;; `seq-some' lead to bootstrap problems.
(dolist (binding bindings)
- (if (macroexp--dynamic-variable-p (car binding)) (setq dyn t)))
+ (when (macroexp--dynamic-variable-p (car binding))
+ (push (car binding) dyns)))
(cond
- (dyn
- `(funcall (lambda (,@(mapcar #'car bindings))
- ,@(macroexp-unprogn body))
- ,@(mapcar #'cadr bindings)))
+ (dyns
+ (let ((form `(funcall (lambda (,@(mapcar #'car bindings))
+ ,@(macroexp-unprogn body))
+ ,@(mapcar #'cadr bindings))))
+ (if (not nowarn) form
+ `(with-suppressed-warnings ((lexical ,@dyns)) ,form))))
((null (cdr bindings))
(macroexp-let* bindings body))
(t `(let ,bindings ,@(macroexp-unprogn body))))))
@@ -2920,7 +2923,7 @@ The function's arguments should be treated as immutable.
(if (and whole (not (cl--safe-expr-p (macroexp-progn argvs))))
whole
;; Function arguments are unconditionally statically scoped (bug#47552).
- (cl--slet (cl-mapcar #'list argns argvs) body)))
+ (cl--slet (cl-mapcar #'list argns argvs) body 'nowarn)))
;;; Structures.
@@ -3012,6 +3015,7 @@ To see the documentation for a defined struct type, use
(defsym (if cl--struct-inline 'cl-defsubst 'defun))
(forms nil)
(docstring (if (stringp (car descs)) (pop descs)))
+ (dynbound-slotnames '())
pred-form pred-check)
;; Can't use `cl-check-type' yet.
(unless (cl--struct-name-p name)
@@ -3131,6 +3135,8 @@ To see the documentation for a defined struct type, use
(while descp
(let* ((desc (pop descp))
(slot (pop desc)))
+ (when (macroexp--dynamic-variable-p slot)
+ (push slot dynbound-slotnames))
(if (memq slot '(cl-tag-slot cl-skip-slot))
(progn
(push nil slots)
@@ -3261,7 +3267,10 @@ To see the documentation for a defined struct type, use
;; forms))
`(progn
(defvar ,tag-symbol)
- ,@(nreverse forms)
+ ,@(if (null dynbound-slotnames)
+ (nreverse forms)
+ `((with-suppressed-warnings ((lexical . ,dynbound-slotnames))
+ ,@(nreverse forms))))
:autoload-end
;; Call cl-struct-define during compilation as well, so that
;; a subsequent cl-defstruct in the same file can correctly include this
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 08610860630..0c616a6026d 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -355,11 +355,11 @@ specified by `erc-button-alist'."
( cuser nil :type (or null erc-channel-user)
;; The CDR of a value from an `erc-channel-users' table.
:documentation "A possibly nil `erc-channel-user'.")
- ( erc-button-face erc-button-face :type symbol
+ ( face erc-button-face :type symbol
:documentation "Temp `erc-button-face' while buttonizing.")
- ( erc-button-nickname-face erc-button-nickname-face :type symbol
+ ( nickname-face erc-button-nickname-face :type symbol
:documentation "Temp `erc-button-nickname-face' while buttonizing.")
- ( erc-button-mouse-face erc-button-mouse-face :type symbol
+ ( mouse-face erc-button-mouse-face :type symbol
:documentation "Temp `erc-button-mouse-face' while buttonizing."))
;; This variable is intended to serve as a "core" to be wrapped by
@@ -463,11 +463,11 @@ retrieve it during buttonizing via
(setq bounds (erc-button--nick-bounds obj)
data (erc-button--nick-data obj)
erc-button-mouse-face
- (erc-button--nick-erc-button-mouse-face obj)
+ (erc-button--nick-mouse-face obj)
erc-button-nickname-face
- (erc-button--nick-erc-button-nickname-face obj)
+ (erc-button--nick-nickname-face obj)
erc-button-face
- (erc-button--nick-erc-button-face obj))))
+ (erc-button--nick-face obj))))
(erc-button-add-button (car bounds) (cdr bounds)
fun t data))))))))
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index a1538962602..70adbb15b5f 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1626,23 +1626,14 @@ This only has effect when `erc-join-buffer' is set to
`frame'."
(defcustom erc-reuse-frames t
"Determines whether new frames are always created.
-
-A value of t means only create a frame for undisplayed buffers.
-`displayed' means use any existing, potentially hidden frame
-already displaying a buffer from the same network context or,
-failing that, a frame showing any ERC buffer. As a last resort,
-`displayed' defaults to the selected frame, except for brand new
-connections, for which the invoking frame is always used. When
-this option is nil, a new frame is always created.
-
-Regardless of its value, this option is ignored unless
-`erc-join-buffer' is set to `frame'. And like most options in
-the `erc-buffer' customize group, this has no effect on server
-buffers while reconnecting because those are always buried."
- :package-version '(ERC . "5.6") ; FIXME sync on release
+Non-nil means only create a frame for undisplayed buffers. Nil
+means always create a new frame. Regardless of its value, ERC
+ignores this option unless `erc-join-buffer' is `frame'. And
+like most options in the `erc-buffer' customize group, this has
+no effect on server buffers while reconnecting because ERC always
+buries those."
:group 'erc-buffers
- :type '(choice boolean
- (const displayed)))
+ :type 'boolean)
(defun erc-channel-p (channel)
"Return non-nil if CHANNEL seems to be an IRC channel name."
@@ -2095,35 +2086,6 @@ realizes it's missing some required module \"foo\", it
can
confidently call (erc-foo-mode 1) without having to learn
anything about the dependency's implementation.")
-(defun erc--setup-buffer-first-window (frame a b)
- (catch 'found
- (walk-window-tree
- (lambda (w)
- (when (cond ((functionp a) (with-current-buffer (window-buffer w)
- (funcall a b)))
- (t (eq (buffer-local-value a (window-buffer w)) b)))
- (throw 'found t)))
- frame nil 0)))
-
-(defun erc--display-buffer-use-some-frame (buffer alist)
- "Maybe display BUFFER in an existing frame for the same connection.
-If performed, return window used; otherwise, return nil. Forward ALIST
-to display-buffer machinery."
- (when-let*
- ((idp (lambda (value)
- (and erc-networks--id
- (erc-networks--id-equal-p erc-networks--id value))))
- (procp (lambda (frame)
- (erc--setup-buffer-first-window frame idp erc-networks--id)))
- (ercp (lambda (frame)
- (erc--setup-buffer-first-window frame 'major-mode 'erc-mode)))
- ((or (cdr (frame-list)) (funcall ercp (selected-frame)))))
- ;; Workaround to avoid calling `window--display-buffer' directly
- (or (display-buffer-use-some-frame buffer
- `((frame-predicate . ,procp) ,@alist))
- (display-buffer-use-some-frame buffer
- `((frame-predicate . ,ercp) ,@alist)))))
-
(defvar erc--setup-buffer-hook nil
"Internal hook for module setup involving windows and frames.")
@@ -2142,21 +2104,15 @@ to display-buffer machinery."
('bury
nil)
('frame
- (cond
- ((and (eq erc-reuse-frames 'displayed)
- (not (get-buffer-window buffer t)))
- (display-buffer buffer '((erc--display-buffer-use-some-frame)
- (inhibit-switch-frame . t)
- (inhibit-same-window . t))))
- ((or (not erc-reuse-frames)
- (not (get-buffer-window buffer t)))
+ (when (or (not erc-reuse-frames)
+ (not (get-buffer-window buffer t)))
(let ((frame (make-frame (or erc-frame-alist
default-frame-alist))))
(raise-frame frame)
(select-frame frame))
(switch-to-buffer buffer)
(when erc-frame-dedicated-flag
- (set-window-dedicated-p (selected-window) t)))))
+ (set-window-dedicated-p (selected-window) t))))
(_
(if (active-minibuffer-window)
(display-buffer buffer)
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 0eadeafc836..c4ae8aadd65 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -7158,8 +7158,8 @@ comment at the start of cc-engine.el for more info."
(beg-literal-beg (car (cddr lit-search-beg-s)))
(lit-search-end-s (c-semi-pp-to-literal lit-search-end))
(end-literal-beg (car (cddr lit-search-end-s)))
- (beg-literal-end (c-end-of-literal lit-search-beg-s beg))
- (end-literal-end (c-end-of-literal lit-search-end-s end))
+ (beg-literal-end (c-end-of-literal lit-search-beg-s lit-search-beg))
+ (end-literal-end (c-end-of-literal lit-search-end-s lit-search-end))
new-beg new-end search-region)
;; Determine any new end of literal resulting from the
insertion/deletion.
@@ -7212,13 +7212,12 @@ comment at the start of cc-engine.el for more info."
;; Save current settings of the 'syntax-table property in
;; (BEG END), then splat these with the punctuation value.
(goto-char beg)
- (while (progn (skip-syntax-forward "" end)
- (< (point) end))
- (setq syn-tab-value
- (c-get-char-property (point) 'syntax-table))
- (when (not (c-get-char-property (point) 'category))
- (push (cons (point) syn-tab-value) syn-tab-settings))
- (forward-char))
+ (while (setq syn-tab-value
+ (c-search-forward-non-nil-char-property
+ 'syntax-table end))
+ (when (not (c-get-char-property (1- (point)) 'category))
+ (push (cons (1- (point)) syn-tab-value)
+ syn-tab-settings)))
(c-put-char-properties beg end 'syntax-table '(1))
;; If an open string's opener has just been neutralized,
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index f3489a16386..b751ef50520 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -503,309 +503,6 @@
(dolist (b '("server" "other" "#chan" "#foo" "#fake"))
(kill-buffer b))))
-(defun erc-tests--run-in-term (&optional debug)
- (let* ((default-directory (getenv "EMACS_TEST_DIRECTORY"))
- (emacs (expand-file-name invocation-name invocation-directory))
- (process-environment (cons "ERC_TESTS_SUBPROCESS=1"
- process-environment))
- (name (ert-test-name (ert-running-test)))
- (temp-file (make-temp-file "erc-term-test-"))
- (cmd `(let ((stats 1))
- (setq enable-dir-local-variables nil)
- (unwind-protect
- (setq stats (ert-run-tests-batch ',name))
- (unless ',debug
- (let ((buf (with-current-buffer (messages-buffer)
- (buffer-string))))
- (with-temp-file ,temp-file
- (insert buf)))
- (kill-emacs (ert-stats-completed-unexpected stats))))))
- ;; `ert-test' object in Emacs 29 has a `file-name' field
- (file-name (symbol-file name 'ert--test))
- (default-directory (expand-file-name (file-name-directory file-name)))
- (package (if-let* ((found (getenv "ERC_PACKAGE_NAME"))
- ((string-prefix-p "erc-" found)))
- (intern found)
- 'erc))
- (setup (and (featurep 'compat)
- `(progn
- (require 'package)
- (let ((package-load-list '((compat t) (,package t))))
- (package-initialize)))))
- ;; Make subprocess terminal bigger than controlling.
- (buf (cl-letf (((symbol-function 'window-screen-lines)
- (lambda () 20))
- ((symbol-function 'window-max-chars-per-line)
- (lambda () 40)))
- (make-term (symbol-name name) emacs nil "-Q" "-nw"
- "-eval" (prin1-to-string setup)
- "-l" file-name "-eval" (format "%S" cmd))))
- (proc (get-buffer-process buf))
- (err (lambda ()
- (with-temp-buffer
- (insert-file-contents temp-file)
- (message "Subprocess: %s" (buffer-string))
- (delete-file temp-file)))))
- (with-current-buffer buf
- (set-process-query-on-exit-flag proc nil)
- (with-timeout (10 (funcall err) (error "Timed out awaiting result"))
- (while (process-live-p proc)
- (accept-process-output proc 0.1)))
- (while (accept-process-output proc))
- (goto-char (point-min))
- ;; Otherwise gives process exited abnormally with exit-code >0
- (unless (search-forward (format "Process %s finished" name) nil t)
- (funcall err)
- (ert-fail (when (search-forward "exited" nil t)
- (buffer-substring-no-properties (line-beginning-position)
- (line-end-position)))))
- (delete-file temp-file)
- (when noninteractive
- (kill-buffer)))))
-
-(defun erc-tests--servars (source &rest vars)
- (unless (bufferp source)
- (setq source (get-buffer source)))
- (dolist (var vars)
- (should (local-variable-if-set-p var))
- (set var (buffer-local-value var source))))
-
-(defun erc-tests--erc-reuse-frames (test &optional debug)
- (if (and (or debug noninteractive) (not (getenv "ERC_TESTS_SUBPROCESS")))
- (progn
- (when (memq system-type '(windows-nt ms-dos))
- (ert-skip "System must be UNIX"))
- (erc-tests--run-in-term debug))
- (should-not erc-frame-dedicated-flag)
- (should (eq erc-reuse-frames t))
- (let ((erc-join-buffer 'frame)
- (erc-reuse-frames t)
- (erc-frame-alist nil)
- (orig-frame (selected-frame))
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
- (delete-other-frames)
- (delete-other-windows)
- (set-window-buffer (selected-window) "*scratch*")
- (funcall test orig-frame)
- (delete-other-frames orig-frame)
- (delete-other-windows))))
-
-;; TODO add cases for frame-display behavior while reconnecting
-
-(defun erc-tests--erc-reuse-frames--t (_)
- (ert-info ("New server buffer creates and raises second frame")
- (with-current-buffer (generate-new-buffer "server")
- (erc-mode)
- (setq erc-server-process (start-process "server"
- (current-buffer) "sleep" "10")
- erc-frame-alist (cons '(name . "server") default-frame-alist)
- erc-network 'foonet
- erc-networks--id (erc-networks--id-create nil)
- erc--server-last-reconnect-count 0)
- (set-process-buffer erc-server-process (current-buffer))
- (set-process-query-on-exit-flag erc-server-process nil)
- (should-not (get-buffer-window (current-buffer) t))
- (erc-setup-buffer (current-buffer))
- (should (equal "server" (frame-parameter (window-frame) 'name)))
- (should (get-buffer-window (current-buffer) t))))
-
- (ert-info ("New channel creates and raises third frame")
- (with-current-buffer (generate-new-buffer "#chan")
- (erc-mode)
- (erc-tests--servars "server" 'erc-server-process 'erc-networks--id
- 'erc-network)
- (setq erc-frame-alist (cons '(name . "#chan") default-frame-alist)
- erc-default-recipients '("#chan"))
- (should-not (get-buffer-window (current-buffer) t))
- (erc-setup-buffer (current-buffer))
- (should (equal "#chan" (frame-parameter (window-frame) 'name)))
- (should (get-buffer-window (current-buffer) t))
- (should (cddr (frame-list))))))
-
-(ert-deftest erc-reuse-frames--t ()
- :tags '(:unstable :expensive-test)
- (erc-tests--erc-reuse-frames
- (lambda (orig-frame)
- (erc-tests--erc-reuse-frames--t orig-frame)
- (dolist (b '("server" "#chan"))
- (kill-buffer b)))))
-
-(defun erc-tests--erc-reuse-frames--displayed-single (_ server-name chan-name)
-
- (should (eq erc-reuse-frames 'displayed))
-
- (ert-info ("New server buffer shown in existing frame")
- (with-current-buffer (generate-new-buffer server-name)
- (erc-mode)
- (setq erc-server-process (start-process server-name (current-buffer)
- "sleep" "10")
- erc-frame-alist (cons `(name . ,server-name) default-frame-alist)
- erc-network (make-symbol server-name)
- erc-server-current-nick "tester"
- erc-networks--id (erc-networks--id-create nil)
- erc--server-last-reconnect-count 0)
- (set-process-buffer erc-server-process (current-buffer))
- (set-process-query-on-exit-flag erc-server-process nil)
- (should-not (get-buffer-window (current-buffer) t))
- (erc-setup-buffer (current-buffer))
- (should-not (equal server-name (frame-parameter (window-frame) 'name)))
- ;; New server buffer window appears in split below ERT/scratch
- (should (get-buffer-window (current-buffer) t))))
-
- (ert-info ("New channel shown in existing frame")
- (with-current-buffer (generate-new-buffer chan-name)
- (erc-mode)
- (erc-tests--servars server-name 'erc-server-process 'erc-networks--id
- 'erc-network)
- (setq erc-frame-alist (cons `(name . ,chan-name) default-frame-alist)
- erc-default-recipients (list chan-name))
- (should-not (get-buffer-window (current-buffer) t))
- (erc-setup-buffer (current-buffer))
- (should-not (equal chan-name (frame-parameter (window-frame) 'name)))
- ;; New channel buffer replaces server in lower window
- (should (get-buffer-window (current-buffer) t))
- (should-not (get-buffer-window server-name t)))))
-
-(ert-deftest erc-reuse-frames--displayed-single ()
- :tags '(:unstable :expensive-test)
- (erc-tests--erc-reuse-frames
- (lambda (orig-frame)
- (let ((erc-reuse-frames 'displayed))
- (erc-tests--erc-reuse-frames--displayed-single orig-frame
- "server" "#chan")
- (should-not (cdr (frame-list))))
- (dolist (b '("server" "#chan"))
- (kill-buffer b)))))
-
-(defun erc-tests--assert-server-split (buffer-or-name frame-name)
- ;; Assert current buffer resides on one side of a horizontal split
- ;; in the "server" frame but is not selected.
- (let* ((buffer-window (get-buffer-window buffer-or-name t))
- (buffer-frame (window-frame buffer-window)))
- (should (equal frame-name (frame-parameter buffer-frame 'name)))
- (should (memq buffer-window (car-safe (window-tree buffer-frame))))
- (should-not (eq buffer-window (frame-selected-window)))
- buffer-frame))
-
-(defun erc-tests--erc-reuse-frames--displayed-double (_)
- (should (eq erc-reuse-frames 'displayed))
-
- (make-frame '((name . "other")))
- (select-frame (make-frame '((name . "server"))) 'no-record)
- (set-window-buffer (selected-window) "*scratch*") ; invokes `erc'
-
- ;; A user invokes an entry point and switches immediately to a new
- ;; frame before autojoin kicks in (bug#55540).
-
- (ert-info ("New server buffer shown in selected frame")
- (with-current-buffer (generate-new-buffer "server")
- (erc-mode)
- (setq erc-server-process (start-process "server" (current-buffer)
- "sleep" "10")
- erc-network 'foonet
- erc-server-current-nick "tester"
- erc-networks--id (erc-networks--id-create nil)
- erc--server-last-reconnect-count 0)
- (set-process-buffer erc-server-process (current-buffer))
- (set-process-query-on-exit-flag erc-server-process nil)
- (should-not (get-buffer-window (current-buffer) t))
- (erc-setup-buffer (current-buffer))
- (should (equal "server" (frame-parameter (window-frame) 'name)))
- (should (get-buffer-window (current-buffer) t))))
-
- (select-frame-by-name "other")
-
- (ert-info ("New channel shown in dedicated frame")
- (with-current-buffer (generate-new-buffer "#chan")
- (erc-mode)
- (erc-tests--servars "server" 'erc-server-process 'erc-networks--id
- 'erc-network)
- (setq erc-frame-alist (cons '(name . "#chan") default-frame-alist)
- erc-default-recipients '("#chan"))
- (should-not (get-buffer-window (current-buffer) t))
- (erc-setup-buffer (current-buffer))
- (erc-tests--assert-server-split (current-buffer) "server")
- ;; New channel buffer replaces server in lower window of other frame
- (should-not (get-buffer-window "server" t)))))
-
-(ert-deftest erc-reuse-frames--displayed-double ()
- :tags '(:unstable :expensive-test)
- (erc-tests--erc-reuse-frames
- (lambda (orig-frame)
- (let ((erc-reuse-frames 'displayed))
- (erc-tests--erc-reuse-frames--displayed-double orig-frame))
- (dolist (b '("server" "#chan"))
- (kill-buffer b)))))
-
-;; If a frame showing ERC buffers exists among other frames, new,
-;; additional connections will use the existing IRC frame. However,
-;; if two or more frames exist with ERC buffers unique to a particular
-;; connection, the correct frame will be found.
-
-(defun erc-tests--erc-reuse-frames--displayed-full (orig-frame)
- (erc-tests--erc-reuse-frames--displayed-double orig-frame)
- ;; Server buffer is not displayed because #chan has replaced it in
- ;; the "server" frame, which is not selected.
- (should (equal "other" (frame-parameter (window-frame) 'name)))
- (erc-tests--erc-reuse-frames--displayed-single orig-frame "ircd" "#spam")
- (should (equal "other" (frame-parameter (window-frame) 'name)))
-
- ;; Buffer "#spam" has replaced "ircd", which earlier replaced
- ;; "#chan" in frame "server". But this is confusing, so...
- (ert-info ("Arrange windows for second connection in other frame")
- (set-window-buffer (selected-window) "ircd")
- (split-window-below)
- (set-window-buffer (next-window) "#spam")
- (should (equal (cddar (window-tree))
- (list (get-buffer-window "ircd" t)
- (get-buffer-window "#spam" t)))))
-
- (ert-info ("Arrange windows for first connection in server frame")
- (select-frame-by-name "server")
- (set-window-buffer (selected-window) "server")
- (set-window-buffer (next-window) "#chan")
- (should (equal (cddar (window-tree))
- (list (get-buffer-window "server" t)
- (get-buffer-window "#chan" t)))))
-
- ;; Select original ERT frame
- (ert-info ("New target for connection server finds appropriate frame")
- (select-frame orig-frame 'no-record)
- (with-current-buffer (window-buffer (selected-window))
- (should (member (buffer-name) '("*ert*" "*scratch*")))
- (with-current-buffer (generate-new-buffer "alice")
- (erc-mode)
- (erc-tests--servars "server" 'erc-server-process 'erc-networks--id)
- (setq erc-default-recipients '("alice"))
- (should-not (get-buffer-window (current-buffer) t))
- (erc-setup-buffer (current-buffer))
- ;; Window created in frame "server"
- (should (eq (selected-frame) orig-frame))
- (erc-tests--assert-server-split (current-buffer) "server"))))
-
- (ert-info ("New target for connection ircd finds appropriate frame")
- (select-frame orig-frame 'no-record)
- (with-current-buffer (window-buffer (selected-window))
- (should (member (buffer-name) '("*ert*" "*scratch*")))
- (with-current-buffer (generate-new-buffer "bob")
- (erc-mode)
- (erc-tests--servars "ircd" 'erc-server-process 'erc-networks--id)
- (setq erc-default-recipients '("bob"))
- (should-not (get-buffer-window (current-buffer) t))
- (erc-setup-buffer (current-buffer))
- ;; Window created in frame "other"
- (should (eq (selected-frame) orig-frame))
- (erc-tests--assert-server-split (current-buffer) "other")))))
-
-(ert-deftest erc-reuse-frames--displayed-full ()
- :tags '(:unstable :expensive-test)
- (erc-tests--erc-reuse-frames
- (lambda (orig-frame)
- (let ((erc-reuse-frames 'displayed))
- (erc-tests--erc-reuse-frames--displayed-full orig-frame))
- (dolist (b '("server" "ircd" "bob" "alice" "#spam" "#chan"))
- (kill-buffer b)))))
-
(ert-deftest erc-lurker-maybe-trim ()
(let (erc-lurker-trim-nicks
(erc-lurker-ignore-chars "_`"))