Change: Workaround font-lock issue in magit-section

Fixes #331.

Author: alphapapa

README.org

@@ -313,6 +313,7 @@ Ement.el doesn't support encrypted rooms natively, but it can be used transparen
 *Fixes*
 
 + Call ~eww-browse-url~ instead of ~browse-url~ in ~ement-room-browse-mxc~ (because the latter is not useful for authenticated media if the user has configured it to use a different browser).  ([[https://github.com/alphapapa/ement.el/pull/323][#323]].  Thanks to [[https://github.com/viiru-][Arto Jantunen]].)
++ Workaround change in ~magit-section~ that broke fontification in room-list and directory buffers.  (See [[https://github.com/alphapapa/ement.el/issues/331][#331]].)
 
 ** 0.16
 

ement-directory.el

@@ -93,7 +93,8 @@
       (_ (when-let ((room (cl-find id (ement-session-rooms session)
                                    :key #'ement-room-id :test #'equal))
                     ((ement--room-direct-p room session)))
-           (propertize "People" 'face 'ement-room-list-direct))))))
+           (ement-propertize "People"
+             'face 'ement-room-list-direct))))))
 
 (defcustom ement-directory-default-keys
   '((joined-p
@@ -143,8 +144,8 @@
                             'ement-room-list-name)))))
     ;; NOTE: We can't use `ement--room-display-name' because these aren't room structs,
     ;; and we don't have membership data.
-    (propertize (or name canonical-alias "[unnamed]")
-                'face face)))
+    (ement-propertize (or name canonical-alias "[unnamed]")
+      'face face)))
 
 (ement-directory-define-column "Alias" (:max-width 25)
   (pcase-let (((map ('canonical_alias alias)) item))
@@ -419,8 +420,8 @@ SPACE may be a room ID or an `ement-room' struct."
                   ;; TODO: Use space's alias where possible.
                   :buffer-name (format "*Ement Directory: space %s" (ement--format-room space session))
                   :root-section-name (format "*Ement Directory: rooms in %s %s"
-                                             (propertize "space"
-                                                         'face 'font-lock-type-face)
+                                             (ement-propertize "space"
+                                               'face 'font-lock-type-face)
                                              (ement--format-room space session))
                   :init-fn (lambda ()
                              (setf (alist-get 'session ement-directory-etc) session

ement-macros.el

@@ -228,6 +228,30 @@ BODY may begin with property list arguments, including:
                  ement-session session)))
        ,@body)))
 
+(defmacro ement-propertize (string &rest properties)
+  "Like `propertize', but auto-set `font-lock-face' property.
+If the `face' property is set, also set the `font-lock-face' property to
+the same value."
+  ;; This is a workaround for a change in `magit-section'; see
+  ;; <https://github.com/alphapapa/ement.el/issues/331>.  By setting both face properties,
+  ;; we should preserve backward compatibility.  Someday this can be removed and we'll
+  ;; just call `propertize' again.
+  (declare (indent defun))
+  (when (and (member ''face properties)
+             (not (member ''font-lock-face properties)))
+    (pcase (plist-get properties ''face #'equal)
+      ((or (pred atom) `(quote ,(pred atom)))
+       `(propertize ,string ,@properties
+                    'font-lock-face ,(plist-get properties ''face #'equal)))
+      (_
+       ;; Avoid evaluating the 'face property's form twice.
+       (let ((value-form (plist-get properties ''face #'equal))
+             (value-var (gensym "ement-propertize-")))
+         (setf (plist-get properties ''face #'equal) value-var
+               (plist-get properties ''font-lock-face #'equal) value-var)
+         `(let ((,value-var ,value-form))
+            (propertize ,string ,@properties)))))))
+
 ;;;; Variables
 
 

ement-room-list.el

@@ -254,7 +254,7 @@ from recent to non-recent for rooms updated in the past hour."
 (ement-room-list-define-key people ()
   (pcase-let ((`[,room ,session] item))
     (when (ement--room-direct-p room session)
-      (propertize "People" 'face 'ement-room-list-direct))))
+      (ement-propertize "People" 'face 'ement-room-list-direct))))
 
 (ement-room-list-define-key space (&key name id)
   (pcase-let* ((`[,room ,session] item)
@@ -285,7 +285,7 @@ from recent to non-recent for rooms updated in the past hour."
                           (_
                            ;; TODO: How to handle this better?  (though it should be very rare)
                            (string-join (mapcar #'format-space parents) ", "))))))
-        (propertize key 'face 'ement-room-list-space)))))
+        (ement-propertize key 'face 'ement-room-list-space)))))
 
 (ement-room-list-define-key space-p ()
   "Groups rooms that are themselves spaces."
@@ -355,7 +355,7 @@ from recent to non-recent for rooms updated in the past hour."
   :then #'identity
   (pcase-let ((`[,room ,_session] item))
     (when (ement--room-favourite-p room)
-      (propertize "Favourite" 'face 'ement-room-list-favourite))))
+      (ement-propertize "Favourite" 'face 'ement-room-list-favourite))))
 
 (ement-room-list-define-key low-priority ()
   :then #'identity
@@ -462,10 +462,10 @@ from recent to non-recent for rooms updated in the past hour."
              (push 'ement-room-list-invited (map-elt face :inherit)))
             ('leave
              (push 'ement-room-list-left (map-elt face :inherit))))
-          (propertize display-name
-                      'face face
-                      'mouse-face 'highlight
-                      'keymap ement-room-list-button-map))
+          (ement-propertize display-name
+            'face face
+            'mouse-face 'highlight
+            'keymap ement-room-list-button-map))
         "")))
 
 (ement-room-list-define-column #("Unread" 0 6 (help-echo "Unread events (Notifications:Highlights)")) (:align 'right)
@@ -475,13 +475,13 @@ from recent to non-recent for rooms updated in the past hour."
             (and (equal 0 notification_count)
                  (equal 0 highlight_count)))
         ""
-      (concat (propertize (number-to-string notification_count)
-                          'face (if (zerop highlight_count)
-                                    'default
-                                  'ement-room-mention))
+      (concat (ement-propertize (number-to-string notification_count)
+                'face (if (zerop highlight_count)
+                          'default
+                        'ement-room-mention))
               ":"
-              (propertize (number-to-string highlight_count)
-                          'face 'highlight)))))
+              (ement-propertize (number-to-string highlight_count)
+                'face 'highlight)))))
 
 (ement-room-list-define-column "Latest" ()
   (pcase-let ((`[,(cl-struct ement-room latest-ts) ,_session] item))
@@ -498,8 +498,9 @@ from recent to non-recent for rooms updated in the past hour."
                (face (list :foreground (elt ement-room-list-timestamp-colors n)))
                (formatted-ts (ement--human-format-duration difference-seconds 'abbreviate)))
           (string-match (rx (1+ digit) (repeat 1 alpha)) formatted-ts)
-          (propertize (match-string 0 formatted-ts) 'face face
-                      'help-echo formatted-ts))
+          (ement-propertize (match-string 0 formatted-ts)
+            'face face
+            'help-echo formatted-ts))
       "")))
 
 (ement-room-list-define-column "Topic" (:max-width 35)
@@ -508,11 +509,11 @@ from recent to non-recent for rooms updated in the past hour."
     (when topic
       (setf topic (replace-regexp-in-string "\n" " " topic 'fixedcase 'literal)))
     (pcase status
-      ('invite (concat (propertize "[invited]"
-                                   'face 'ement-room-list-invited)
+      ('invite (concat (ement-propertize "[invited]"
+                         'face 'ement-room-list-invited)
                        " " topic))
-      ('leave (concat (propertize "[left]"
-                                  'face 'ement-room-list-left)
+      ('leave (concat (ement-propertize "[left]"
+                        'face 'ement-room-list-left)
                       " " topic))
       (_ (or topic "")))))