Add utility for iterating over arrays in ERC

* lisp/erc/erc-common.el (erc--doarray): Add macro for mapping over
arrays.  ERC has the uncommon requirement of having to repeatedly
traverse strings that contain flags for advertised server features.
It doesn't make sense to translate these meanings into enums or
dynamically generate variables for each flag.  Hash tables and lists
require additional setup and aren't as compact to inspect.
* 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.  (Bug#67677)

(cherry picked from commit 69ca2cc1138b0fe722d601c2113c83f2a6f791ed)

diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index c79954cdee535527bf6164be8737abac27e21d12..fd6ad47664136e2992575220839acd0a94a00922 100644 (file)
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -543,6 +543,25 @@ the resulting variables will end up with more useful doc strings."
   (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 3bcdfb96eb85cd0c727203fac854b92f7b473db5..ac7fc817cb9c713d1d8c8ea71a9cee094fd078c9 100644 (file)
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -713,8 +713,8 @@ It extracts the information about the dcc request and adds it to
              (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 c499afb22f73cd9f47fe283275ec63c35ba292e4..4d027f0e6c4524af6c09b52e90bd89d04fa26762 100644 (file)
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -6781,7 +6781,7 @@ Use the getter of the same name to retrieve the current value.")
           (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
@@ -6800,21 +6800,20 @@ complement relevant letters in STRING."
          (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)))
@@ -6894,9 +6893,7 @@ dropped were they not already absent."
   (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 1b610a367b6f9e5047f339fafbe1f08b884d664d..361e12c2a91907f5ec2867e1e39928666bc81d66 100644 (file)
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -142,6 +142,19 @@
                                     (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.