branch: externals/hyperbole
commit da50cc8197dd5f8a93ef742ac25ee6e2f0b18032
Author: Bob Weiner <r...@gnu.org>
Commit: Bob Weiner <r...@gnu.org>
Fix so no fatal errors and pass all tests when natively compiled
---
ChangeLog | 31 +++++++++++++++++++++++++
FAST-DEMO | 9 ++++++--
MANIFEST | 2 +-
Makefile | 8 +++----
hact.el | 66 ++++++++++++-----------------------------------------
hactypes.el | 4 ++--
hargs.el | 2 +-
hload-path.el | 4 ++--
hui-mouse.el | 3 +--
hypb.el | 12 +++++++---
test/hpath-tests.el | 46 +++++++++++++++++++------------------
11 files changed, 97 insertions(+), 90 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index cbb63a2e03..924dd8e6ff 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,34 @@
+2022-06-04 Bob Weiner <r...@gnu.org>
+
+* test/hpath-tests.el (hpath--should-exist-paths): Fix to handle Hyperbole
package installation dirs.
+
+* hact.el (action:params-emacs): Simplify by calling 'help-function-arglist'.
+
+* hypb.el (hypb:debug):
+ hact.el (actype:eval):
+ hargs.el (hargs:action-get): Handle builtin and natively compiled
subroutines/functions.
+
+* hypb.el (hypb:display-file-with-logo): Add slight delay after file load to
ensure searching
+ always succeeds.
+
+* Makefile (EMACS): Fix on MacOS so can still override emacs version by
prefixing the make
+ command with EMACS=<executable>.
+
+2022-06-02 Bob Weiner <r...@gnu.org>
+
+* Makefile (version): Add hyperbole-pkg.el to version check.
+
+2022-05-30 Bob Weiner <r...@gnu.org>
+
+* hact.el (action:params): Add support for natively-compiled functions
+ using 'help-function-arglist' from "help.el".
+ hypb.el (hypb:emacs-byte-code-p): Make an autoload since referenced from
+ hact.el.
+
+2022-05-28 Bob Weiner <r...@gnu.org>
+
+* hactypes.el (link-to-texinfo-node): Fix typo in find-file-noselect call.
+
2022-05-22 Bob Weiner <r...@gnu.org>
* hsys-org.el (hsys-org-meta-return): Remove optional ARG and just use value
of current-prefix-arg
diff --git a/FAST-DEMO b/FAST-DEMO
index edc8557a18..08e604944a 100644
--- a/FAST-DEMO
+++ b/FAST-DEMO
@@ -172,9 +172,14 @@
* Posix/Linux Shell Command Implicit Buttons
+ Some of the below commands require recursive use of the minibuffer, so
let's
+ ensure that is enabled:
+
+ <setq enable-recursive-minibuffers t>
+
The shell command part of the demo requires a shell that is compatible
- with bash. If you are using another shell you can for this part switch
- to bash,
+ with bash. If you are using another shell you can switch to bash for
+ this part of the demo:
{ M-x set-variable RET shell-file-name RET C-u M-! /usr/bin/env SPC bash
RET RET }
diff --git a/MANIFEST b/MANIFEST
index e1b8b26c48..da46525474 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -85,7 +85,7 @@ hib-doc-id.el - Implicit button type for document id
index entries
hib-kbd.el - Implicit button type for key sequences delimited with {}
hib-social.el - Implicit button type for social media/git hashtag and
username references
hinit.el - Standard initializations for GNU Hyperbole
-hload-path.el - GNU Hyperbole load-path setup
+hload-path.el - GNU Hyperbole load-path and autoload early
initializations
hsettings.el - GNU Hyperbole settings which may require customization
hvar.el - Variable manipulation routines for GNU Hyperbole
hypb-maintenance.el - Support for updating Hyperbole web pages
diff --git a/Makefile b/Makefile
index 9f2ebd7831..aabd834e98 100644
--- a/Makefile
+++ b/Makefile
@@ -3,7 +3,7 @@
# Author: Bob Weiner
#
# Orig-Date: 15-Jun-94 at 03:42:38
-# Last-Mod: 11-May-22 at 01:30:04 by Bob Weiner
+# Last-Mod: 4-Jun-22 at 01:26:17 by Bob Weiner
#
# Copyright (C) 1994-2022 Free Software Foundation, Inc.
# See the file HY-COPY for license information.
@@ -333,7 +333,7 @@ clean:
version: doc
@ echo ""
@ echo "Any fgrep output means the version number has not been updated
in that file."
- test 0 -eq $$(fgrep -L $(HYPB_VERSION) Makefile HY-ABOUT HY-NEWS
README.md hversion.el hyperbole.el man/hyperbole.texi man/version.texi | wc -c)
|| exit 1
+ test 0 -eq $$(fgrep -L $(HYPB_VERSION) hyperbole-pkg.el Makefile
HY-ABOUT HY-NEWS README.md hversion.el hyperbole.el man/hyperbole.texi
man/version.texi | wc -c) || exit 1
@ echo ""
# Build the Info, HTML and Postscript versions of the user manual and
README.md.html.
@@ -462,8 +462,8 @@ test-all:
@echo "# Tests: $(TEST_ERT_FILES)"
ifeq ($(TERM), dumb)
ifneq (,$(findstring .apple.,$(DISPLAY)))
- # Found, on MacOS, use graphical UI MacOS 'Emacs' script
- TERM=xterm-256color EMACS=Emacs $(EMACS) --quick $(PRELOADS) --eval
"(load-file \"test/hy-test-dependencies.el\")" --eval "(let
((auto-save-default)) $(LOAD_TEST_ERT_FILES) (ert-run-tests-interactively t))"
+ # Found, on MacOS
+ TERM=xterm-256color $(EMACS) --quick $(PRELOADS) --eval "(load-file
\"test/hy-test-dependencies.el\")" --eval "(let ((auto-save-default))
$(LOAD_TEST_ERT_FILES) (ert-run-tests-interactively t))"
else
# Not found, set TERM so tests will at least run within parent Emacs
session
TERM=vt100 $(EMACS) --quick $(PRELOADS) --eval "(load-file
\"test/hy-test-dependencies.el\")" --eval "(let ((auto-save-default))
$(LOAD_TEST_ERT_FILES) (ert-run-tests-interactively t))"
diff --git a/hact.el b/hact.el
index 5e0c596344..aa2c8ca1e0 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: 30-Jan-22 at 03:07:43 by Bob Weiner
+;; Last-Mod: 30-May-22 at 13:55:46 by Bob Weiner
;;
;; Copyright (C) 1991-2021 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -301,58 +301,19 @@ When optional SYM is given, returns the name for that
symbol only, if any."
"Return Hyperbole action that execute a keyboard MACRO REPEAT-COUNT times."
(list 'execute-kbd-macro macro repeat-count))
-;; This function is based on Emacs `help-function-arglist'.
(defun action:params-emacs (def)
"Return the argument list for the function DEF which may be a symbol or a
function body."
- ;; Handle symbols aliased to other symbols.
- (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def)))
- ;; If definition is a macro, find the function inside it.
- (if (eq (car-safe def) 'macro) (setq def (cdr def)))
- (cond
- ((and (byte-code-function-p def) (listp (aref def 0))) (aref def 0))
- ((eq (car-safe def) 'lambda) (nth 1 def))
- ((eq (car-safe def) 'closure) (nth 2 def))
- ((or (and (byte-code-function-p def) (integerp (aref def 0)))
- (subrp def))
- (or (let* ((doc (condition-case nil (documentation def) (error nil)))
- (docargs (if doc (car (help-split-fundoc doc nil))))
- (arglist (if docargs
- (cdar (read-from-string (downcase docargs)))))
- (valid t))
- ;; Check validity.
- (dolist (arg arglist)
- (unless (and (symbolp arg)
- (let ((name (symbol-name arg)))
- (if (eq (aref name 0) ?&)
- (memq arg '(&rest &optional))
- (not (string-match "\\." name)))))
- (setq valid nil)))
- (when valid arglist))
- (let* ((args-desc (if (not (subrp def))
- (aref def 0)
- (let ((a (subr-arity def)))
- (logior (car a)
- (if (numberp (cdr a))
- (lsh (cdr a) 8)
- (lsh 1 7))))))
- (max (lsh args-desc -8))
- (min (logand args-desc 127))
- (rest (logand args-desc 128))
- (arglist ()))
- (dotimes (i min)
- (push (intern (concat "arg" (number-to-string (1+ i)))) arglist))
- (when (> max min)
- (push '&optional arglist)
- (dotimes (i (- max min))
- (push (intern (concat "arg" (number-to-string (+ 1 i min))))
- arglist)))
- (unless (zerop rest) (push '&rest arglist) (push 'rest arglist))
- (nreverse arglist))))
- ((and (autoloadp def) (not (eq (nth 4 def) 'keymap)))
- ;; Force autoload to get function signature.
- (setq def (autoload-do-load def))
- (unless (autoloadp def)
- (action:params-emacs def)))))
+ (let ((params (help-function-arglist def t)))
+ (cond ((listp params) ;; includes nil
+ params)
+ ((stringp params)
+ (when (and (autoloadp def) (not (eq (nth 4 def) 'keymap)))
+ ;; Force autoload to get function signature.
+ (setq def (autoload-do-load def))
+ (unless (autoloadp def)
+ (action:params-emacs def))))
+ (t
+ (error "(action:params-emacs): Construct not supported: %s" def)))))
(defun action:params (action)
"Return unmodified ACTION parameter list.
@@ -360,6 +321,8 @@ Autoloads action function if need be to get the parameter
list."
(when (and (symbolp action) (fboundp action))
(setq action (hypb:indirect-function action)))
(cond ((null action) nil)
+ ((fboundp 'help-function-arglist)
+ (help-function-arglist action t))
((listp action)
(cond ((eq (car action) 'closure)
(nth 2 action))
@@ -451,6 +414,7 @@ performing ACTION."
(run-hooks 'action-act-hook)
(prog1 (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))))
(apply action args)
diff --git a/hactypes.el b/hactypes.el
index 3413b32b4e..097f0e8119 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: 22-May-22 at 12:52:36 by Bob Weiner
+;; Last-Mod: 28-May-22 at 10:23:19 by Bob Weiner
;;
;; Copyright (C) 1991-2022 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -628,7 +628,7 @@ FILE may be a string or nil, in which case the current
buffer is used."
(setq node (replace-regexp-in-string "[ \t\n\r\f]+" " " node t t)))
(let (node-point)
(if file
- (set-buffer (find-find-noselect (hpath:substitute-value file)))
+ (set-buffer (find-file-noselect (hpath:substitute-value file)))
(setq file buffer-file-name))
(save-excursion
(goto-char (point-min))
diff --git a/hargs.el b/hargs.el
index 6ce9d9e01c..ba35ebd507 100644
--- a/hargs.el
+++ b/hargs.el
@@ -56,7 +56,7 @@ Current button is being edited when EDITING-FLAG is t.
Return nil if ACTION is not a list or `byte-code' object, has no
interactive form or takes no arguments."
(save-excursion
- (and (or (hypb:emacs-byte-code-p action) (listp action))
+ (and (or (subrp action) (hypb:emacs-byte-code-p action) (listp action))
(let ((interactive-form (action:commandp action)))
(when interactive-form
(hpath:relative-arguments
diff --git a/hload-path.el b/hload-path.el
index 29481985bd..960e636bf0 100644
--- a/hload-path.el
+++ b/hload-path.el
@@ -1,9 +1,9 @@
-;;; hload-path.el --- GNU Hyperbole load-path setup -*- lexical-binding: t;
-*-
+;;; hload-path.el --- GNU Hyperbole load-path and autoload early
initializations -*- lexical-binding: t; -*-
;;
;; Author: Bob Weiner
;;
;; Orig-Date: 29-Jun-16 at 14:39:33
-;; Last-Mod: 11-May-22 at 00:12:11 by Bob Weiner
+;; Last-Mod: 1-Jun-22 at 23:20:50 by Bob Weiner
;;
;; Copyright (C) 1992-2021 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
diff --git a/hui-mouse.el b/hui-mouse.el
index f8be5b08b6..08eb283187 100644
--- a/hui-mouse.el
+++ b/hui-mouse.el
@@ -39,13 +39,12 @@
;;; ************************************************************************
(require 'hload-path)
-(eval-when-compile (require 'hsys-org))
+(require 'hsys-org)
(require 'hbut)
(unless (fboundp 'smart-info)
(require 'hmouse-info))
(unless (fboundp 'smart-c-at-tag-p)
(require 'hmouse-tag))
-(require 'hsys-org)
(eval-when-compile (require 'tar-mode))
diff --git a/hypb.el b/hypb.el
index 73c8ac3ef7..7b36ad5cfb 100644
--- a/hypb.el
+++ b/hypb.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 6-Oct-91 at 03:42:38
-;; Last-Mod: 12-May-22 at 00:03:09 by Bob Weiner
+;; Last-Mod: 4-Jun-22 at 01:29:24 by Bob Weiner
;;
;; Copyright (C) 1991-2022 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -223,7 +223,8 @@ If no matching installation type is found, return a list of
(\"unknown\" hyperb:
(or (featurep 'hinit) (load "hyperbole"))
(or (and (featurep 'hbut)
(let ((func (hypb:indirect-function 'ebut:create)))
- (not (or (hypb:emacs-byte-code-p func)
+ (not (or (subrp func)
+ (hypb:emacs-byte-code-p func)
(eq 'byte-code
(car (car (nthcdr 3 (hypb:indirect-function
'ebut:create)))))))))
@@ -301,6 +302,7 @@ If no matching installation type is found, return a list of
(\"unknown\" hyperb:
dname))))
(concat "@" dname))))
+;;;###autoload
(defun hypb:emacs-byte-code-p (obj)
"Return non-nil iff OBJ is an Emacs byte compiled object."
(or (and (fboundp 'byte-code-function-p) (byte-code-function-p obj))
@@ -871,7 +873,11 @@ If FILE is not an absolute path, expand it relative to
`hyperb:dir'."
(skip-syntax-forward "-")
(set-window-start (selected-window) 1)
(set-buffer-modified-p nil)
- (help-mode))))
+ (help-mode)
+ ;; On some versions of Emacs like Emacs28, need a slight delay
+ ;; for file loading before searches will work properly.
+ ;; Otherwise, "test/demo-tests.el" may fail.
+ (sit-for 0.05))))
(defun hypb:browse-home-page ()
"Visit the web home page for Hyperbole."
diff --git a/test/hpath-tests.el b/test/hpath-tests.el
index 95990011b0..9124eba350 100644
--- a/test/hpath-tests.el
+++ b/test/hpath-tests.el
@@ -23,26 +23,28 @@
(declare-function hy-test-helpers:action-key-should-call-hpath:find
"hy-test-helpers")
(defconst hpath--should-exist-paths
- '("hypb.el"
- "kotl/kview.el"
- "${hyperb:dir}"
- "${hyperb:dir}/hypb.el"
- "${hyperb:dir}/kotl/kview.el"
- "kview.el"
- "${load-path}/kview.el"
- "${load-path}/kotl/kview.el"
- "${hyperb:dir}/./hypb.el"
- "${hyperb:dir}/../hyperbole/hypb.el"
- "./hypb.el"
- "../hyperbole/hypb.el"
- "../hyperbole/./hypb.el"
- "~"
- "~/."
- "${load-path}/../hyperbole/${DOT}/hypb.el"
- "${load-path}/../hyperbole/$DOT/hypb.el"
- "$DOT"
- "${DOT}"
- )
+ (let ((hyperb-dir-basename (file-name-nondirectory (directory-file-name
hyperb:dir))))
+ (list
+ "hypb.el"
+ "kotl/kview.el"
+ "${hyperb:dir}"
+ "${hyperb:dir}/hypb.el"
+ "${hyperb:dir}/kotl/kview.el"
+ "kview.el"
+ "${load-path}/kview.el"
+ "${load-path}/kotl/kview.el"
+ "${hyperb:dir}/./hypb.el"
+ (format "${hyperb:dir}/../%s/hypb.el" hyperb-dir-basename)
+ "./hypb.el"
+ (format "../%s/hypb.el" hyperb-dir-basename)
+ (format "../%s/./hypb.el" hyperb-dir-basename)
+ "~"
+ "~/."
+ (format "${load-path}/../%s/${DOT}/hypb.el" hyperb-dir-basename)
+ (format "${load-path}/../%s/$DOT/hypb.el" hyperb-dir-basename)
+ "$DOT"
+ "${DOT}"
+ ))
"List of paths to test that should exist when expanded in ${hyperb:dir}.")
(defconst hpath--should-not-exist-paths
@@ -91,14 +93,14 @@
(setenv "DOT" ".")
(let ((failures (delq t (mapcar #'hpath--should-exist-p
hpath--should-exist-paths))))
(if failures
- (ert-fail (cons "These (original-path expanded-path) entries failed to
exist when expanded:" failures))
+ (ert-fail (cons "These (original-path expanded-path) entries failed to
exist when expanded with hpath:expand:" failures))
t)))
(ert-deftest hpath:should-not-exist-paths ()
"Expand paths in `hpath--should-not-exist-paths' and trigger an error on the
first one that exists."
(let ((failures (delq t (mapcar #'hpath--should-not-exist-p
hpath--should-not-exist-paths))))
(if failures
- (ert-fail (cons "These (original-path expanded-path) entries
improperly existed when expanded:" failures))
+ (ert-fail (cons "These (original-path expanded-path) entries
improperly existed when expanded with hpath:expand:" failures))
t)))
(ert-deftest hpath:find-report-lisp-variable-path-name-when-not-exists ()
