[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/hyperbole 37ae486775 2/2: Fix a number of issues with A
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/hyperbole 37ae486775 2/2: Fix a number of issues with Action Buttons |
|
Date: |
Sun, 30 Jan 2022 04:57:39 -0500 (EST) |
branch: externals/hyperbole
commit 37ae48677533276421a5ac85640a7968542d9270
Author: Robert Weiner <rsw@gnu.org>
Commit: Robert Weiner <rsw@gnu.org>
Fix a number of issues with Action Buttons
---
ChangeLog | 21 ++++++++++++++++++++
hact.el | 8 ++++----
hactypes.el | 5 +++--
hbut.el | 10 +++++++---
hibtypes.el | 56 +++++++++++++++++++++++++++++++-----------------------
test/demo-tests.el | 33 +++++++++++++++++++++++++++++---
6 files changed, 97 insertions(+), 36 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 30c053c285..351c447063 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,26 @@
+2022-01-30 Bob Weiner <rsw@gnu.org>
+
+* hact.el (actype:act): Allow for builtin subr objects like 'cons';
+ This fixes Action Buttons that start with <progn ...>, for example.
+
2022-01-29 Bob Weiner <rsw@gnu.org>
+* hbut.el (hbut:key-list): Fix doc.
+
+* test/demo-tests.el (demo-implicit-button-action-button-sexp-test):
+
(demo-implicit-button-action-button-boolean-function-call-test):
+ Add to test Action Button sexp and boolean functions.
+
+* hactypes.el (display-boolean): Change to add 'bool-expr' to output msg.
+
+* hibtypes.el (action): Fix bug that when intern-soft returns nil, then check
+ if returned symbol is boundp, neglected to check that symbol was not nil
+ and therefore (boundp nil) was returning t, causing the logic to misfire.
+ Also, add 'hact' calls at the end and double quote variable args or will
+ trigger an error.
+
+* hact.el (actype:eval): Simplify action with args call.
+
* hycontrol.el (hycontrol-invert-prefix-arg): Add to invert prefix arg or
change
0 to -1.
(hycontrol-reset-prefix-arg): Turn into a named function so can
diff --git a/hact.el b/hact.el
index 9bb4e821e3..5e0c596344 100644
--- a/hact.el
+++ b/hact.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 18-Sep-91 at 02:57:09
-;; Last-Mod: 24-Jan-22 at 00:15:02 by Bob Weiner
+;; Last-Mod: 30-Jan-22 at 03:07:43 by Bob Weiner
;;
;; Copyright (C) 1991-2021 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -416,6 +416,7 @@ performing ACTION."
(run-hooks 'action-act-hook)
(prog1 (or (if (or (symbolp action) (listp action)
(hypb:emacs-byte-code-p action)
+ (subrp action)
(and (stringp action) (not (integerp action))
(setq action (key-binding action))))
(eval (cons action args))
@@ -443,8 +444,7 @@ and ARGS are extracted. ACTYPE may be a symbol or symbol
name for
either an action type or a function. Run `action-act-hook' before
performing ACTION."
(let ((prefix-arg current-prefix-arg)
- (action (actype:action actype))
- (act '(apply action args)))
+ (action (actype:action actype)))
(if (null action)
(error "(actype:act): Null action for: `%s'" actype)
(let ((hist-elt (hhist:element)))
@@ -453,7 +453,7 @@ performing ACTION."
(hypb:emacs-byte-code-p action)
(and (stringp action) (not (integerp action))
(setq action (key-binding action))))
- (eval act)
+ (apply action args)
(eval action))
(hhist:add hist-elt))))))
diff --git a/hactypes.el b/hactypes.el
index 57a69e4b9a..a721c2c950 100644
--- a/hactypes.el
+++ b/hactypes.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 23-Sep-91 at 20:34:36
-;; Last-Mod: 24-Jan-22 at 00:16:30 by Bob Weiner
+;; Last-Mod: 29-Jan-22 at 19:47:39 by Bob Weiner
;;
;; Copyright (C) 1991-2021 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -60,7 +60,8 @@ inserted, delete the completions window."
"Display a message showing the result value of a BOOL-EXPR.
Return any non-nil value or t."
(let ((result (eval bool-expr t)))
- (message "Boolean result (%s) = %s" (if result "True" "False")
(prin1-to-string result))
+ (message "Boolean result (%s) = %S; Expr: %S"
+ (if result "True" "False") result bool-expr)
(or result t)))
(defact display-variable (var)
diff --git a/hbut.el b/hbut.el
index 034cf86582..054a867472 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: 24-Jan-22 at 00:18:32 by Bob Weiner
+;; Last-Mod: 30-Jan-22 at 03:17:19 by Bob Weiner
;;
;; Copyright (C) 1991-2021 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -17,7 +17,8 @@
;;; Other required Elisp libraries
;;; ************************************************************************
-(eval-and-compile (mapc #'require '(elisp-mode help-mode hversion hmoccur
+;; Require 'cl for `copy-list'
+(eval-and-compile (mapc #'require '(cl elisp-mode help-mode hversion hmoccur
hbmap htz hbdata hact view)))
;;; ************************************************************************
@@ -1422,7 +1423,7 @@ source file for the buttons in the menu, if any.")
;;; ------------------------------------------------------------------------
(defun hbut:key-list ()
- "Return list of global button label keys."
+ "Return list of explicit and named implicit button label keys in current
buffer."
(nconc (hbut:ebut-key-list) (hbut:ibut-key-list)))
(defun hbut:ebut-key-list (&optional key-src)
@@ -1534,6 +1535,9 @@ excluding delimiters, not just one."
(or (hattr:get 'hbut:current 'args)
(not (listp args))
(progn
+ (setq args (copy-list args))
+ (when (eq (car args) #'hact)
+ (setq args (cdr args)))
(hattr:set 'hbut:current 'actype
(or
;; Hyperbole action type
diff --git a/hibtypes.el b/hibtypes.el
index 1f9e290e82..acfa7ff531 100644
--- a/hibtypes.el
+++ b/hibtypes.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 19-Sep-91 at 20:45:31
-;; Last-Mod: 24-Jan-22 at 00:31:57 by Bob Weiner
+;; Last-Mod: 30-Jan-22 at 03:12:41 by Bob Weiner
;;
;; Copyright (C) 1991-2021 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -1351,12 +1351,15 @@ arg1 ... argN '>'. For example, <mail nil
\"user@somewhere.org\">."
lbl (substring lbl 1)))
(setq actype (if (string-match-p " " lbl) (car (split-string lbl)) lbl)
actype-sym (intern-soft (concat "actypes::" actype))
- actype (or (and (or (fboundp actype-sym) (boundp actype-sym))
actype-sym)
- (progn (setq actype-sym (intern-soft actype))
- (and (or (fboundp actype-sym) (boundp
actype-sym)) actype-sym))))
- ;; Ignore unbound symbols
- (unless (and actype (or (fboundp actype) (boundp actype) (special-form-p
actype)))
- (setq actype nil))
+ ;; Must ignore that (boundp nil) would be t here.
+ actype (or (and actype-sym
+ (or (fboundp actype-sym) (boundp actype-sym)
+ (special-form-p actype-sym))
+ actype-sym)
+ (and (setq actype-sym (intern-soft actype))
+ (or (fboundp actype-sym) (boundp actype-sym)
+ (special-form-p actype-sym))
+ actype-sym)))
(when actype
(ibut:label-set lbl start-pos end-pos)
(setq action (read (concat "(" lbl ")"))
@@ -1364,7 +1367,8 @@ arg1 ... argN '>'. For example, <mail nil
\"user@somewhere.org\">."
(cond ((and (symbolp actype) (fboundp actype)
(string-match "-p\\'" (symbol-name actype)))
;; Is a function with a boolean result
- (setq action `(display-boolean ',action)
+ (setq args `(',action)
+ action `(display-boolean ',action)
actype #'display-boolean))
((and (null args) (symbolp actype) (boundp actype)
(or var-flag (not (fboundp actype))))
@@ -1378,22 +1382,26 @@ arg1 ... argN '>'. For example, <mail nil
\"user@somewhere.org\">."
#'actype:identity
#'actype:eval)))
(if (eq hrule:action #'actype:identity)
- (apply hrule:action actype args)
- (apply hrule:action actype (mapcar #'eval args))))))))
-
-;; !! Todo: Finish this
-
-;; (defun action:help (label)
-;; "Display documentation for action button function or variable."
-;; (interactive (list (hargs:read-match "Report on global button labeled: "
-;; (mapcar 'list (gbut:label-list))
-;; nil t nil 'hbut)))
-;; (let* ((lbl-key (hbut:label-to-key label))
-;; (but (hbut:get lbl-key nil gbut:file)))
-;; (if but
-;; (hbut:report but)
-;; (error "(gbut:help): No global button labeled: %s" label))))
-
+ `(hact ,actype ,@args)
+ `(hact ,actype ,@(mapcar #'eval ,args))))))))
+
+(defun action:help (hbut)
+ "Display documentation for action button at point.
+If a boolean function or variable, display its value."
+ (interactive
+ (list
+ (when hbut
+ (hbut:label hbut))))
+ (when (hbut:is-p hbut)
+ (let* ((label (hbut:key-to-label (hattr:get hbut 'lbl-key)))
+ (actype (hattr:get hbut 'actype))
+ (args (hattr:get hbut 'args)))
+ (setq actype (or (htype:def-symbol actype) actype))
+ (if hbut
+ (progn (hbut:report hbut)
+ (when (memq actype '(display-boolean display-variable))
+ (apply #'actype:eval actype args)))
+ (error "(action:help): No action button labeled: %s" label)))))
;;; ========================================================================
;;; Inserts completion into minibuffer or other window.
diff --git a/test/demo-tests.el b/test/demo-tests.el
index 654d841351..9862849526 100644
--- a/test/demo-tests.el
+++ b/test/demo-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <matsl@gnu.org>
;;
;; Orig-Date: 30-Jan-21 at 12:00:00
-;; Last-Mod: 24-Jan-22 at 00:38:00 by Bob Weiner
+;; Last-Mod: 30-Jan-22 at 03:11:47 by Bob Weiner
;;
;; Copyright (C) 2021 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -202,16 +202,43 @@
(goto-char 5)
(action-key)
(should (string= "DEMO" (buffer-name)))
- (should (looking-at "\s*Table of Contents")))
+ (should (= 5 (line-number-at-pos (point)))))
(kill-buffer "DEMO")))
-(ert-deftest demo-implicit-button-action-button-function-calls-test ()
+(ert-deftest demo-implicit-button-action-button-function-call-test ()
(with-temp-buffer
(insert "<message \"%d\" (eval (+ 2 2))>")
(goto-char 2)
(action-key)
(hy-test-helpers:should-last-message "4")))
+(ert-deftest demo-implicit-button-action-button-sexp-test ()
+ (with-temp-buffer
+ (insert
+ "<progn (mapc (lambda (f) (bury-buffer (find-file-noselect
+ (expand-file-name f hyperb:dir))))
+ '(\"hibtypes.el\" \"hactypes.el\" \"hsettings.el\"))
+ (message \"Last 3 buffers are: %S\"
+ (mapcar #'buffer-name
+ (nthcdr (- (length (buffer-list)) 3)
(buffer-list))))>")
+ (goto-char 2)
+ (action-key)
+ (let* ((bufs (reverse (buffer-list)))
+ (hsettings-buf (buffer-name (nth 0 bufs)))
+ (hactypes-buf (buffer-name (nth 1 bufs)))
+ (hibtypes-buf (buffer-name (nth 2 bufs))))
+ (should (and (hy-test-helpers:should-last-message "Last 3 buffers are")
+ (string-match-p "hsettings\\.el" hsettings-buf)
+ (string-match-p "hactypes\\.el" hactypes-buf)
+ (string-match-p "hibtypes\\.el" hibtypes-buf))))))
+
+(ert-deftest demo-implicit-button-action-button-boolean-function-call-test ()
+ (with-temp-buffer
+ (insert "<string-empty-p \"False\">")
+ (goto-char 2)
+ (action-key)
+ (hy-test-helpers:should-last-message "Boolean result (False) = nil")))
+
(ert-deftest demo-implicit-button-action-button-variable-display-test ()
(with-temp-buffer
(insert "<fill-column>")