]> git.eshelyaron.com Git - emacs.git/commitdiff
Consolidate status-prefix slots of erc-channel-user
authorF. Jason Park <jp@neverwas.me>
Sun, 30 Apr 2023 14:45:01 +0000 (07:45 -0700)
committerF. Jason Park <jp@neverwas.me>
Mon, 18 Dec 2023 04:17:55 +0000 (20:17 -0800)
* etc/ERC-NEWS: Mention change even though the API remains
undisturbed.
* lisp/erc/erc-common.el (erc-channel-user): "Encode" status prefix
slots `voice', `halfop', `op', `admin', and `owner' as single `status'
slot.  Add backward-compatible constructor.  Although the old layout
was overly sparse, since the vast majority of users have no membership
status at all, the point here is not to trade time for space but
rather to improve human readability of ERC buffer substrings
containing text props that reference `erc-channel-user' objects.
* lisp/erc/erc.el (erc--define-channel-user-status-compat-getter):
Helper macro for declaring compat-oriented "getters" for status-prefix
slots of `erc-channel-user'.
(erc-channel-user-voice, erc-channel-user-halfop, erc-channel-user-op,
erc-channel-user-admin, erc-channel-user-owner): Add compat getters.
These are not new functions.  They were previously defined by the
`erc-channel-user' `cl-defstruct' in erc-common.el.
(erc--update-cusr-status-if-changed): New helper macro to make
`erc-update-current-channel-member' more readable.
(erc-update-current-channel-member): Collapse some overly verbose
"unrolled" forms using helper macro and more compact expressions.
* test/lisp/erc/erc-tests.el (erc-channel-user): New test.

etc/ERC-NEWS
lisp/erc/erc-common.el
lisp/erc/erc.el
test/lisp/erc/erc-tests.el

index b38ebfe208cec5e4ed0574f3624c5a47d0bbd1b2..9609be7206e69dd1502f616efae60f9a4eee5e0c 100644 (file)
@@ -460,6 +460,15 @@ like "+" (for "voice"), and to avoid confusion with user modes, like
 "+i" (for "invisible").  Additionally, its lone parameter is now
 overloaded to accept an 'erc-channel-user' object as well as a string.
 
+*** The 'erc-channel-user' struct has a changed internally.
+The five boolean slots for membership prefixes have been folded
+("encoded") into a single integer slot.  However, the old 'setf'-able
+accessors remain available, and the constructor's signature remains
+unchanged.  Since third-party code must be recompiled when upgrading
+ERC anyway, users shouldn't experience any churn.  The only caveat is
+that third-party code using the literal read-syntax of these objects,
+for example, in unit tests, will have to be updated.
+
 *** Hidden messages contain a preceding rather than trailing newline.
 ERC has traditionally only offered to hide messages involving fools,
 but plans are to make hiding more powerful.  Anyone depending on the
index 0b8653876710102a295e205709dc91ecd8c908c3..a45bdd833e8a7d529c201112dbb0ace04f503935 100644 (file)
   ;; Buffers
   (buffers nil))
 
-(cl-defstruct (erc-channel-user (:type vector) :named)
-  voice halfop op admin owner
+(cl-defstruct (erc-channel-user (:type vector)
+                                (:constructor
+                                 erc-channel-user--make
+                                 (&key (status 0) (last-message-time nil)))
+                                (:constructor
+                                 make-erc-channel-user
+                                 ( &key voice halfop op admin owner
+                                   last-message-time
+                                   &aux (status (+ (if voice  1 0)
+                                                   (if halfop 2 0)
+                                                   (if op     4 0)
+                                                   (if admin  8 0)
+                                                   (if owner 16 0)))))
+                                :named)
+  "Object containing channel-specific data for a single user."
+  ;; voice halfop op admin owner
+  (status 0 :type integer)
   ;; Last message time (in the form of the return value of
   ;; (current-time)
   ;;
index 759907b76184a4d19fef5c74469522dfa30c47f7..556682b729fb11e470a75560e55aa4764450957e 100644 (file)
@@ -597,6 +597,29 @@ Removes all users in the current channel.  This is called by
              erc-channel-users)
     (clrhash erc-channel-users)))
 
+(defmacro erc--define-channel-user-status-compat-getter (name n)
+  "Define a gv getter for historical `erc-channel-user' status slot NAME.
+Expect NAME to be a string and N to be its associated power-of-2
+\"enumerated flag\" integer."
+  `(defun ,(intern (concat "erc-channel-user-" name)) (u)
+     ,(format "Get equivalent of pre-5.6 `%s' slot for `erc-channel-user'."
+              name)
+     (declare (gv-setter (lambda (v)
+                           (macroexp-let2 nil v v
+                             (,'\`(let ((val (erc-channel-user-status ,',u)))
+                                    (setf (erc-channel-user-status ,',u)
+                                          (if ,',v
+                                              (logior val ,n)
+                                            (logand val ,(lognot n))))
+                                    ,',v))))))
+     (= ,n (logand ,n (erc-channel-user-status u)))))
+
+(erc--define-channel-user-status-compat-getter "voice"  1)
+(erc--define-channel-user-status-compat-getter "halfop" 2)
+(erc--define-channel-user-status-compat-getter "op"     4)
+(erc--define-channel-user-status-compat-getter "admin"  8)
+(erc--define-channel-user-status-compat-getter "owner" 16)
+
 (defun erc-channel-user-owner-p (nick)
   "Return non-nil if NICK is an owner of the current channel."
   (and nick
@@ -6764,6 +6787,19 @@ which USER is a member, and t is returned."
                   (run-hooks 'erc-channel-members-changed-hook))))))
     changed))
 
+;; This exists solely to make `erc-update-current-channel-member' more
+;; readable.  Having to resort to it is admittedly not ideal.  While
+;; it would seem at first glance that we could go further and encode
+;; the combined status in one go, we can't without gating the entire
+;; operation on the parameters `admin', `halfop', etc. being non-nil.
+(defmacro erc--update-cusr-status-if-changed (cuser changed-var status-var)
+  "Maybe update STATUS-VAR slot of `erc-channel-user' CUSER, and CHANGED-VAR."
+  (let ((accessor (intern (format "erc-channel-user-%s" status-var))))
+    `(when (and ,status-var (not (eq (,accessor ,cuser) ,status-var)))
+       (setf (,accessor ,cuser) (and (not (eq ,status-var 'off))
+                                     (and ,status-var t))
+             ,changed-var t))))
+
 (defun erc-update-current-channel-member
   (nick new-nick &optional add voice halfop op admin owner host login full-name info
         update-message-time)
@@ -6791,41 +6827,11 @@ See also: `erc-update-user' and `erc-update-channel-member'."
     (if cuser
         (progn
           (erc-log (format "update-member: user = %S, cuser = %S" user cuser))
-          (when (and voice
-                     (not (eq (erc-channel-user-voice cuser) voice)))
-            (setq changed t)
-            (setf (erc-channel-user-voice cuser)
-                  (cond ((eq voice 'on) t)
-                        ((eq voice 'off) nil)
-                        (t voice))))
-          (when (and halfop
-                     (not (eq (erc-channel-user-halfop cuser) halfop)))
-            (setq changed t)
-            (setf (erc-channel-user-halfop cuser)
-                  (cond ((eq halfop 'on) t)
-                        ((eq halfop 'off) nil)
-                        (t halfop))))
-          (when (and op
-                     (not (eq (erc-channel-user-op cuser) op)))
-            (setq changed t)
-            (setf (erc-channel-user-op cuser)
-                  (cond ((eq op 'on) t)
-                        ((eq op 'off) nil)
-                        (t op))))
-          (when (and admin
-                     (not (eq (erc-channel-user-admin cuser) admin)))
-            (setq changed t)
-            (setf (erc-channel-user-admin cuser)
-                  (cond ((eq admin 'on) t)
-                        ((eq admin 'off) nil)
-                        (t admin))))
-          (when (and owner
-                     (not (eq (erc-channel-user-owner cuser) owner)))
-            (setq changed t)
-            (setf (erc-channel-user-owner cuser)
-                  (cond ((eq owner 'on) t)
-                        ((eq owner 'off) nil)
-                        (t owner))))
+          (erc--update-cusr-status-if-changed cuser changed voice)
+          (erc--update-cusr-status-if-changed cuser changed halfop)
+          (erc--update-cusr-status-if-changed cuser changed op)
+          (erc--update-cusr-status-if-changed cuser changed admin)
+          (erc--update-cusr-status-if-changed cuser changed owner)
           (when update-message-time
             (setf (erc-channel-user-last-message-time cuser) (current-time)))
           (setq user-changed
@@ -6846,21 +6852,11 @@ See also: `erc-update-user' and `erc-update-channel-member'."
                 (cons (current-buffer)
                       (erc-server-user-buffers user))))
         (setq cuser (make-erc-channel-user
-                     :voice (cond ((eq voice 'on) t)
-                                  ((eq voice 'off) nil)
-                                  (t voice))
-                     :halfop (cond ((eq halfop 'on) t)
-                                ((eq halfop 'off) nil)
-                                (t halfop))
-                     :op (cond ((eq op 'on) t)
-                               ((eq op 'off) nil)
-                               (t op))
-                     :admin (cond ((eq admin 'on) t)
-                                  ((eq admin 'off) nil)
-                                  (t admin))
-                     :owner (cond ((eq owner 'on) t)
-                                  ((eq owner 'off) nil)
-                                  (t owner))
+                     :voice  (and (not (eq voice  'off)) (and voice  t))
+                     :halfop (and (not (eq halfop 'off)) (and halfop t))
+                     :op     (and (not (eq op     'off)) (and op     t))
+                     :admin  (and (not (eq admin  'off)) (and admin  t))
+                     :owner  (and (not (eq owner  'off)) (and owner  t))
                      :last-message-time
                      (if update-message-time (current-time))))
         (puthash (erc-downcase nick) (cons user cuser)
index b7e0cdcaa21e06f8837c5b3bebc3829bb1a4bb06..45cf4ea489f080ca50397e06687144974e6e6744 100644 (file)
     (kill-buffer "baznet")
     (kill-buffer "#chan")))
 
+(ert-deftest erc-channel-user ()
+  ;; Traditional and alternate constructor swapped for compatibility.
+  (should (= 0 (erc-channel-user-status (erc-channel-user--make))))
+  (should-not (erc-channel-user-last-message-time (erc-channel-user--make)))
+
+  (should (= 42 (erc-channel-user-last-message-time
+                 (make-erc-channel-user :last-message-time 42))))
+
+  (should (zerop (erc-channel-user-status (make-erc-channel-user))))
+
+  (let ((u (make-erc-channel-user)))
+
+    (ert-info ("Add voice status to user")
+      (should (= 0 (erc-channel-user-status u)))
+      (should-not (erc-channel-user-voice u))
+      (should (eq t (setf (erc-channel-user-voice u) t)))
+      (should (eq t (erc-channel-user-voice u))))
+
+    (ert-info ("Add op status to user")
+      (should (= 1 (erc-channel-user-status u)))
+      (should-not (erc-channel-user-op u))
+      (should (eq t (setf (erc-channel-user-op u) t)))
+      (should (eq t (erc-channel-user-op u))))
+
+    (ert-info ("Add owner status to user")
+      (should (= 5 (erc-channel-user-status u)))
+      (should-not (erc-channel-user-owner u))
+      (should (eq t (setf (erc-channel-user-owner u) t)))
+      (should (eq t (erc-channel-user-owner u))))
+
+    (ert-info ("Remove owner status from user")
+      (should (= 21 (erc-channel-user-status u)))
+      (should-not (setf (erc-channel-user-owner u) nil))
+      (should-not (erc-channel-user-owner u)))
+
+    (ert-info ("Remove op status from user")
+      (should (= 5 (erc-channel-user-status u)))
+      (should-not (setf (erc-channel-user-op u) nil))
+      (should-not (erc-channel-user-op u)))
+
+    (ert-info ("Remove voice status from user")
+      (should (= 1 (erc-channel-user-status u)))
+      (should-not (setf (erc-channel-user-voice u) nil))
+      (should-not (erc-channel-user-voice u)))
+
+    (ert-info ("Remove voice status from zeroed user")
+      (should (= 0 (erc-channel-user-status u)))
+      (should-not (setf (erc-channel-user-voice u) nil))
+      (should-not (erc-channel-user-voice u))
+      (should (= 0 (erc-channel-user-status u))))))
+
 (defconst erc-tests--modules
   '( autoaway autojoin bufbar button capab-identify
      command-indicator completion dcc fill identd