branch: elpa/adoc-mode
commit 0a189c5f2883ca0d4cab9c562aebaefd8aef0c45
Author: Tobias Zawada <[email protected]>
Commit: TobiasZawada <[email protected]>
Revert "#44 Avoid cl-loop in native fontification of source blocks"
This reverts commit 9e6f3d5008e9a3590791efabbdbc81b96da6a07b.
---
adoc-mode.el | 35 +++++++++++++++--------------------
1 file changed, 15 insertions(+), 20 deletions(-)
diff --git a/adoc-mode.el b/adoc-mode.el
index 1d7d4fd336..312dff736f 100644
--- a/adoc-mode.el
+++ b/adoc-mode.el
@@ -1991,18 +1991,12 @@ LANG is a string, and the returned major mode is a
symbol."
(intern (concat lang "-mode"))
(intern (concat (downcase lang) "-mode")))))
-(defun adoc-map-intervals (fun property &optional beg end object)
- "Apply FUN to all intervals of PROPERTY in OBJECT in the region from BEG to
END."
- (unless object (setq object (current-buffer)))
- (unless beg (setq beg (point-min)))
- (unless end (setq end (point-max)))
- (let (end-interval)
- (while
- (progn
- (setq end-interval (next-single-property-change beg property object
end))
- (funcall fun beg end-interval)
- (setq beg end-interval)
- (null (= end-interval end))))))
+(defmacro adoc-cond-let (cond binding &rest body)
+ "Let-bind BINDING when COND is fulfilled at compile-time.
+Execute BODY like `progn'."
+ (declare (debug (form (&rest (symbolp form)) body)) (indent 2))
+ `(let ,(when (eval cond) binding)
+ ,@body))
;; Based on `org-src-font-lock-fontify-block' from org-src.el.
(defun adoc-fontify-code-block-natively (lang start-block end-block start-src
end-src)
@@ -2031,14 +2025,15 @@ START-SRC and END-SRC delimit the actual source code."
(insert string))
(unless (eq major-mode lang-mode) (funcall lang-mode))
(font-lock-ensure)
- (adoc-map-intervals
- (lambda (pos next)
- (let ((val (get-text-property pos 'face)))
- (when val
- (put-text-property
- (+ start-src (1- pos)) (1- (+ start-src next)) 'face
- val adoc-buffer))))
- 'face))
+ (adoc-cond-let (version< emacs-version "30.0") (int)
+ (cl-loop for int being the intervals property 'face
+ for pos = (car int)
+ for next = (cdr int)
+ for val = (get-text-property pos 'face)
+ when val do
+ (put-text-property
+ (+ start-src (1- pos)) (1- (+ start-src next)) 'face
+ val adoc-buffer))))
(add-text-properties start-block start-src '(face adoc-meta-face))
(add-text-properties end-src end-block '(face adoc-meta-face))
(add-text-properties
