Strip HTML from event descriptions before insertion

org-gcal.el

@@ -116,6 +116,31 @@ Predicate functions take an event, and if they return nil the
   :group 'org-gcal
   :type 'list)
 
+(defcustom org-gcal-strip-html-descriptions nil
+  "Whether to strip HTML tags and entities from event descriptions.
+When non-nil, HTML in event descriptions fetched from Google Calendar
+is converted to plain text before insertion into Org files.
+
+This is the global default.  Use `org-gcal-strip-html-descriptions-overrides'
+to override this setting for specific calendars."
+  :group 'org-gcal
+  :type 'boolean)
+
+(defcustom org-gcal-strip-html-descriptions-overrides nil
+  "Per-calendar overrides for `org-gcal-strip-html-descriptions'.
+An alist mapping calendar IDs to booleans.  Calendars listed here
+use the specified value instead of the global default.
+
+For example, to strip HTML globally but preserve it for a shared
+calendar:
+
+  (setq org-gcal-strip-html-descriptions t)
+  (setq org-gcal-strip-html-descriptions-overrides
+        \\='((\"shared-calendar@group.calendar.google.com\" . nil)))"
+  :group 'org-gcal
+  :type '(alist :key-type (string :tag "Calendar ID")
+                :value-type (boolean :tag "Strip HTML")))
+
 (defcustom org-gcal-notify-p t
   "If nil no more alert messages are shown for status updates."
   :group 'org-gcal
@@ -1488,6 +1513,33 @@ delete calendar info from events on calendars you no longer have access to."
         ""
       (substring string from to))))
 
+(defun org-gcal--strip-html-p (calendar-id)
+  "Return non-nil if HTML should be stripped for CALENDAR-ID.
+Consult `org-gcal-strip-html-descriptions-overrides' first, falling
+back to `org-gcal-strip-html-descriptions'."
+  (if-let* ((override (assoc calendar-id
+                              org-gcal-strip-html-descriptions-overrides
+                              #'string=)))
+      (cdr override)
+    org-gcal-strip-html-descriptions))
+
+(defun org-gcal--strip-html (string)
+  "Strip HTML tags and decode entities in STRING.
+Google Calendar returns event descriptions as HTML.  Convert to
+plain text suitable for insertion into Org files."
+  (thread-last string
+    (replace-regexp-in-string "<br[^>]*>" "\n")
+    (replace-regexp-in-string "<li[^>]*>" "\n- ")
+    (replace-regexp-in-string "<[^>]+>" "")
+    (replace-regexp-in-string "&amp;" "&")
+    (replace-regexp-in-string "&lt;" "<")
+    (replace-regexp-in-string "&gt;" ">")
+    (replace-regexp-in-string "&nbsp;" " ")
+    (replace-regexp-in-string "&quot;" "\"")
+    (replace-regexp-in-string "&#39;" "'")
+    (replace-regexp-in-string "\n\\{3,\\}" "\n\n")
+    (string-trim)))
+
 (defun org-gcal--alldayp (s e)
   (let ((slst (org-gcal--parse-date s))
         (elst (org-gcal--parse-date e)))
@@ -1621,7 +1673,10 @@ heading."
   (unless (org-at-heading-p)
     (user-error "Must be on Org-mode heading."))
   (let* ((smry  (plist-get event :summary))
-         (desc  (plist-get event :description))
+         (desc  (when-let* ((d (plist-get event :description)))
+                  (if (org-gcal--strip-html-p calendar-id)
+                      (org-gcal--strip-html d)
+                    d)))
          (loc   (plist-get event :location))
          (source (plist-get event :source))
          (transparency   (plist-get event :transparency))
@@ -1643,7 +1698,7 @@ heading."
          (old-start (plist-get old-time-desc :start))
          (old-end (plist-get old-time-desc :start))
          (recurrence (plist-get event :recurrence))
-         (elem))
+         (elem (org-element-at-point)))
     (when loc (replace-regexp-in-string "\n" ", " loc))
     (org-edit-headline
      (cond
@@ -1693,7 +1748,6 @@ heading."
     ;; Insert event time and description in :ORG-GCAL: drawer, erasing the
     ;; current contents.
     (org-gcal--back-to-heading)
-    (setq elem (org-element-at-point))
     (save-excursion
       (when (re-search-forward
              (format

test/org-gcal-test.el

@@ -81,6 +81,12 @@
 }
 ")
 
+(defconst org-gcal-test-html-event-json
+  (replace-regexp-in-string
+   "My event description\\\\n\\\\nSecond paragraph"
+   "<html-blob>Click the link:<br><a href=\\\\\"https://meet.jit.si/Weekly\\\\\">https://meet.jit.si/Weekly</a><br><br>Items:<br><ul><li>First</li><li>Second</li></ul>&amp; more info</html-blob>"
+   org-gcal-test-event-json))
+
 (defconst org-gcal-test-cancelled-event-json
   (replace-regexp-in-string "confirmed" "cancelled"
                             org-gcal-test-event-json))
@@ -124,6 +130,9 @@ always located at the beginning of the buffer."
 (defconst org-gcal-test-event
   (org-gcal-test--json-read-string org-gcal-test-event-json))
 
+(defconst org-gcal-test-html-event
+  (org-gcal-test--json-read-string org-gcal-test-html-event-json))
+
 (defconst org-gcal-test-cancelled-event
   (org-gcal-test--json-read-string org-gcal-test-cancelled-event-json))
 
@@ -1365,6 +1374,110 @@ Second paragraph
 ;;                  (buffer-substring-no-properties (point-min) (point-max))))
 ;;             (should (string-equal bufstr target-buf))))))))
 
+(ert-deftest org-gcal-test--strip-html ()
+  "Verify that `org-gcal--strip-html' converts HTML to plain text."
+  (should (equal (org-gcal--strip-html
+                  "<html-blob>Click the link:<br><a href=\"https://meet.jit.si/Weekly\">https://meet.jit.si/Weekly</a><br></html-blob>")
+                 "Click the link:\nhttps://meet.jit.si/Weekly"))
+  ;; List items
+  (should (equal (org-gcal--strip-html "<ul><li>First</li><li>Second</li></ul>")
+                 "- First\n- Second"))
+  ;; HTML entities
+  (should (equal (org-gcal--strip-html "foo &amp; bar &lt;baz&gt; &quot;quux&quot; &#39;x&#39; &nbsp;")
+                 "foo & bar <baz> \"quux\" 'x'"))
+  ;; Consecutive blank lines collapsed
+  (should (equal (org-gcal--strip-html "a<br><br><br><br>b")
+                 "a\n\nb"))
+  ;; Plain text passes through
+  (should (equal (org-gcal--strip-html "No HTML here")
+                 "No HTML here")))
+
+(ert-deftest org-gcal-test--strip-html-p ()
+  "Verify that `org-gcal--strip-html-p' respects global default and overrides."
+  ;; Global default nil
+  (let ((org-gcal-strip-html-descriptions nil)
+        (org-gcal-strip-html-descriptions-overrides nil))
+    (should-not (org-gcal--strip-html-p "cal@example.com")))
+  ;; Global default t
+  (let ((org-gcal-strip-html-descriptions t)
+        (org-gcal-strip-html-descriptions-overrides nil))
+    (should (org-gcal--strip-html-p "cal@example.com")))
+  ;; Per-calendar override enables stripping despite global nil
+  (let ((org-gcal-strip-html-descriptions nil)
+        (org-gcal-strip-html-descriptions-overrides
+         '(("cal@example.com" . t))))
+    (should (org-gcal--strip-html-p "cal@example.com"))
+    (should-not (org-gcal--strip-html-p "other@example.com")))
+  ;; Per-calendar override disables stripping despite global t
+  (let ((org-gcal-strip-html-descriptions t)
+        (org-gcal-strip-html-descriptions-overrides
+         '(("shared@group.calendar.google.com" . nil))))
+    (should-not (org-gcal--strip-html-p "shared@group.calendar.google.com"))
+    (should (org-gcal--strip-html-p "personal@gmail.com"))))
+
+(ert-deftest org-gcal-test--update-entry-strip-html ()
+  "Verify that `org-gcal--update-entry' strips HTML when enabled."
+  ;; With stripping enabled, HTML is converted to plain text.
+  (let ((org-gcal-strip-html-descriptions t)
+        (org-gcal-strip-html-descriptions-overrides nil))
+    (org-gcal-test--with-temp-buffer
+        "* "
+      (org-gcal--update-entry org-gcal-test-calendar-id
+                              org-gcal-test-html-event)
+      (org-back-to-heading)
+      (re-search-forward ":org-gcal:")
+      (let* ((elem (org-element-at-point))
+             (contents (buffer-substring-no-properties
+                        (org-element-property :contents-begin elem)
+                        (org-element-property :contents-end elem))))
+        ;; Should not contain HTML tags (use regex that won't match Org timestamps)
+        (should-not (string-match-p "</?[a-zA-Z][^>]*>" contents))
+        ;; Should contain converted text
+        (should (string-match-p "Click the link:" contents))
+        (should (string-match-p "https://meet.jit.si/Weekly" contents))
+        ;; Entity decoded
+        (should (string-match-p "& more info" contents))))))
+
+(ert-deftest org-gcal-test--update-entry-preserve-html ()
+  "Verify that `org-gcal--update-entry' preserves HTML when stripping disabled."
+  ;; With stripping disabled (default), HTML is preserved.
+  (let ((org-gcal-strip-html-descriptions nil)
+        (org-gcal-strip-html-descriptions-overrides nil))
+    (org-gcal-test--with-temp-buffer
+        "* "
+      (org-gcal--update-entry org-gcal-test-calendar-id
+                              org-gcal-test-html-event)
+      (org-back-to-heading)
+      (re-search-forward ":org-gcal:")
+      (let* ((elem (org-element-at-point))
+             (contents (buffer-substring-no-properties
+                        (org-element-property :contents-begin elem)
+                        (org-element-property :contents-end elem))))
+        ;; Should still contain HTML tags
+        (should (string-match-p "<html-blob>" contents))
+        (should (string-match-p "</a>" contents))
+        ;; Entity NOT decoded
+        (should (string-match-p "&amp;" contents))))))
+
+(ert-deftest org-gcal-test--update-entry-strip-html-per-calendar ()
+  "Verify per-calendar override for HTML stripping in `org-gcal--update-entry'."
+  ;; Global default is nil, but this specific calendar has stripping enabled.
+  (let ((org-gcal-strip-html-descriptions nil)
+        (org-gcal-strip-html-descriptions-overrides
+         `((,org-gcal-test-calendar-id . t))))
+    (org-gcal-test--with-temp-buffer
+        "* "
+      (org-gcal--update-entry org-gcal-test-calendar-id
+                              org-gcal-test-html-event)
+      (org-back-to-heading)
+      (re-search-forward ":org-gcal:")
+      (let* ((elem (org-element-at-point))
+             (contents (buffer-substring-no-properties
+                        (org-element-property :contents-begin elem)
+                        (org-element-property :contents-end elem))))
+        (should-not (string-match-p "</?[a-zA-Z][^>]*>" contents))
+        (should (string-match-p "& more info" contents))))))
+
 ;;; TODO: Figure out mocking for POST/PATCH followed by GET
 ;;; - ‘mock‘ might work for this - the argument list must be specified up
 ;;;   front, but the wildcard ‘*’ can be used to match any value. If that