From b4dc8abc8b27538a49e5800ffb3bdafdb58775e1 Mon Sep 17 00:00:00 2001 From: Kinneyzhang Date: Mon, 27 Jul 2026 02:27:53 +0800 Subject: [PATCH] Add ABSOLUTE coordinates to tp-intervals and tp-intervals-map API-COORD-01: both functions take a new trailing optional ABSOLUTE argument. When non-nil, buffer results use native 1-based buffer positions - directly reusable in tp-set/tp-remove calls - instead of the legacy START-relative 0-based offsets, which stay the default this cycle (the default flip is deferred to 0.4). String results were always absolute and are unchanged. DOC-STR-02: tp-intervals-map's one-line docstring is rewritten to its real contract: the tp-layers layer-stack split handed to FUNCTION (TOP-PROPS vs BELOW-PROPS-LST), the coordinate system including ABSOLUTE, and the return value (FUNCTION's non-nil results in interval order). Co-Authored-By: Claude Fable 5 --- tp-core-tests.el | 65 ++++++++++++++++++++++++++++++++++++++++++++++++ tp-core.el | 50 +++++++++++++++++++++++++++++-------- 2 files changed, 104 insertions(+), 11 deletions(-) diff --git a/tp-core-tests.el b/tp-core-tests.el index 7a1fc5b..9f5e49b 100644 --- a/tp-core-tests.el +++ b/tp-core-tests.el @@ -68,5 +68,70 @@ "The face-family property list contains the three face properties." (should (equal tp-face-properties '(face font-lock-face mouse-face)))) +;;; API-COORD-01: ABSOLUTE coordinates in tp-intervals / tp-intervals-map + +(ert-deftest tp-core-test-intervals-buffer-relative-default () + "Without ABSOLUTE, buffer intervals stay START-relative (legacy)." + (with-temp-buffer + (insert "hello world") + (put-text-property 4 8 'face 'bold) + (should (equal (tp-intervals 3 9) + '((0 1 nil) (1 5 (face bold)) (5 6 nil)))))) + +(ert-deftest tp-core-test-intervals-buffer-absolute () + "With ABSOLUTE, buffer intervals use native 1-based positions." + (with-temp-buffer + (insert "hello world") + (put-text-property 4 8 'face 'bold) + (should (equal (tp-intervals 3 9 nil t) + '((3 4 nil) (4 8 (face bold)) (8 9 nil)))) + ;; Clipping still applies in native coordinates. + (should (equal (tp-intervals 5 7 nil t) + '((5 7 (face bold))))))) + +(ert-deftest tp-core-test-intervals-string-ignores-absolute () + "String intervals are already absolute; ABSOLUTE changes nothing." + (let ((s (copy-sequence "hello world"))) + (put-text-property 3 7 'face 'bold s) + (should (equal (tp-intervals 2 9 s) (tp-intervals 2 9 s t))) + (should (equal (tp-intervals 2 9 s t) + '((2 3 nil) (3 7 (face bold)) (7 9 nil)))))) + +(ert-deftest tp-core-test-intervals-map-absolute () + "tp-intervals-map passes ABSOLUTE through to native positions." + (with-temp-buffer + (insert "hello world") + (put-text-property 4 8 'face 'bold) + (should (equal (tp-intervals-map #'list 3 9) + '((0 1 nil nil) (1 5 (face bold) nil) (5 6 nil nil)))) + (should (equal (tp-intervals-map #'list 3 9 nil t) + '((3 4 nil nil) (4 8 (face bold) nil) (8 9 nil nil)))))) + +(ert-deftest tp-core-test-intervals-map-splits-layer-stack () + "tp-intervals-map hands the tp-layers stack to FUNCTION separately." + (with-temp-buffer + (insert "hello") + (set-text-properties + 1 6 '(face bold tp-layers ((face italic tp-name below)))) + (let ((res (tp-intervals-map #'list 1 6 nil t))) + (should (= (length res) 1)) + (pcase-let ((`(,beg ,end ,top ,below) (car res))) + (should (= beg 1)) + (should (= end 6)) + (should (eq (plist-get top 'face) 'bold)) + (should-not (plist-member top 'tp-layers)) + (should (equal below '((face italic tp-name below)))))))) + +(ert-deftest tp-core-test-intervals-map-drops-nil-results () + "nil results from FUNCTION are removed from the returned list." + (with-temp-buffer + (insert "hello world") + (put-text-property 4 8 'face 'bold) + (should (equal (tp-intervals-map + (lambda (beg end top _below) + (when (plist-get top 'face) (cons beg end))) + 1 12 nil t) + '((4 . 8)))))) + (provide 'tp-core-tests) ;;; tp-core-tests.el ends here diff --git a/tp-core.el b/tp-core.el index 70d5d61..2dd3a74 100644 --- a/tp-core.el +++ b/tp-core.el @@ -114,19 +114,28 @@ FORMAT-STRING and ARGS are passed to `format'." (let ((inhibit-read-only t)) ,@body))) -(defun tp-intervals (start end &optional object) +(defun tp-intervals (start end &optional object absolute) "Return list of property intervals from START to END in OBJECT. -Each element is (START END PROPERTIES). OBJECT defaults to current buffer. -For buffers, returns positions relative to START (0-based offsets). -For strings, returns absolute positions. +Each element is (START END PROPERTIES). OBJECT defaults to current +buffer. +For buffers, positions are by default relative to START (0-based +offsets, the legacy convention). When ABSOLUTE is non-nil they are +native 1-based buffer positions instead, directly reusable in other +tp calls (`tp-set', `tp-remove', ...) without offset arithmetic. +For strings, positions are always absolute (0-based); ABSOLUTE +changes nothing. Intervals that extend beyond the requested range are clipped to it, so returned positions never fall outside [START, END)." (let* ((intervals (object-intervals (or object (current-buffer)))) ;; For buffers, object-intervals returns 0-based positions - ;; but buffer positions are 1-based, so we need to adjust - (offset (if (stringp object) 0 (1- start))) + ;; but buffer positions are 1-based, so we need to adjust: + ;; subtracting (1- start) makes them START-relative, while + ;; subtracting -1 restores native 1-based positions. + (offset (cond ((stringp object) 0) + (absolute -1) + (t (1- start)))) ;; Filter bounds in 0-based terms for buffers - (filter-start (if (stringp object) start offset)) + (filter-start (if (stringp object) start (1- start))) (filter-end (if (stringp object) end (1- end)))) (mapcar (lambda (tp) (let* ((tp-start (- (max (nth 0 tp) filter-start) offset)) @@ -754,9 +763,28 @@ order." (setq pos next))) (nreverse results)))))) -(defun tp-intervals-map (function start end &optional object) - "Apply FUNCTION to all intervals between START and END in OBJECT. -FUNCTION receives (i-start i-end top-props below-props-lst)." +(defun tp-intervals-map (function start end &optional object absolute) + "Apply FUNCTION to each property interval of [START, END) in OBJECT. + +FUNCTION is called with (I-START I-END TOP-PROPS BELOW-PROPS-LST) for +every interval `tp-intervals' reports, splitting the layer-stack +bookkeeping out of the raw properties: +- TOP-PROPS is the interval's property plist with the `tp-layers' + entry removed: the directly rendered properties. +- BELOW-PROPS-LST is the value of the interval's `tp-layers' + property: the list of stored layer plists (normally the layers + buried below the rendered top layer; while any layer is hidden it + holds the whole ordered stack - see `tp-layer-stack-at' for the + decoded view). It is nil when the interval carries no layer stack. + +I-START/I-END follow `tp-intervals' coordinates: for buffers they +are by default relative to START (0-based offsets, the legacy +convention), or native 1-based buffer positions when ABSOLUTE is +non-nil; for strings they are always absolute 0-based positions. +OBJECT is a string, a buffer, or nil for the current buffer. + +Returns the list of FUNCTION's non-nil results, in interval order +\(nil results are dropped)." (remove nil (mapcar @@ -772,7 +800,7 @@ FUNCTION receives (i-start i-end top-props below-props-lst)." (funcall function interval-start interval-end top-props below-props-lst))) - (tp-intervals start end object)))) + (tp-intervals start end object absolute)))) (provide 'tp-core) ;;; tp-core.el ends here