From 6ded8441328db8019f546182ec1f7943bead9160 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 3 Dec 2023 19:19:37 -0800 Subject: [PATCH 05/11] [5.6] Add utility for iterating over arrays in ERC * lisp/erc/erc-common.el (erc--doarray): Add macro for mapping over arrays. ERC has the unique requirement of having to repeatedly traverse strings that contain flags for advertised server features. It doesn't make sense to "encode" these meanings into enums or dynamically generate variables for each flag. Hash tables and plain lists require additional setup and aren't as compact to print for inspection. * lisp/erc/erc-dcc.el (erc-dcc-handle-ctcp-send): Use `string-search' instead of `seq-contains-p' even though performance doesn't matter here. * lisp/erc/erc.el (erc--channel-mode-types): Use `erc--doarray' instead of `dolist'. (erc--process-channel-modes): Use `erc--doarray' instead of `dolist', and don't create a string from current char until needed. (erc--parse-user-modes): Use `erc--doarray' instead of `dolist'. * test/lisp/erc/erc-tests.el (erc--doarray): New test. --- lisp/erc/erc-common.el | 19 +++++++++++++++++++ lisp/erc/erc-dcc.el | 4 ++-- lisp/erc/erc.el | 35 ++++++++++++++++------------------- test/lisp/erc/erc-tests.el | 13 +++++++++++++ 4 files changed, 50 insertions(+), 21 deletions(-) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index c5e4901c6d2..e9e494720e5 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -535,6 +535,25 @@ erc-define-message-format-catalog (declare (indent 1)) `(erc--define-catalog ,language ,entries)) +(defmacro erc--doarray (spec &rest body) + "Map over ARRAY, running BODY with VAR bound to iteration element. +Behave more or less like `seq-doseq', but tailor operations for +arrays. + +\(fn (VAR ARRAY [RESULT]) BODY...)" + (declare (indent 1) (debug ((symbolp form &optional form) body))) + (let ((array (make-symbol "array")) + (len (make-symbol "len")) + (i (make-symbol "i"))) + `(let* ((,array ,(nth 1 spec)) + (,len (length ,array)) + (,i 0)) + (while-let (((< ,i ,len)) + (,(car spec) (aref ,array ,i))) + ,@body + (cl-incf ,i)) + ,(nth 2 spec)))) + (provide 'erc-common) ;;; erc-common.el ends here diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 3bcdfb96eb8..ac7fc817cb9 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -713,8 +713,8 @@ erc-dcc-handle-ctcp-send (port (match-string 4 query)) (size (match-string 5 query)) (sub (substring (match-string 6 query) 0 -4)) - (secure (seq-contains-p sub ?S #'eq)) - (turbo (seq-contains-p sub ?T #'eq))) + (secure (string-search "S" sub)) + (turbo (string-search "T" sub))) ;; FIXME: a warning really should also be sent ;; if the ip address != the host the dcc sender is on. (erc-display-message diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 7397add1e98..9084b7ee042 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -6800,7 +6800,7 @@ erc--channel-mode-types (ct (make-char-table 'erc--channel-mode-types)) (type ?a)) (dolist (cs types) - (dolist (c (append cs nil)) + (erc--doarray (c cs) (aset ct c type)) (cl-incf type)) (make-erc--channel-mode-types :key key @@ -6819,21 +6819,20 @@ erc--process-channel-modes (table (erc--channel-mode-types-table obj)) (fallbackp (erc--channel-mode-types-fallbackp obj)) (+p t)) - (dolist (c (append string nil)) - (let ((letter (char-to-string c))) - (cond ((= ?+ c) (setq +p t)) - ((= ?- c) (setq +p nil)) - ((and status-letters (string-search letter status-letters)) - (erc--update-membership-prefix (pop args) c (if +p 'on 'off))) - ((and-let* ((group (or (aref table c) (and fallbackp ?d)))) - (erc--handle-channel-mode group c +p - (and (/= group ?d) - (or (/= group ?c) +p) - (pop args))) - t)) - ((not fallbackp) - (erc-display-message nil '(notice error) (erc-server-buffer) - (format "Unknown channel mode: %S" c)))))) + (erc--doarray (c string) + (cond ((= ?+ c) (setq +p t)) + ((= ?- c) (setq +p nil)) + ((and status-letters (string-search (string c) status-letters)) + (erc--update-membership-prefix (pop args) c (if +p 'on 'off))) + ((and-let* ((group (or (aref table c) (and fallbackp ?d)))) + (erc--handle-channel-mode group c +p + (and (/= group ?d) + (or (/= group ?c) +p) + (pop args))) + t)) + ((not fallbackp) + (erc-display-message nil '(notice error) (erc-server-buffer) + (format "Unknown channel mode: %S" c))))) (setq erc-channel-modes (sort erc-channel-modes #'string<)) (setq erc--mode-line-mode-string (concat "+" (erc--channel-modes erc--mode-line-chanmodes-arg-len))) @@ -6913,9 +6912,7 @@ erc--parse-user-modes (let ((addp t) ;; redundant-add redundant-drop adding dropping) - ;; For short strings, `append' appears to be no slower than - ;; iteration var + `aref' or `mapc' + closure. - (dolist (c (append string nil)) + (erc--doarray (c string) (pcase c (?+ (setq addp t)) (?- (setq addp nil)) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index ed1dcccd59c..2c70f100c3f 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -142,6 +142,19 @@ erc--with-dependent-type-match (widget-editable-list-match w v)) '(face))))) +(ert-deftest erc--doarray () + (let ((array "abcdefg") + out) + ;; No return form. + (should-not (erc--doarray (c array) (push c out))) + (should (equal out '(?g ?f ?e ?d ?c ?b ?a))) + + ;; Return form evaluated upon completion. + (setq out nil) + (should (= 42 (erc--doarray (c array (+ 39 (length out))) + (when (cl-evenp c) (push c out))))) + (should (equal out '(?f ?d ?b))))) + (defun erc-tests--send-prep () ;; Caller should probably shadow `erc-insert-modify-hook' or ;; populate user tables for erc-button. -- 2.42.0