master 69ca2cc1138 05/19: Add utility for iterating over arrays in ERC

[F. Jason Park]

branch: master
commit 69ca2cc1138b0fe722d601c2113c83f2a6f791ed
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    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)
---
 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 c79954cdee5..fd6ad476641 100644
--- 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 3bcdfb96eb8..ac7fc817cb9 100644
--- 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 c499afb22f7..4d027f0e6c4 100644
--- 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 1b610a367b6..361e12c2a91 100644
--- 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.