branch: externals/hyperbole
commit 23fee3ba1a4ed6454064a0ec26330fa0fb792a4d
Author: Mats Lidell <mats.lid...@lidells.se>
Commit: Mats Lidell <mats.lid...@lidells.se>
Add support for org face types to support org 9.7 and older
---
ChangeLog | 7 ++++++
hsys-org.el | 60 ++++++++++++++++++++++++++++++++------------------
test/hsys-org-tests.el | 4 ++--
3 files changed, 47 insertions(+), 24 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index c8f6c08d40..13ddf3d370 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2024-06-23 Mats Lidell <ma...@gnu.org>
+
+* hsys-org.el (hsys-org-first-face-type-pos)
+ (hsys-org-last-face-type-pos, hsys-org-region-with-face-type)
+ (hsys-org-is-face-type): Add support for working with org face types
+ to be compatible with org mode 9.7 and older versions.
+
2024-06-23 Bob Weiner <r...@gnu.org>
* Makefile: (dockerized-run): Add to intweractively run dockerized versions
diff --git a/hsys-org.el b/hsys-org.el
index 11dbde4471..18983bcaf3 100644
--- a/hsys-org.el
+++ b/hsys-org.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 2-Jul-16 at 14:54:14
-;; Last-Mod: 22-Jun-24 at 23:43:08 by Mats Lidell
+;; Last-Mod: 23-Jun-24 at 23:39:40 by Mats Lidell
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -368,20 +368,32 @@ Match to all todos if `keyword' is nil or the empty
string."
(org-occur (concat "^" org-outline-regexp " *" (regexp-quote
keyword)))
keyword))
-(defun hsys-org-region-with-text-property-value (pos property)
- "Return region around POS that shares its text PROPERTY value, else nil.
+(defun hsys-org-first-face-type-pos (start org-face-type)
+ "Return the first position for property ORG-FACE-TYPE when viewed from
START."
+ (let (next)
+ (while (and (setq next (previous-single-property-change start 'face))
+ (hsys-org-is-face-type org-face-type (get-text-property (1-
next) 'face)))
+ (setq start next))
+ next))
+
+(defun hsys-org-last-face-type-pos (start org-face-type)
+ "Return the last position for property ORG-FACE-TYPE when viewed from START."
+ (let ((pos (next-single-property-change start 'face)))
+ (while (memq org-face-type (get-text-property pos 'face))
+ (setq pos (next-single-property-change pos 'face)))
+ pos))
+
+(defun hsys-org-region-with-face-type (pos org-face-type)
+ "Return region around POS that shares its ORG-FACE-TYPE value, else nil.
Return the (start . end) buffer positions of the region."
(when (null pos) (setq pos (point)))
- (let ((property-value (get-text-property pos property))
- (start-point pos))
- (when property-value
- ;; Can't use previous-single-property-change here because it
- ;; ignores characters that lack the property, i.e. have nil values.
+ (let ((start-point pos))
+ (when (hsys-org-is-face-type org-face-type (get-text-property pos 'face))
(if (bobp)
(setq start-point (point-min))
- (while (equal (get-text-property (1- start-point) property)
property-value)
+ (while (hsys-org-is-face-type org-face-type (get-text-property (1-
start-point) 'face))
(setq start-point (1- start-point))))
- (cons start-point (next-single-property-change start-point property)))))
+ (cons start-point (hsys-org-last-face-type-pos start-point
org-face-type)))))
(defun hsys-org-agenda-item-at-p ()
"Return non-nil if point is on an Org Agenda view item line, else nil."
@@ -453,7 +465,7 @@ Assume caller has already checked that the current buffer
is in `org-mode'."
Link region is (start . end) and includes delimiters, else nil."
(and (hsys-org-face-at-p 'org-link)
(equal (get-text-property (point) 'help-echo) "Radio target link")
- (hsys-org-region-with-text-property-value (point) 'face)))
+ (hsys-org-region-with-face-type (point) 'org-link)))
(defun hsys-org-radio-target-def-at-p ()
"Return target region iff point is on a <<<radio target>>> definition.
@@ -461,18 +473,19 @@ Target region is (start . end) and includes any
delimiters, else nil."
(when (hsys-org-target-at-p)
(save-excursion
(unless (looking-at org-radio-target-regexp)
- (goto-char (or (previous-single-property-change (point) 'face)
(point-min))))
+ (goto-char (or (hsys-org-first-face-type-pos (point) 'org-target)
+ (point-min))))
(when (looking-at "<<<")
(goto-char (match-end 0)))
(and (hsys-org-face-at-p 'org-target)
- (hsys-org-region-with-text-property-value (point) 'face)))))
+ (hsys-org-region-with-face-type (point) 'org-target)))))
(defun hsys-org-radio-target-at-p ()
"Return region iff point is on a <<<radio target>>> or a link to one.
The region is (start . end) and includes any delimiters, else nil."
(and (or (hsys-org-radio-target-def-at-p)
(hsys-org-radio-target-link-at-p))
- (hsys-org-region-with-text-property-value (point) 'face)))
+ (hsys-org-region-with-face-type (point) 'org-target)))
(defun hsys-org-internal-target-link-at-p ()
"Return link text region iff point is on an Org mode internal target link.
@@ -480,7 +493,7 @@ Link region is (start . end) and includes delimiters, else
nil."
(and (hsys-org-face-at-p 'org-link)
(not (equal (get-text-property (point) 'help-echo) "Radio target link"))
(hsys-org-link-at-p)
- (hsys-org-region-with-text-property-value (point) 'face)))
+ (hsys-org-region-with-face-type (point) 'org-link)))
(defun hsys-org-internal-target-def-at-p ()
"Return target region iff point is on <<internal target>> definition.
@@ -488,26 +501,29 @@ Target region is (start . end) and includes any
delimiters, else nil."
(when (hsys-org-target-at-p)
(save-excursion
(unless (looking-at org-target-regexp)
- (goto-char (or (previous-single-property-change (point) 'face)
(point-min))))
+ (goto-char (or (hsys-org-first-face-type-pos (point) 'org-target)
(point-min))))
(when (looking-at "<<")
(goto-char (match-end 0)))
(and (hsys-org-face-at-p 'org-target)
- (hsys-org-region-with-text-property-value (point) 'face)))))
+ (hsys-org-region-with-face-type (point) 'org-target)))))
(defun hsys-org-internal-target-at-p ()
"Return region iff point is on an <<internal target>> or a link to one.
The region is (start . end) and includes any delimiters, else nil."
(and (or (hsys-org-internal-target-def-at-p)
(hsys-org-internal-target-link-at-p))
- (hsys-org-region-with-text-property-value (point) 'face)))
+ (hsys-org-region-with-face-type (point) 'org-target)))
+
+(defun hsys-org-is-face-type (org-face-type face-prop)
+ "Non-nil if FACE-PROP is a or contain ORG-FACE-TYPE."
+ (when (or (eq face-prop org-face-type)
+ (and (listp face-prop) (memq org-face-type face-prop)))
+ org-face-type))
(defun hsys-org-face-at-p (org-face-type)
"Return ORG-FACE-TYPE iff point is on a character with that face, else nil.
ORG-FACE-TYPE must be a symbol, not a symbol name."
- (let ((face-prop (get-text-property (point) 'face)))
- (when (or (eq face-prop org-face-type)
- (and (listp face-prop) (memq org-face-type face-prop)))
- org-face-type)))
+ (hsys-org-is-face-type org-face-type (get-text-property (point) 'face)))
;; Adapted from Org code
(defun hsys-org-search-internal-link-p (target)
diff --git a/test/hsys-org-tests.el b/test/hsys-org-tests.el
index 9b905d066c..01fc3a2f61 100644
--- a/test/hsys-org-tests.el
+++ b/test/hsys-org-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <ma...@gnu.org>
;;
;; Orig-Date: 23-Apr-21 at 20:55:00
-;; Last-Mod: 9-Apr-24 at 09:32:53 by Mats Lidell
+;; Last-Mod: 23-Jun-24 at 23:08:22 by Mats Lidell
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -41,7 +41,7 @@
(insert "* 1\n** 2\n*** 3\n")
(goto-char 1)
(font-lock-ensure)
- (should (equal (hsys-org-region-with-text-property-value 1 'face) '(1 .
4)))))
+ (should (equal (hsys-org-region-with-face-type 1 'org-level-1) '(1 . 4)))))
;; TODO: org-agenda-item-at-p
