branch: externals/hyperbole
commit b266bc60acd7f0353429645c31be29e5a9cb4c88
Author: Bob Weiner <r...@gnu.org>
Commit: Bob Weiner <r...@gnu.org>
ibut:operate - Trigger errors when point is in read-only contexts
---
ChangeLog | 3 +++
HY-TALK/Hyperbole-and-Org-Mode.org | 9 ++++----
Makefile | 4 ++--
hbut.el | 43 ++++++++++++++++++++++++++++++++------
hload-path.el | 4 ++--
hsys-org.el | 24 +++++----------------
hversion.el | 10 ++++-----
7 files changed, 59 insertions(+), 38 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index bb837f7e9b..6cda3e788d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,8 @@
2023-08-27 Bob Weiner <r...@gnu.org>
+* hbut.el (ibut:org-at-read-only-p, ibut:operate): Trigger errors when point
is on
+ read-only text, read-only Org contexts, explicit buttons, or emacs
push-buttons.
+
* hyperbole.el (hyperbole--enable-mode, hyperbole--disable-mode): Stop setting
'mark-even-if-inactive' to nil as this is no longer needed. As a result,
remove
'hyperbole--mark-even-if-inactive'.
diff --git a/HY-TALK/Hyperbole-and-Org-Mode.org
b/HY-TALK/Hyperbole-and-Org-Mode.org
index 908ba667cc..592133ea1e 100644
--- a/HY-TALK/Hyperbole-and-Org-Mode.org
+++ b/HY-TALK/Hyperbole-and-Org-Mode.org
@@ -226,11 +226,11 @@ You can also use short names in front of implicit links:
<[frm]> "(hyperbole)C-h h s f"
Then better than Org links that jump to targets, {M-RET} on a link
-to a named implicit button (ilink) to activate the original button.
+to a named implicit button (ilink) will activate the original button.
<ilink:ib>
-Similarly, you can these buttons to your Hyperbole personal button file
+Similarly, you can add these buttons to your Hyperbole personal button file
accessed with {C-h h b p} and they become global buttons that can be referenced
from any buffer with a global link:
@@ -278,7 +278,8 @@ Variable name values can also be displayed.
* Action Key on Org Constructs
-** <hsys-org-enable-smart-keys> Shares M-RET between Hyperbole and Org
+** <hsys-org-enable-smart-keys> shares M-RET between Hyperbole and Org
+
This <<variable>> sets the Org mode contexts where Hyperbole's
Action/Assist keys are active. By default, these 'Smart Keys'
work only on hyperbuttons (Hyperbole's and Org's) when the variable
@@ -427,7 +428,7 @@ Let's mark all the backup files in a directory for future
deletion:
{C-x 4 d RET ~}
-n* Acknowledgements
+* Acknowledgements
The Org Team - for all the incredible things Org can do
diff --git a/Makefile b/Makefile
index 334f4ec6d2..f23768e236 100644
--- a/Makefile
+++ b/Makefile
@@ -3,7 +3,7 @@
# Author: Bob Weiner
#
# Orig-Date: 15-Jun-94 at 03:42:38
-# Last-Mod: 24-Jul-23 at 20:25:51 by Mats Lidell
+# Last-Mod: 27-Aug-23 at 15:19:50 by Bob Weiner
#
# Copyright (C) 1994-2023 Free Software Foundation, Inc.
# See the file HY-COPY for license information.
@@ -451,7 +451,7 @@ $(pkg_parent)/hyperbole-$(HYPB_VERSION).tar.sig:
$(pkg_parent)/hyperbole-$(HYPB_
$(pkg_parent)/hyperbole-$(HYPB_VERSION).tar: version $(HYPERBOLE_FILES)
$(RM) -fr $(pkg_hyperbole) $(pkg_hyperbole).tar
- # git archive --format=tar --prefix=hyperbole-$(HYPB_VERSION)/ HEAD |
(cd $(pkg_parent) && tar xf -)
+ # git archive --format=tar --prefix=hyperbole-$(HYPB_VERSION)/ HEAD |
(cd $(pkg_parent) && tar xf -)
(mkdir -p $(pkg_hyperbole) && git ls-files | tar Tzcf - - | (cd
$(pkg_hyperbole) && tar zxf -)) && \
cd $(pkg_hyperbole) && make autoloads && chmod 755 topwin.py && \
COPYFILE_DISABLE=1 $(TAR) -C $(pkg_parent) -clf $(pkg_hyperbole).tar
hyperbole-$(HYPB_VERSION)
diff --git a/hbut.el b/hbut.el
index 19d41b33a4..ca616349d9 100644
--- a/hbut.el
+++ b/hbut.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 18-Sep-91 at 02:57:09
-;; Last-Mod: 23-Aug-23 at 22:25:52 by Bob Weiner
+;; Last-Mod: 27-Aug-23 at 15:10:25 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -1935,10 +1935,7 @@ Default is the symbol \\='hbut:current. Return symbol
for button deleted or nil
(setq but-sym 'hbut:current))
(when (ibut:is-p but-sym)
(let ((name (hattr:get but-sym 'name))
- (name-start (hattr:get but-sym 'name-start))
- (name-end (hattr:get but-sym 'name-end))
(loc (hattr:get but-sym 'loc))
- (lbl-key (hattr:get but-sym 'lbl-key))
(lbl-start (hattr:get but-sym 'lbl-start))
(lbl-end (hattr:get but-sym 'lbl-end)))
(when (and lbl-start lbl-end)
@@ -1947,7 +1944,7 @@ Default is the symbol \\='hbut:current. Return symbol
for button deleted or nil
(save-excursion
(if name
(ibut:map
- (lambda (name start end)
+ (lambda (_name start _end)
(goto-char (+ start 2))
(when (ibut:set-name-and-label-key-p)
(ibut:delete-occurrence
@@ -2268,6 +2265,21 @@ Summary of operations based on inputs (name arg comes
from \\='hbut:current attr
(when (and region-flag edit-flag)
(hypb:error "(ibut:operate): 'edit-flag' must be nil when region is
highlighted to use region as new button name"))
+ ;; Error when on a read-only part of a buffer's text
+ (when (plist-member (text-properties-at (point)) 'read-only)
+ (hypb:error "(ibut:operate): Point must not be on a read-only Org
element"))
+ ;; Error when on an explicit button
+ (when (eq (hattr:get 'hbut:current 'categ) 'explicit)
+ (hypb:error "(ibut:operate): Point must not be on an explicit button: %s"
+ (ibut:label-to-key (hattr:get 'hbut:current 'lbl-key))))
+ ;; Error when on an Emacs push-button
+ (when (plist-member (text-properties-at (point)) 'button)
+ (hypb:error "(ibut:operate): Point must not be on an Emacs push-button:
%s"
+ (button-label (button-at (point)))))
+ ;; Error when in read-only contexts of an Org file
+ (when (ibut:org-at-read-only-p)
+ (hypb:error "(ibut:operate): Point must not be in a read-only Org
context"))
+
(unless new-name
(setq new-name name
name nil))
@@ -2286,7 +2298,7 @@ Summary of operations based on inputs (name arg comes
from \\='hbut:current attr
(if edit-flag "modify" "create")
ibut:label-start name ibut:label-end
(buffer-name))))
- (let (start end mark prev-point)
+ (let (start end)
(cond (edit-flag
(cond (name
;; Rename all occurrences of button - those with same name
@@ -2400,6 +2412,25 @@ Summary of operations based on inputs (name arg comes
from \\='hbut:current attr
;; instance-flag might be 't which we don't want to return.
(when (stringp instance-flag) instance-flag)))
+(defun ibut:org-at-read-only-p ()
+ "Return non-nil if point is in an Org read-only context."
+ (and (derived-mode-p 'org-mode)
+ (featurep 'hsys-org)
+ (or (hsys-org-src-block-start-at-p)
+ (hsys-org-block-start-at-p)
+ (let ((contexts (org-context)))
+ (and contexts
+ (delq nil (mapcar (lambda (ctxt) (assq ctxt contexts))
+ '(:checkbox
+ :headline-stars
+ :item-bullet
+ :keyword
+ :link
+ :priority
+ :table-special
+ :tags
+ :todo-keyword))))))))
+
(defun ibut:insert-text (ibut)
"Space, delimit and insert the text part of IBUT."
(cond ((looking-at ibut:label-separator-regexp)
diff --git a/hload-path.el b/hload-path.el
index 002cc244a4..b449075d8e 100644
--- a/hload-path.el
+++ b/hload-path.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 29-Jun-16 at 14:39:33
-;; Last-Mod: 2-Jul-23 at 12:25:01 by Bob Weiner
+;; Last-Mod: 27-Aug-23 at 15:20:49 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -114,7 +114,7 @@ the symbol list. For `suspicious', only `set-buffer' can
be used."
`(with-suppressed-warnings ,warnings ,@body)
`(with-no-warnings ,@body)))
-;; New autoload generation function defined only in Emacs 28
+;; New autoload generation function defined only as of Emacs 28
(defalias 'hload-path--make-directory-autoloads
(cond ((fboundp 'loaddefs-generate)
#'loaddefs-generate)
diff --git a/hsys-org.el b/hsys-org.el
index aea44c4283..c930adb1b2 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: 30-Jul-23 at 09:18:01 by Bob Weiner
+;; Last-Mod: 27-Aug-23 at 14:29:35 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -230,19 +230,6 @@ Return the (start . end) buffer positions of the region."
(let ((case-fold-search t))
(looking-at org-babel-src-block-regexp))))
-;; (defun hsys-org-link-at-p ()
-;; "Return non-nil iff point is on an Org mode link.
-;; Assume caller has already checked that the current buffer is in `org-mode'
-;; or are looking for an Org link in another buffer type."
-;; (unless (or (smart-eolp) (smart-eobp))
-;; (with-suppressed-warnings nil
-;; ;; org-element-context may call looking-at with a nil value,
-;; ;; triggering an error, so catch it. Also, suppress *Warnings*
-;; ;; display of backtrace.
-;; (condition-case ()
-;; (eq (org-element-type (org-element-context)) 'link)
-;; (error nil)))))
-
(defun hsys-org-link-at-p ()
"Return non-nil iff point is on an Org mode link.
Assume caller has already checked that the current buffer is in `org-mode'
@@ -259,10 +246,10 @@ or are looking for an Org link in another buffer type."
;; Assume caller has already checked that the current buffer is in org-mode.
(defun hsys-org-target-at-p ()
- "Return non-nil iff point is on an Org radio target or radio target link.
-The radio target is the definition and the radio target link is
-the referent. Assume caller has already checked that the current
-buffer is in `org-mode'."
+ "Return non-nil iff point is on an Org target or target link.
+The target is the definition and the target link is the referent.
+Assume caller has already checked that the current buffer is in
+`org-mode'."
(hsys-org-face-at-p 'org-target))
;; Assume caller has already checked that the current buffer is in org-mode.
@@ -328,7 +315,6 @@ The region is (start . end) and includes any delimiters,
else nil."
(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)))
diff --git a/hversion.el b/hversion.el
index 60d3f73a06..d59e50eda2 100644
--- a/hversion.el
+++ b/hversion.el
@@ -4,7 +4,7 @@
;; Maintainer: Bob Weiner, Mats Lidell
;;
;; Orig-Date: 1-Jan-94
-;; Last-Mod: 25-Jun-23 at 11:59:46 by Bob Weiner
+;; Last-Mod: 27-Aug-23 at 15:26:39 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -150,7 +150,7 @@ support is available."
(frame-parameter frame 'hyperb:window-system))
;; Each frame could be on a different window system when under a
-;; client-server window system, so set `hyperb:window-system' for
+;; client-server window system, so set `hyperb:window-system' for
;; each frame.
(mapc #'hyperb:window-sys-term (frame-list))
;; Ensure this next hook is appended so that if follows the hook that
@@ -161,7 +161,7 @@ support is available."
;;; Public functions used by pulldown and popup menus
;;; ************************************************************************
-(if (not (fboundp 'id-browse-file))
+(unless (fboundp 'id-browse-file)
(defalias 'id-browse-file 'view-file))
(unless (fboundp 'id-info)
@@ -208,10 +208,10 @@ support is available."
(error "(id-info-item): Invalid Info index item: `%s'"
index-item)))
(error "(id-info-item): Info index item must be a string: `%s'"
index-item))))
-(if (not (fboundp 'id-tool-quit))
+(unless (fboundp 'id-tool-quit)
(defalias 'id-tool-quit #'eval))
-(if (not (fboundp 'id-tool-invoke))
+(unless (fboundp 'id-tool-invoke)
(defun id-tool-invoke (sexp)
(if (commandp sexp)
(call-interactively sexp)
