branch: externals/hyperbole
commit 04e6b302c1fdc4245f9d999a11b8de09ef6a4f7a
Author: Bob Weiner <r...@gnu.org>
Commit: Bob Weiner <r...@gnu.org>
HyRolo updates to improve file heading handling, markdown headers
Also better handle org-fold compatibility
---
ChangeLog | 34 ++++++++++++++++++++++++++++++++--
hmouse-tag.el | 17 ++++++++---------
hsys-org.el | 22 ++++++++++++++++++----
hui-mouse.el | 14 ++++++++------
hyrolo.el | 51 ++++++++++++++++++++++++++++++++++-----------------
test/hyrolo-tests.el | 2 --
6 files changed, 100 insertions(+), 40 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 509e69c490..4ee0965fe7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,15 +1,46 @@
+2024-02-04 Bob Weiner <r...@gnu.org>
+
+* hyrolo.el (hyrolo-add): Ensure when matching for initial # characters, do
not match
+ to those later in the line.
+ (hyrolo-markdown-mode): Fix to match only to lines starting with #
as an
+ entry prefix; don't use `markdown-regex-header' since that allows '- ' as
an
+ entry prefix.
+
+* hsys-org.el (hsys-org--set-fold-style): Add and use in
'hsys-org-fix-version'.
+
2024-02-03 Mats Lidell <ma...@gnu.org>
* test/demo-tests.el (fast-demo-key-series-shell-apropos): Skip test if
apropos command is not available. Useful for running test-all using
silex docker-emacs images.
+2024-02-03 Bob Weiner <r...@gnu.org>
+
+* hyrolo.el (hyrolo-move-to-entry-end): Add doc string; add 'condition-case' in
+ case of 'outline-before-first-heading' error (see advice from
"org-compat.el").
+ hui-mouse.el (smart-outline-to-entry-end): Reverse parts of if clause; add
+ 'condition-case' in case of 'outline-before-first-heading' error (see
advice
+ from "org-compat.el").
+ (hyrolo-cache-get-major-mode-from-pos): Fix error msg to reflect >= not >.
+
2024-02-01 Mats Lidell <ma...@gnu.org>
* test/hyrolo-tests.el (hyrolo-tests--hyrolo-section-header): Helper that
returns a HyRolo section header.
(hyrolo-tests--hyrolo-reveal-mode): Add reveal mode test.
+2024-02-01 Bob Weiner <r...@gnu.org>
+
+* hyrolo.el (hyrolo-hdr-move-after-p): Updated to skip over trailing empty
lines.
+* test/hyrolo-tests.el (hyrolo-demo-no-following-same-level-heading,
+ hyrolo-demo-move-between-entries-on-same-level): No
longer
+ need to go to next record after moving past a header followed by a blank
line.
+
+2024-01-31 Bob Weiner <r...@gnu.org>
+
+* hyrolo.el (hyrolo-move-to-entry-end): Handle potential error raised if called
+ with point before the first entry.
+
2024-01-30 Mats Lidell <ma...@gnu.org>
* test/hyrolo-tests.el (hyrolo-tests--outline-as-string): Add helper that
@@ -29,8 +60,7 @@
* hmouse-tag.el (find-ert-test-regexp): Change ert test definition lookups to
use
the path stored in each test symbol's 'ert--test' property by changing from
using the 'xref-find-definitions' in 'find-function-regexp-alist' to using
- this newly defined regexp instead. Add (require 'cl-lib) since this update
- uses 'cl-delete-if'.
+ this newly defined regexp instead.
* hyrolo.el (hyrolo-reveal-open-new-overlays,
hyrolo-reveal-close-old-overlays):
Wrap 'funcall' in 'hyrolo-funcall-match' so uses HyRolo outline settings.
diff --git a/hmouse-tag.el b/hmouse-tag.el
index 972099d70c..1d10add13b 100644
--- a/hmouse-tag.el
+++ b/hmouse-tag.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 24-Aug-91
-;; Last-Mod: 28-Jan-24 at 15:54:51 by Bob Weiner
+;; Last-Mod: 28-Jan-24 at 18:36:34 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -20,7 +20,7 @@
;;; ************************************************************************
(eval-and-compile
- (mapc #'require '(cl-lib find-func hpath hui-select))
+ (mapc #'require '(find-func hpath hui-select))
(unless (or (featurep 'etags) (featurep 'tags))
;; Force use of .elc file here since otherwise the bin/etags
;; executable might be found in a user's load-path by the load
@@ -100,13 +100,12 @@ should insert the implicit link type definition name.")
;; Add Hyperbole def types to `find-function-regexp-alist'.
(mapc (lambda (item)
(setq find-function-regexp-alist
- (cl-delete-if (lambda (elt) (eq (car elt) (car item)))
- find-function-regexp-alist))
- (add-to-list 'find-function-regexp-alist item))
- '((defact . find-defact-regexp)
- (defal . find-defal-regexp)
- (defib . find-defib-regexp)
- (defil . find-defil-regexp)
+ (assq-delete-all (car item) find-function-regexp-alist))
+ (push item find-function-regexp-alist))
+ '((defact . find-defact-regexp)
+ (defal . find-defal-regexp)
+ (defib . find-defib-regexp)
+ (defil . find-defil-regexp)
(ert--test . find-ert-test-regexp)))
(define-obsolete-variable-alias 'smart-asm-include-dirs
diff --git a/hsys-org.el b/hsys-org.el
index 399d1196ec..852fa0015a 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: 21-Jan-24 at 11:47:53 by Bob Weiner
+;; Last-Mod: 4-Feb-24 at 14:12:06 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -173,8 +173,11 @@ Return t if Org is reloaded, else nil."
(string-equal (match-string 1 org-dir) ;; org-dir version
(remove ?- (org-release)))
t))
- ;; Just require these libraries used for Hyperbole testing to ensure
- ;; they are loaded from the single Org version used.
+ ;; Ensure Org folding is configured for `reveal-mode' compatibility
+ (hsys-org--set-fold-style)
+ ;; Just require these libraries used for Hyperbole testing
+ ;; (when they are available) to ensure they are loaded from
+ ;; the single Org version used.
(mapc (lambda (lib-sym) (require lib-sym nil t))
'(org-version org-keys org-compat ol org-table org-macs org-id
org-element org-list org-element org-src
org-fold org))
@@ -192,7 +195,10 @@ Return t if Org is reloaded, else nil."
org-libraries-to-reload)
;; Ensure user's external Org package version is configured for
loading
- (package-initialize)
+ (unless (and package--initialized (not after-init-time))
+ (package-initialize))
+ ;; Ensure Org folding is configured for `reveal-mode' compatibility
+ (hsys-org--set-fold-style)
(let ((pkg-desc (car (cdr (assq 'org package-archive-contents)))))
(package-activate pkg-desc t))
@@ -549,6 +555,14 @@ TARGET must be a string."
;;; Private functions
;;; ************************************************************************
+(defun hsys-org--set-fold-style ()
+ "Set `org-fold-core-style' to 'overlays for `reveal-mode' compatibility.
+This must be called before Org mode is loaded."
+ (when (and (ignore-errors (find-library-name "org-fold-core"))
+ (not (boundp 'org-fold-core-style)))
+ (load "org-fold-core"))
+ (custom-set-variables '(org-fold-core-style 'overlays)))
+
(provide 'hsys-org)
;;; hsys-org.el ends here
diff --git a/hui-mouse.el b/hui-mouse.el
index 512825a8b8..016892db25 100644
--- a/hui-mouse.el
+++ b/hui-mouse.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 04-Feb-89
-;; Last-Mod: 27-Jan-24 at 11:29:19 by Bob Weiner
+;; Last-Mod: 4-Feb-24 at 10:07:05 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -2041,13 +2041,15 @@ If assist key is pressed:
(t (outline-hide-entry))))
(defun smart-outline-to-entry-end (&optional include-sub-entries)
- "Move point past the end of the current entry.
+ "Move point past the end of the current entry, if any.
With optional INCLUDE-SUB-ENTRIES non-nil, move to the end of the
entire subtree. Return final point."
- (if include-sub-entries
- (progn (outline-end-of-subtree)
- (goto-char (1+ (point))))
- (outline-next-heading))
+ (if (not include-sub-entries)
+ (outline-next-heading)
+ (condition-case ()
+ (progn (outline-end-of-subtree)
+ (goto-char (1+ (point))))
+ (error "")))
(point))
(defun smart-outline-subtree-hidden-p ()
diff --git a/hyrolo.el b/hyrolo.el
index 25e34e3953..b675209789 100644
--- a/hyrolo.el
+++ b/hyrolo.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 7-Jun-89 at 22:08:29
-;; Last-Mod: 28-Jan-24 at 15:34:45 by Bob Weiner
+;; Last-Mod: 4-Feb-24 at 14:00:36 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -491,7 +491,7 @@ entry which begins with the parent string."
(re-search-forward
hyrolo-entry-name-regexp nil t)
(point))))
(when (and (derived-mode-p 'markdown-mode)
- (string-match "\\`.*#+" entry-spc))
+ (string-match "\\`[^#]*#+" entry-spc))
(setq entry-spc (substring entry-spc (length (match-string 0
entry-spc)))))
(cond ((string-lessp entry name)
(hyrolo-to-entry-end t))
@@ -1038,7 +1038,7 @@ or NAME is invalid, return nil."
;; `hyrolo-add' handles removing # prefix from
;; trailing-space grouping below
hyrolo-entry-trailing-space-group-number 2
- outline-regexp (concat hyrolo-hdr-prefix-regexp
markdown-regex-header)
+ outline-regexp (concat hyrolo-hdr-prefix-regexp "^\\(#+\\)\\([
\t\n\r]\\)")
outline-level #'hyrolo-outline-level)
;; Use ellipses for invisible text
(add-to-invisibility-spec '(outline . t))
@@ -1146,7 +1146,7 @@ non-nil."
(setq-local hyrolo-entry-regexp "^\\([*\^L]+\\)\\([ \t\n\r]+\\)"
hyrolo-hdr-and-entry-regexp (concat hyrolo-hdr-prefix-regexp
hyrolo-entry-regexp)
hyrolo-entry-group-number 1
- ;; `hyrolo-add' handles removing # prefix from
+ ;; `hyrolo-add' handles removing * prefix from
;; trailing-space grouping below
hyrolo-entry-trailing-space-group-number 2
outline-regexp (concat hyrolo-hdr-prefix-regexp
"^\\([*\^L]+\\)\\([ \t\n\r]\\)")
@@ -1867,8 +1867,8 @@ The header includes lines matching both
`hyrolo-hdr-regexp' and
(save-excursion (hyrolo-hdr-move-after-p)))
(defun hyrolo-hdr-move-after-p ()
- "If point is within a file header, move past the hdr and return non-nil.
-Otherwise, don't move and return nil."
+ "If point is within a file header, move past the hdr and blank lines.
+Return non-nil if point moves, else return nil."
(let ((opoint (point))
result)
(if (save-excursion
@@ -1900,7 +1900,9 @@ Otherwise, don't move and return nil."
;; @loc> line after header
(forward-line 1))))
(if (> (point) opoint)
- result
+ (progn (while (looking-at-p "^[ \t]*$")
+ (forward-line 1))
+ result)
(goto-char opoint)
nil)))
@@ -2134,9 +2136,7 @@ Calls the functions given by `hyrolo-mode-hook'.
"@loc> ")
1)
outline-heading-alist)
- ;; This next local value is dynamically overridden in `hyrolo-grep'.
- (setq-local outline-regexp "\\([*\^L]+\\)\\([ \t\n\r]\\)"
- hyrolo-entry-regexp (concat "^" "\\([*\^L]+\\)\\([ \t\n\r]+\\)")
+ (setq-local hyrolo-entry-regexp (concat "^" "\\([*\^L]+\\)\\([
\t\n\r]+\\)")
hyrolo-hdr-and-entry-regexp (default-value
'hyrolo-hdr-and-entry-regexp)
;; In `outline-regexp', prevent matching to *word*
;; at the beginning of lines and hanging hyrolo
@@ -2144,6 +2144,8 @@ Calls the functions given by `hyrolo-mode-hook'.
;; the end of the match. Note this change adds one
;; level to the level count, so `hyrolo-outline-level'
;; decrements it by one. -- rsw, 2023-11-17
+ ;; This next local value is dynamically overridden in
`hyrolo-grep'.
+ outline-regexp "\\([*\^L]+\\)\\([ \t\n\r]\\)"
outline-level #'hyrolo-outline-level)
;; Can't cycle because {TAB} moves to next match
@@ -2669,10 +2671,24 @@ Return current point."
(point)))
(defun hyrolo-move-to-entry-end (include-sub-entries)
+ "Move point past the end of the current entry, if any.
+With optional INCLUDE-SUB-ENTRIES non-nil, move to the end of the
+entire subtree. Return INCLUDE-SUB-ENTRIES flag value."
(if (not include-sub-entries)
+ ;; Move to (point-max) if no next heading found and return nil
(outline-next-heading)
- (outline-end-of-subtree)
- (goto-char (1+ (point))))
+ ;; When point is before the first entry in an Org file,
+ ;; `outline-end-of-subtree' can signal an
+ ;; `outline-before-first-heading' error within its subcall to
+ ;; `outline-back-to-heading' because of advice wrapped around that
+ ;; function from "org-compat.el".
+ (condition-case ()
+ (progn
+ (outline-end-of-subtree)
+ (goto-char (1+ (point))))
+ ;; Error means point is before the first buffer heading; move
+ ;; past file header to any next entry.
+ (error (hyrolo-hdr-move-after-p))))
include-sub-entries)
(defun hyrolo-to-next-loc ()
@@ -2968,13 +2984,13 @@ Any non-nil value returned is a cons of (<entry-name> .
<entry-source>)."
(org-fold-core-set-folding-spec-property (car
org-link--link-folding-spec) :visible nil)
(org-fold-core-set-folding-spec-property (car
org-link--link-folding-spec) :visible t)))
- (setq-local hyrolo-entry-regexp "^\\(\\*+\\)\\([ ]+\\)"
+ (setq-local hyrolo-entry-regexp "^\\(\\*+\\)\\([ \t\n\r]+\\)"
hyrolo-hdr-and-entry-regexp (concat hyrolo-hdr-prefix-regexp
hyrolo-entry-regexp)
hyrolo-entry-group-number 1
- ;; `hyrolo-add' handles removing # prefix from
+ ;; `hyrolo-add' handles removing * prefix from
;; trailing-space grouping below
hyrolo-entry-trailing-space-group-number 2
- outline-regexp (concat hyrolo-hdr-prefix-regexp "^\\(\\*+\\)\\(
\\)")
+ outline-regexp (concat hyrolo-hdr-prefix-regexp "^\\(\\*+\\)\\([
\t\n\r]\\)")
outline-level #'hyrolo-outline-level)
(use-local-map org-mode-map)
;; Modify a few syntax entries
@@ -3106,7 +3122,8 @@ Return final point."
(apply func args))
;; Narrow to current match buffer when given a lambda func.
(not (symbolp func)))
- ;; Prevent error and move past file header.
+ ;; Error means point is before the first buffer heading; move
+ ;; past file header to any next entry.
(error (hyrolo-hdr-move-after-p)))
(point))
@@ -3163,7 +3180,7 @@ HyRolo display matches buffer.")
"Get the `major-mode' associated with POS in the current HyRolo display
buffer."
(hyrolo--cache-get-major-mode-from-index
(nth (or (seq-position hyrolo--cache-loc-match-bounds pos (lambda (e pos)
(< pos e)))
- (error "(hyrolo-cache-get-major-mode): pos=%d > max display buffer
pos=%d"
+ (error "(hyrolo-cache-get-major-mode): pos=%d >= max display buffer
pos=%d"
pos (car hyrolo--cache-loc-match-bounds)))
hyrolo--cache-major-mode-indexes)))
diff --git a/test/hyrolo-tests.el b/test/hyrolo-tests.el
index 1aa4e669d1..8a007156db 100644
--- a/test/hyrolo-tests.el
+++ b/test/hyrolo-tests.el
@@ -176,7 +176,6 @@ and {b} the previous same level cell."
(should (equal (point) (point-min)))
(hyrolo-hdr-move-after-p)
- (should (hact 'kbd-key "n"))
(should (looking-at "\\*\\*\\s-+Strong"))
(should (hact 'kbd-key "f"))
@@ -200,7 +199,6 @@ and {b} the previous same level cell."
(should (equal (point) (point-min)))
(hyrolo-hdr-move-after-p)
- (should (hact 'kbd-key "n"))
(should (looking-at "\\*\\*\\s-+Strong"))
(should (hact 'kbd-key "n"))
