From b6f3f87925bd308a39ddae1fa7c73dd75c6dccb8 Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Wed, 17 Dec 2025 16:08:10 +0000 Subject: [PATCH] Separate tp-define-layer and tp-define-layer-group macros Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com> --- README.md | 116 +++++++++++++++++++++++++------ README_CN.md | 116 +++++++++++++++++++++++++------ tp-tests.el | 94 +++++++++++++++++++++++--- tp.el | 188 +++++++++++++++++++++++++++++++++++---------------- 4 files changed, 403 insertions(+), 111 deletions(-) diff --git a/README.md b/README.md index 401ba99..d392039 100644 --- a/README.md +++ b/README.md @@ -206,7 +206,8 @@ A complete overview of all tp.el functions organized by category: #### Property Layer Definition Functions | Function | Description | |----------|-------------| -| [`tp-define-layer`](#tp-define-layer---define-layers) | Define a layer or layer group | +| [`tp-define-layer`](#tp-define-layer---define-single-layer) | Define a single layer | +| [`tp-define-layer-group`](#tp-define-layer-group---define-layer-group) | Define a group of layers | | [`tp-layer-props`](#tp-layer-props--tp-group-props) | Get properties for a layer | | [`tp-group-props`](#tp-layer-props--tp-group-props) | Get properties for all layers in a group | | [`tp-undefine-layer`](#tp-undefine-layer--tp-undefine-group) | Remove layer definition | @@ -1078,32 +1079,30 @@ The **property layer system** is tp.el's innovative feature that allows stacking ### Property Layer Definition -#### `tp-define-layer` - Define Layer(s) +#### `tp-define-layer` - Define Single Layer -Define a single layer or a group of multiple layers. +Define a single text property layer. Supports two formats: -**Single Layer:** +**Format 1 - Direct plist:** ```elisp (tp-define-layer layer-name (face (:background "cyan") line-prefix ">>")) ``` -**Multiple Layers (Layer Group):** +**Format 2 - With :props keyword (for future extensibility):** ```elisp -(tp-define-layer my-group - layer-1 ; Reference existing layer - (face (:background "red") line-prefix ">>") ; Anonymous layer - (face (:background "green" :weight bold))) ; Another anonymous layer +(tp-define-layer layer-name + :props (face (:background "cyan") line-prefix ">>")) ``` -The first layer in the definition is the top layer (visible by default). +If a layer with the same name already exists, it will be overwritten with the new definition. **Examples:** ```elisp -;; Define individual layers +;; Define individual layers using Format 1 (direct plist) (progn (setq tp-layer-alist nil) ; Reset for clean example (tp-define-layer highlight @@ -1111,27 +1110,102 @@ The first layer in the definition is the top layer (visible by default). (tp-layer-props 'highlight)) ;; => (face (:background "yellow" :foreground "black") tp-name highlight) +;; Define a layer using Format 2 (:props keyword) (progn (tp-define-layer error - (face (:background "red" :foreground "white") - help-echo "Error!")) + :props (face (:background "red" :foreground "white") + help-echo "Error!")) (tp-layer-props 'error)) ;; => (face (:background "red" :foreground "white") help-echo "Error!" tp-name error) +;; Redefine an existing layer (overwrites the old definition) (progn + (tp-define-layer test-layer (face bold)) + (tp-define-layer test-layer (face italic)) ; Overwrites + (tp-layer-props 'test-layer)) +;; => (face italic tp-name test-layer) +``` + +--- + +#### `tp-define-layer-group` - Define Layer Group + +Define a group of multiple layers. Supports three formats for each element: + +**Format 1 - Anonymous layers (named as GROUP-NAME-0, GROUP-NAME-1, etc.):** + +```elisp +(tp-define-layer-group tp-test-moons + (display "🌑" face (:height 1.0)) + (display "🌘" face (:height 1.5)) + (display "🌗" face (:height 2.0))) +;; Creates layers: tp-test-moons-0, tp-test-moons-1, tp-test-moons-2 +``` + +**Format 2 - Named layers with cons-cell (named as GROUP-NAME-suffix):** + +```elisp +(tp-define-layer-group tp-test-moons + ("新月" . (display "🌑" face (:height 1.0))) + ("残月" . (display "🌘" face (:height 1.5))) + ("下弦月" . (display "🌗" face (:height 2.0)))) +;; Creates layers: tp-test-moons-新月, tp-test-moons-残月, tp-test-moons-下弦月 +``` + +**Format 3 - Named layers with :props keyword (named as GROUP-NAME-suffix):** + +```elisp +(tp-define-layer-group tp-test-moons + ("新月" :props (display "🌑" face (:height 1.0))) + ("残月" :props (display "🌘" face (:height 1.5))) + ("下弦月" :props (display "🌗" face (:height 2.0)))) +;; Creates layers: tp-test-moons-新月, tp-test-moons-残月, tp-test-moons-下弦月 +``` + +You can also reference already-defined layers in a group: + +```elisp +(tp-define-layer existing-layer (face bold)) +(tp-define-layer-group my-group + existing-layer ; Reference existing layer + (face (:background "red") line-prefix ">>") ; Anonymous layer + ("named" . (face italic))) ; Named layer +``` + +If a layer group with the same name already exists, it will be overwritten. +The first layer in the definition is the top layer (visible by default). + +**Examples:** + +```elisp +;; Define status layers, then group them +(progn + (setq tp-layer-alist nil) + (setq tp-layer-groups nil) + (tp-define-layer highlight + (face (:background "yellow" :foreground "black"))) + (tp-define-layer error + (face (:background "red" :foreground "white"))) (tp-define-layer info (face (:background "blue" :foreground "white"))) - (tp-layer-props 'info)) -;; => (face (:background "blue" :foreground "white") tp-name info) - -;; Define a layer group -(progn - (tp-define-layer status-colors + (tp-define-layer-group status-colors highlight error info) (length (tp-group-props 'status-colors))) ;; => 3 + +;; Define a layer group with named layers +(progn + (setq tp-layer-alist nil) + (setq tp-layer-groups nil) + (tp-define-layer-group moon-phases + ("new" . (display "🌑")) + ("waxing-crescent" . (display "🌒")) + ("first-quarter" . (display "🌓")) + ("full" . (display "🌕"))) + (tp-layer-props 'moon-phases-full)) +;; => (display "🌕" tp-name moon-phases-full) ``` --- @@ -1161,7 +1235,7 @@ Get properties for a layer or all layers in a group. (setq tp-layer-groups nil) (tp-define-layer layer1 (face bold)) (tp-define-layer layer2 (face italic)) - (tp-define-layer my-group layer1 layer2) + (tp-define-layer-group my-group layer1 layer2) (length (tp-group-props 'my-group))) ;; => 2 ``` @@ -1988,7 +2062,7 @@ Return t if OBJECT has no text properties. (tp-define-layer status-todo (face (:foreground "gray"))) (tp-define-layer status-progress (face (:foreground "yellow"))) (tp-define-layer status-done (face (:foreground "green"))) - (tp-define-layer task-status status-todo status-progress status-done) + (tp-define-layer-group task-status status-todo status-progress status-done) ;; Check group is defined (length (tp-group-props 'task-status))) ;; => 3 diff --git a/README_CN.md b/README_CN.md index fc44c03..5f850d1 100644 --- a/README_CN.md +++ b/README_CN.md @@ -205,7 +205,8 @@ tp.el 所有函数按类别组织的完整概览: #### 属性层定义函数 | 函数 | 描述 | |------|------| -| [`tp-define-layer`](#tp-define-layer---定义属性层) | 定义属性层或属性层组 | +| [`tp-define-layer`](#tp-define-layer---定义单个属性层) | 定义单个属性层 | +| [`tp-define-layer-group`](#tp-define-layer-group---定义属性层组) | 定义属性层组 | | [`tp-layer-props`](#tp-layer-props--tp-group-props) | 获取属性层的属性 | | [`tp-group-props`](#tp-layer-props--tp-group-props) | 获取属性层组中所有属性层的属性 | | [`tp-undefine-layer`](#tp-undefine-layer--tp-undefine-group) | 移除属性层定义 | @@ -1075,32 +1076,30 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的 ### 属性层定义 -#### `tp-define-layer` - 定义属性层 +#### `tp-define-layer` - 定义单个属性层 -定义单个属性层或多个属性层组。 +定义单个文本属性层。支持两种格式: -**单个属性层:** +**格式一 - 直接定义文本属性:** ```elisp (tp-define-layer layer-name (face (:background "cyan") line-prefix ">>")) ``` -**多个属性层(属性层组):** +**格式二 - 使用 :props 关键字(为后续扩展预留):** ```elisp -(tp-define-layer my-group - layer-1 ; 引用已存在的属性层 - (face (:background "red") line-prefix ">>") ; 匿名属性层 - (face (:background "green" :weight bold))) ; 另一个匿名属性层 +(tp-define-layer layer-name + :props (face (:background "cyan") line-prefix ">>")) ``` -定义中的第一个属性层是顶层(默认可见)。 +如果同名的层已存在,新定义将覆盖旧定义。 **示例:** ```elisp -;; 定义单个属性层 +;; 使用格式一(直接 plist)定义单个属性层 (progn (setq tp-layer-alist nil) ; 重置以确保干净的示例 (tp-define-layer highlight @@ -1108,27 +1107,102 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的 (tp-layer-props 'highlight)) ;; => (face (:background "yellow" :foreground "black") tp-name highlight) +;; 使用格式二(:props 关键字)定义属性层 (progn (tp-define-layer error - (face (:background "red" :foreground "white") - help-echo "错误!")) + :props (face (:background "red" :foreground "white") + help-echo "错误!")) (tp-layer-props 'error)) ;; => (face (:background "red" :foreground "white") help-echo "错误!" tp-name error) +;; 重新定义已存在的属性层(覆盖旧定义) (progn + (tp-define-layer test-layer (face bold)) + (tp-define-layer test-layer (face italic)) ; 覆盖 + (tp-layer-props 'test-layer)) +;; => (face italic tp-name test-layer) +``` + +--- + +#### `tp-define-layer-group` - 定义属性层组 + +定义包含多个属性层的层组。每个元素支持三种格式: + +**格式一 - 匿名层(命名为 GROUP-NAME-0, GROUP-NAME-1 等):** + +```elisp +(tp-define-layer-group tp-test-moons + (display "🌑" face (:height 1.0)) + (display "🌘" face (:height 1.5)) + (display "🌗" face (:height 2.0))) +;; 创建层: tp-test-moons-0, tp-test-moons-1, tp-test-moons-2 +``` + +**格式二 - 使用 cons-cell 命名层(命名为 GROUP-NAME-suffix):** + +```elisp +(tp-define-layer-group tp-test-moons + ("新月" . (display "🌑" face (:height 1.0))) + ("残月" . (display "🌘" face (:height 1.5))) + ("下弦月" . (display "🌗" face (:height 2.0)))) +;; 创建层: tp-test-moons-新月, tp-test-moons-残月, tp-test-moons-下弦月 +``` + +**格式三 - 使用 :props 关键字命名层(命名为 GROUP-NAME-suffix):** + +```elisp +(tp-define-layer-group tp-test-moons + ("新月" :props (display "🌑" face (:height 1.0))) + ("残月" :props (display "🌘" face (:height 1.5))) + ("下弦月" :props (display "🌗" face (:height 2.0)))) +;; 创建层: tp-test-moons-新月, tp-test-moons-残月, tp-test-moons-下弦月 +``` + +你也可以在层组中引用已定义的层: + +```elisp +(tp-define-layer existing-layer (face bold)) +(tp-define-layer-group my-group + existing-layer ; 引用已存在的属性层 + (face (:background "red") line-prefix ">>") ; 匿名属性层 + ("named" . (face italic))) ; 命名属性层 +``` + +如果同名的层组已存在,新定义将覆盖旧定义。 +定义中的第一个属性层是顶层(默认可见)。 + +**示例:** + +```elisp +;; 先定义状态层,然后将它们组合成层组 +(progn + (setq tp-layer-alist nil) + (setq tp-layer-groups nil) + (tp-define-layer highlight + (face (:background "yellow" :foreground "black"))) + (tp-define-layer error + (face (:background "red" :foreground "white"))) (tp-define-layer info (face (:background "blue" :foreground "white"))) - (tp-layer-props 'info)) -;; => (face (:background "blue" :foreground "white") tp-name info) - -;; 定义属性层组 -(progn - (tp-define-layer status-colors + (tp-define-layer-group status-colors highlight error info) (length (tp-group-props 'status-colors))) ;; => 3 + +;; 使用命名层定义层组 +(progn + (setq tp-layer-alist nil) + (setq tp-layer-groups nil) + (tp-define-layer-group moon-phases + ("new" . (display "🌑")) + ("waxing-crescent" . (display "🌒")) + ("first-quarter" . (display "🌓")) + ("full" . (display "🌕"))) + (tp-layer-props 'moon-phases-full)) +;; => (display "🌕" tp-name moon-phases-full) ``` --- @@ -1158,7 +1232,7 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的 (setq tp-layer-groups nil) (tp-define-layer layer1 (face bold)) (tp-define-layer layer2 (face italic)) - (tp-define-layer my-group layer1 layer2) + (tp-define-layer-group my-group layer1 layer2) (length (tp-group-props 'my-group))) ;; => 2 ``` @@ -1985,7 +2059,7 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的 (tp-define-layer status-todo (face (:foreground "gray"))) (tp-define-layer status-progress (face (:foreground "yellow"))) (tp-define-layer status-done (face (:foreground "green"))) - (tp-define-layer task-status status-todo status-progress status-done) + (tp-define-layer-group task-status status-todo status-progress status-done) ;; 检查组是否已定义 (length (tp-group-props 'task-status))) ;; => 3 diff --git a/tp-tests.el b/tp-tests.el index df0abb9..87d7b77 100644 --- a/tp-tests.el +++ b/tp-tests.el @@ -220,13 +220,21 @@ ;;; ============================================================ (ert-deftest tp-test-define-layer () - "Test tp-define-layer creates a layer." + "Test tp-define-layer creates a layer (Format 1 - direct plist)." (tp-test-with-temp-buffer (tp-define-layer test-layer (face bold help-echo "test")) (should (assoc 'test-layer tp-layer-alist)) (should (equal (cdr (assoc 'test-layer tp-layer-alist)) '(face bold help-echo "test"))))) +(ert-deftest tp-test-define-layer-with-props () + "Test tp-define-layer with :props keyword (Format 2)." + (tp-test-with-temp-buffer + (tp-define-layer test-layer :props (face italic help-echo "props")) + (should (assoc 'test-layer tp-layer-alist)) + (should (equal (cdr (assoc 'test-layer tp-layer-alist)) + '(face italic help-echo "props"))))) + (ert-deftest tp-test-define-layer-updates-existing () "Test tp-define-layer updates existing layer." (tp-test-with-temp-buffer @@ -235,6 +243,14 @@ (should (equal (cdr (assoc 'test-layer tp-layer-alist)) '(face italic))))) +(ert-deftest tp-test-define-layer-updates-existing-with-props () + "Test tp-define-layer with :props updates existing layer." + (tp-test-with-temp-buffer + (tp-define-layer test-layer (face bold)) + (tp-define-layer test-layer :props (face underline)) + (should (equal (cdr (assoc 'test-layer tp-layer-alist)) + '(face underline))))) + (ert-deftest tp-test-layer-props () "Test tp-layer-props returns properties with tp-name." (tp-test-with-temp-buffer @@ -257,14 +273,14 @@ (should-not (assoc 'test-layer tp-layer-alist)))) ;;; ============================================================ -;;; Layer Group Tests (using tp-define-layer with multiple layers) +;;; Layer Group Tests (using tp-define-layer-group) ;;; ============================================================ -(ert-deftest tp-test-define-layer-multiple () - "Test tp-define-layer creates a layer group with multiple layers." +(ert-deftest tp-test-define-layer-group-anonymous () + "Test tp-define-layer-group creates a layer group with anonymous layers." (tp-test-with-temp-buffer (tp-define-layer layer1 (face bold)) - (tp-define-layer my-group + (tp-define-layer-group my-group layer1 (face italic) (face underline)) @@ -272,14 +288,64 @@ ;; Check all layers are present in the group (let ((layers (cdr (assoc 'my-group tp-layer-groups)))) (should (= (length layers) 3)) - (should (memq 'layer1 layers))))) + (should (memq 'layer1 layers)) + ;; Anonymous layers should be named my-group-0 and my-group-1 + (should (memq 'my-group-0 layers)) + (should (memq 'my-group-1 layers))))) + +(ert-deftest tp-test-define-layer-group-named-cons () + "Test tp-define-layer-group with named cons-cell format." + (tp-test-with-temp-buffer + (tp-define-layer-group my-group + ("first" . (face bold)) + ("second" . (face italic))) + (should (assoc 'my-group tp-layer-groups)) + (let ((layers (cdr (assoc 'my-group tp-layer-groups)))) + (should (= (length layers) 2)) + (should (memq 'my-group-first layers)) + (should (memq 'my-group-second layers))) + ;; Check that layers are properly defined + (should (equal (cdr (assoc 'my-group-first tp-layer-alist)) '(face bold))) + (should (equal (cdr (assoc 'my-group-second tp-layer-alist)) '(face italic))))) + +(ert-deftest tp-test-define-layer-group-named-props () + "Test tp-define-layer-group with :props format." + (tp-test-with-temp-buffer + (tp-define-layer-group my-group + ("first" :props (face bold)) + ("second" :props (face italic))) + (should (assoc 'my-group tp-layer-groups)) + (let ((layers (cdr (assoc 'my-group tp-layer-groups)))) + (should (= (length layers) 2)) + (should (memq 'my-group-first layers)) + (should (memq 'my-group-second layers))) + ;; Check that layers are properly defined + (should (equal (cdr (assoc 'my-group-first tp-layer-alist)) '(face bold))) + (should (equal (cdr (assoc 'my-group-second tp-layer-alist)) '(face italic))))) + +(ert-deftest tp-test-define-layer-group-mixed () + "Test tp-define-layer-group with mixed formats." + (tp-test-with-temp-buffer + (tp-define-layer existing-layer (face underline)) + (tp-define-layer-group my-group + existing-layer + (face bold) + ("named" . (face italic)) + ("with-props" :props (face strike-through))) + (should (assoc 'my-group tp-layer-groups)) + (let ((layers (cdr (assoc 'my-group tp-layer-groups)))) + (should (= (length layers) 4)) + (should (memq 'existing-layer layers)) + (should (memq 'my-group-0 layers)) + (should (memq 'my-group-named layers)) + (should (memq 'my-group-with-props layers))))) (ert-deftest tp-test-group-props () "Test tp-group-props returns all layer properties." (tp-test-with-temp-buffer (tp-define-layer layer1 (face bold)) (tp-define-layer layer2 (face italic)) - (tp-define-layer my-group layer1 layer2) + (tp-define-layer-group my-group layer1 layer2) (let ((props-list (tp-group-props 'my-group))) (should (= (length props-list) 2)) ;; Check that both layers are present @@ -291,17 +357,27 @@ "Test tp-undefine-group removes group definition." (tp-test-with-temp-buffer (tp-define-layer layer1 (face bold)) - (tp-define-layer my-group layer1) + (tp-define-layer-group my-group layer1) (should (assoc 'my-group tp-layer-groups)) (tp-undefine-group 'my-group) (should-not (assoc 'my-group tp-layer-groups)))) +(ert-deftest tp-test-layer-group-updates-existing () + "Test tp-define-layer-group updates existing group." + (tp-test-with-temp-buffer + (tp-define-layer layer1 (face bold)) + (tp-define-layer layer2 (face italic)) + (tp-define-layer-group my-group layer1) + (should (= (length (cdr (assoc 'my-group tp-layer-groups))) 1)) + (tp-define-layer-group my-group layer1 layer2) + (should (= (length (cdr (assoc 'my-group tp-layer-groups))) 2)))) + (ert-deftest tp-test-layer-reset () "Test tp-layer-reset clears all definitions." (tp-test-with-temp-buffer (tp-define-layer layer1 (face bold)) (tp-define-layer layer2 (face italic)) - (tp-define-layer group1 layer1 layer2) + (tp-define-layer-group group1 layer1 layer2) (should tp-layer-alist) (should tp-layer-groups) (tp-layer-reset) diff --git a/tp.el b/tp.el index e93b772..06f841c 100644 --- a/tp.el +++ b/tp.el @@ -1511,71 +1511,139 @@ Returns a plist of all properties in the region or string." ;;; Layer Definition Functions -(defmacro tp-define-layer (name &rest layers) - "Define a text property layer or layer group named NAME. +(defmacro tp-define-layer (name &rest args) + "Define a single text property layer named NAME. -Single layer: - (tp-define-layer layer-1 \\='(face (:background \"cyan\") line-prefix \">>\")) +This macro supports two formats: -Multiple layers (first defined layer is the top layer): - (tp-define-layer layers-2 - \\='layer-1 - \\='(face (:background \"red\") line-prefix \">>\") - \\='(face (:background \"green\" :weight bold) line-prefix \"::\")) +Format 1 - Direct plist: + (tp-define-layer layer-name + (display \"🌑\" face (:height 1.0))) -LAYERS can be: -- A single plist for a single layer definition -- Multiple items where each can be: - - A symbol referencing another defined layer - - A plist defining an anonymous sub-layer +Format 2 - With :props keyword (for future extensibility): + (tp-define-layer layer-name + :props (display \"🌑\" face (:height 1.0))) -For multiple layers, they are stored as a group in `tp-layer-groups'. -The first layer in the definition is the top layer." +If a layer with the same NAME already exists, it will be overwritten +with the new definition. + +The layer is stored in `tp-layer-alist'." (declare (indent defun)) - ;; Determine if this is a single layer (one plist argument) or multiple layers - (let ((first-layer (car layers))) - (let ((is-single-layer - (and (= (length layers) 1) - first-layer - (listp first-layer) - ;; A plist has an even number of elements (key-value pairs) - (cl-evenp (length first-layer)) - ;; The first element is a property name (symbol, not nil) - (symbolp (car first-layer))))) - (if is-single-layer - ;; Single layer: (tp-define-layer name '(plist...)) - (let ((properties first-layer)) - `(progn - (if (assoc ',name tp-layer-alist) - (setf (cdr (assoc ',name tp-layer-alist)) ',properties) - (push (cons ',name ',properties) tp-layer-alist)) - (assoc ',name tp-layer-alist))) - ;; Multiple layers: (tp-define-layer name 'layer1 '(plist1) '(plist2) ...) - (let ((layer-names nil) - (idx 0) - (layer-defs nil)) - (dolist (layer layers) - (cond - ;; Reference to existing layer - ((symbolp layer) - (push layer layer-names)) - ;; Plist layer - create with auto-generated name - ((listp layer) - (let ((sub-name (intern (format "%s-layer-%d" name idx)))) - (push `(if (assoc ',sub-name tp-layer-alist) - (setf (cdr (assoc ',sub-name tp-layer-alist)) ',layer) - (push (cons ',sub-name ',layer) tp-layer-alist)) - layer-defs) - (push sub-name layer-names) - (cl-incf idx))))) - (setq layer-names (nreverse layer-names)) - (setq layer-defs (nreverse layer-defs)) - `(progn - ,@layer-defs - (if (assoc ',name tp-layer-groups) - (setf (cdr (assoc ',name tp-layer-groups)) ',layer-names) - (push (cons ',name ',layer-names) tp-layer-groups)) - (assoc ',name tp-layer-groups))))))) + (let ((properties + (cond + ;; Format 2: :props (plist) + ((and (eq (car args) :props) + (cadr args)) + (cadr args)) + ;; Format 1: (plist) + ((and (= (length args) 1) + (listp (car args))) + (car args)) + (t (error "Invalid tp-define-layer format for %s" name))))) + `(progn + (if (assoc ',name tp-layer-alist) + (setf (cdr (assoc ',name tp-layer-alist)) ',properties) + (push (cons ',name ',properties) tp-layer-alist)) + (assoc ',name tp-layer-alist)))) + +(defun tp--parse-layer-group-element (group-name element idx) + "Parse a layer group element and return (layer-name . properties). +GROUP-NAME is the name of the layer group. +ELEMENT is the element to parse (can be anonymous plist, cons-cell, or :props form). +IDX is the index for anonymous elements. + +Returns a cons cell (LAYER-NAME . PROPERTIES) or a symbol if ELEMENT +references an already-defined layer." + (cond + ;; Case: already defined layer (symbol) + ((symbolp element) + element) + ;; Case: Format 3 - ("name" :props (plist...)) + ((and (listp element) + (stringp (car element)) + (eq (cadr element) :props) + (caddr element)) + (let* ((layer-suffix (car element)) + (layer-name (intern (format "%s-%s" group-name layer-suffix))) + (props (caddr element))) + (cons layer-name props))) + ;; Case: Format 2 - ("name" . (plist...)) - cons cell + ((and (consp element) + (stringp (car element)) + (listp (cdr element))) + (let* ((layer-suffix (car element)) + (layer-name (intern (format "%s-%s" group-name layer-suffix))) + (props (cdr element))) + (cons layer-name props))) + ;; Case: Format 1 - (plist...) - anonymous, use index + ((and (listp element) + (not (stringp (car element)))) + (let ((layer-name (intern (format "%s-%d" group-name idx)))) + (cons layer-name element))) + (t (error "Invalid layer group element: %S" element)))) + +(defmacro tp-define-layer-group (name &rest elements) + "Define a layer group named NAME containing multiple layers. + +This macro supports three formats for each element: + +Format 1 - Anonymous layers (named as NAME-0, NAME-1, etc.): + (tp-define-layer-group group-name + (display \"🌑\" face (:height 1.0)) + (display \"🌘\" face (:height 1.5)) + (display \"🌗\" face (:height 2.0))) + +Format 2 - Named layers with cons-cell (named as NAME-suffix): + (tp-define-layer-group group-name + (\"新月\" . (display \"🌑\" face (:height 1.0))) + (\"残月\" . (display \"🌘\" face (:height 1.5))) + (\"下弦月\" . (display \"🌗\" face (:height 2.0)))) + +Format 3 - Named layers with :props keyword (named as NAME-suffix): + (tp-define-layer-group group-name + (\"新月\" :props (display \"🌑\" face (:height 1.0))) + (\"残月\" :props (display \"🌘\" face (:height 1.5))) + (\"下弦月\" :props (display \"🌗\" face (:height 2.0)))) + +You can also reference already-defined layers by their symbol name: + (tp-define-layer-group group-name + existing-layer-1 + existing-layer-2 + (display \"🌗\" face (:height 2.0))) + +If a layer group with the same NAME already exists, it will be overwritten. +Individual layers created by the group are stored in `tp-layer-alist', +and the group itself is stored in `tp-layer-groups'." + (declare (indent defun)) + (let ((layer-names nil) + (layer-defs nil) + (idx 0)) + (dolist (element elements) + (let ((parsed (tp--parse-layer-group-element name element idx))) + (cond + ;; Reference to existing layer (symbol) + ((symbolp parsed) + (push parsed layer-names)) + ;; New layer definition (cons cell of name . props) + ((consp parsed) + (let ((layer-name (car parsed)) + (props (cdr parsed))) + (push `(if (assoc ',layer-name tp-layer-alist) + (setf (cdr (assoc ',layer-name tp-layer-alist)) ',props) + (push (cons ',layer-name ',props) tp-layer-alist)) + layer-defs) + (push layer-name layer-names) + ;; Only increment idx for anonymous (Format 1) elements + (unless (and (listp element) (stringp (car element))) + (cl-incf idx))))))) + (setq layer-names (nreverse layer-names)) + (setq layer-defs (nreverse layer-defs)) + `(progn + ,@layer-defs + (if (assoc ',name tp-layer-groups) + (setf (cdr (assoc ',name tp-layer-groups)) ',layer-names) + (push (cons ',name ',layer-names) tp-layer-groups)) + (assoc ',name tp-layer-groups)))) (defun tp-layer-props (layer-name) "Return properties for layer LAYER-NAME from `tp-layer-alist'.