From 9528d5233295a5b0fff9b95d993d889452632b48 Mon Sep 17 00:00:00 2001 From: Tobias Zawada Date: Thu, 1 Feb 2024 21:44:02 +0100 Subject: [PATCH] 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 1d7d4fd..312dff7 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