From 797e9cce1ad3fc34fc59ddbadd9d28d017955b59 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 7 Feb 2023 00:02:26 -0800 Subject: [PATCH 0/3] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (3): [5.6] Be smarter about switching to TLS from M-x erc [5.6] Add display option for interactive ERC invocations [5.6] Optionally prompt for more ERC entry-point params doc/misc/erc.texi | 2 +- lisp/erc/erc.el | 108 ++++++++++++++++++--------- test/lisp/erc/erc-tests.el | 146 +++++++++++++++++++++++++++++++------ 3 files changed, 199 insertions(+), 57 deletions(-) Interdiff: diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 691e865bfa4..6aec59e6f11 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2234,15 +2234,27 @@ erc-select-read-args (eql port erc-default-port) (y-or-n-p "Connect using TLS instead? ") (setq port erc-default-port-tls))) - #'erc-open-tls-stream))) + #'erc-open-tls-stream)) + env) + (when erc-interactive-display + (push `(erc-join-buffer . ,erc-interactive-display) env)) + (when opener + (push `(erc-server-connect-function . ,opener) env)) (when (and passwd (string= "" passwd)) (setq passwd nil)) `( :server ,server :port ,port :nick ,nick ,@(and user `(:user ,user)) ,@(and passwd `(:password ,passwd)) ,@(and full `(:full-name ,full)) - ,@(and erc-interactive-display - `(buffer-display ,erc-interactive-display)) - ,@(and opener `(connect-function ,opener))))) - + ,@(and env `(&interactive-env ,env))))) + +(defmacro erc--with-entrypoint-environment (env &rest body) + "Run BODY with bindings from ENV alist." + (declare (indent 1)) + (let ((syms (make-symbol "syms")) + (vals (make-symbol "vals"))) + `(let (,syms ,vals) + (pcase-dolist (`(,k . ,v) ,env) (push k ,syms) (push v ,vals)) + (cl-progv ,syms ,vals + ,@body)))) ;;;###autoload (cl-defun erc (&key (server (erc-compute-server)) @@ -2252,10 +2264,8 @@ erc password (full-name (erc-compute-full-name)) id - ;; For interactive use - ((buffer-display erc-join-buffer) erc-join-buffer) - ((connect-function erc-server-connect-function) - erc-server-connect-function)) + ;; Used by interactive form + ((&interactive-env --interactive-env--))) "ERC is a powerful, modular, and extensible IRC client. This function is the main entry point for ERC. @@ -2282,7 +2292,8 @@ erc \(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME ID)" (interactive (erc-select-read-args)) - (erc-open server port nick full-name t password nil nil nil nil user id)) + (erc--with-entrypoint-environment --interactive-env-- + (erc-open server port nick full-name t password nil nil nil nil user id))) ;;;###autoload (defalias 'erc-select #'erc) @@ -2297,13 +2308,8 @@ erc-tls (full-name (erc-compute-full-name)) client-certificate id - ;; For interactive use - ((buffer-display erc-join-buffer) erc-join-buffer) - ((connect-function erc-server-connect-function) - (if (eq erc-server-connect-function - #'erc-open-network-stream) - #'erc-open-tls-stream - erc-server-connect-function))) + ;; Used by interactive form + ((&interactive-env --interactive-env--))) "ERC is a powerful, modular, and extensible IRC client. This function is the main entry point for ERC over TLS. @@ -2352,7 +2358,12 @@ erc-tls \(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME CLIENT-CERTIFICATE ID)" (interactive (let ((erc-default-port erc-default-port-tls)) (erc-select-read-args))) - (progn + (unless (or (assq 'erc-server-connect-function --interactive-env--) + ;; Fails when advice is present, but assume user can cope. + (not (eq erc-server-connect-function #'erc-open-network-stream))) + (push '(erc-server-connect-function . erc-open-tls-stream) + --interactive-env--)) + (erc--with-entrypoint-environment --interactive-env-- (erc-open server port nick full-name t password nil nil nil client-certificate user id))) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 1029a38c726..8f44d984f09 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -999,6 +999,13 @@ erc--server-connect-dumb-ipv6-regexp (should (string-match erc--server-connect-dumb-ipv6-regexp (concat "[" a "]"))))) +(ert-deftest erc--with-entrypoint-environment () + (let ((env '((erc-join-buffer . foo) + (erc-server-connect-function . bar)))) + (erc--with-entrypoint-environment env + (should (eq erc-join-buffer 'foo)) + (should (eq erc-server-connect-function 'bar))))) + (ert-deftest erc-select-read-args () (ert-info ("Prompts for switch to TLS by default") @@ -1007,8 +1014,9 @@ erc-select-read-args (list :server "irc.libera.chat" :port 6697 :nick (user-login-name) - 'buffer-display 'buffer - 'connect-function #'erc-open-tls-stream)))) + '&interactive-env + '((erc-server-connect-function . erc-open-tls-stream) + (erc-join-buffer . buffer)))))) (ert-info ("Switches to TLS when port matches default TLS port") (should (equal (ert-simulate-keys "irc.gnu.org\r6697\r\r\r" @@ -1016,8 +1024,9 @@ erc-select-read-args (list :server "irc.gnu.org" :port 6697 :nick (user-login-name) - 'buffer-display 'buffer - 'connect-function #'erc-open-tls-stream)))) + '&interactive-env + '((erc-server-connect-function . erc-open-tls-stream) + (erc-join-buffer . buffer)))))) (ert-info ("Switches to TLS when URL is ircs://") (should (equal (ert-simulate-keys "ircs://irc.gnu.org\r\r\r\r" @@ -1025,8 +1034,9 @@ erc-select-read-args (list :server "irc.gnu.org" :port 6697 :nick (user-login-name) - 'buffer-display 'buffer - 'connect-function #'erc-open-tls-stream)))) + '&interactive-env + '((erc-server-connect-function . erc-open-tls-stream) + (erc-join-buffer . buffer)))))) (setq-local erc-interactive-display nil) ; cheat to save space @@ -1100,17 +1110,25 @@ erc-select-read-args :full-name "nick"))))) (ert-deftest erc-tls () - (let (calls) + (let (calls env) (cl-letf (((symbol-function 'user-login-name) (lambda (&optional _) "tester")) ((symbol-function 'erc-open) - (lambda (&rest r) (push r calls)))) + (lambda (&rest r) + (push `((erc-join-buffer ,erc-join-buffer) + (erc-server-connect-function + ,erc-server-connect-function)) + env) + (push r calls)))) (ert-info ("Defaults") (erc-tls) (should (equal (pop calls) '("irc.libera.chat" 6697 "tester" "unknown" t - nil nil nil nil nil "user" nil)))) + nil nil nil nil nil "user" nil))) + (should (equal (pop env) + '((erc-join-buffer bury) + (erc-server-connect-function erc-open-tls-stream))))) (ert-info ("Full") (erc-tls :server "irc.gnu.org" @@ -1123,7 +1141,10 @@ erc-tls :id 'GNU.org) (should (equal (pop calls) '("irc.gnu.org" 7000 "bob" "Bob's Name" t - "bob:changeme" nil nil nil t "bobo" GNU.org)))) + "bob:changeme" nil nil nil t "bobo" GNU.org))) + (should (equal (pop env) + '((erc-join-buffer bury) + (erc-server-connect-function erc-open-tls-stream))))) ;; Values are often nil when called by lisp code, which leads to ;; null params. This is why `erc-open' recomputes almost @@ -1139,7 +1160,56 @@ erc-tls :password "bob:changeme")) (should (equal (pop calls) '(nil 7000 nil "Bob's Name" t - "bob:changeme" nil nil nil nil "bobo" nil))))))) + "bob:changeme" nil nil nil nil "bobo" nil))) + (should (equal (pop env) + '((erc-join-buffer bury) + (erc-server-connect-function erc-open-tls-stream))))) + + (ert-info ("Interactive") + (ert-simulate-keys "nick:sesame@localhost:6667\r\r" + (call-interactively #'erc-tls)) + (should (equal (pop calls) + '("localhost" 6667 "nick" "unknown" t "sesame" + nil nil nil nil "user" nil))) + (should (equal (pop env) + '((erc-join-buffer buffer) (erc-server-connect-function + erc-open-tls-stream)))))))) + +;; See `erc-select-read-args' above for argument parsing. +;; This only tests the "hidden" arguments. + +(ert-deftest erc--interactive () + (let (calls env) + (cl-letf (((symbol-function 'user-login-name) + (lambda (&optional _) "tester")) + ((symbol-function 'erc-open) + (lambda (&rest r) + (push `((erc-join-buffer ,erc-join-buffer) + (erc-server-connect-function + ,erc-server-connect-function)) + env) + (push r calls)))) + + (ert-info ("Default click-through accept TLS upgrade") + (ert-simulate-keys "\r\r\r\ry\r" + (call-interactively #'erc)) + (should (equal (pop calls) + '("irc.libera.chat" 6697 "tester" "unknown" t nil + nil nil nil nil "user" nil))) + (should (equal (pop env) + '((erc-join-buffer buffer) (erc-server-connect-function + erc-open-tls-stream))))) + + (ert-info ("Nick supplied, decline TLS upgrade") + (ert-simulate-keys "\r\rdummy\r\rn\r" + (call-interactively #'erc)) + (should (equal (pop calls) + '("irc.libera.chat" 6667 "dummy" "unknown" t nil + nil nil nil nil "user" nil))) + (should (equal (pop env) + '((erc-join-buffer buffer) + (erc-server-connect-function + erc-open-network-stream)))))))) (defun erc-tests--make-server-buf (name) (with-current-buffer (get-buffer-create name) -- 2.39.1