[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/hyperbole c5b0ffe 1/3: Large set of RSW updates across
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/hyperbole c5b0ffe 1/3: Large set of RSW updates across last three weekends |
|
Date: |
Sun, 7 Nov 2021 23:57:31 -0500 (EST) |
branch: externals/hyperbole
commit c5b0ffe2c8e073f2337d8336789d243d7194b156
Author: Bob Weiner <rsw@gnu.org>
Commit: Bob Weiner <rsw@gnu.org>
Large set of RSW updates across last three weekends
---
ChangeLog | 95 +++++++++++++++++++++-
DEMO | 13 ++--
HY-NEWS | 105 +++++++++++++------------
hact.el | 3 +-
hactypes.el | 59 ++++++++------
hbdata.el | 113 +++++++++++++++------------
hbut.el | 153 ++++++++++++++++++++++++------------
hmouse-drv.el | 109 +++++++++++++-------------
hpath.el | 3 +-
hui-mini.el | 20 ++---
hui-mouse.el | 6 +-
hui-select.el | 8 +-
hui-window.el | 75 +++++++++---------
hui.el | 199 ++++++++++++++++++++++++-----------------------
hyperbole.el | 198 ++++++++++------------------------------------
hyrolo-logic.el | 3 +-
kotl/kexport.el | 7 +-
kotl/kotl-mode.el | 8 +-
man/hyperbole.html | 18 ++---
man/hyperbole.info | Bin 554573 -> 554577 bytes
man/hyperbole.pdf | Bin 1309014 -> 1309176 bytes
man/hyperbole.texi | 16 ++--
man/version.texi | 4 +-
test/hbut-tests.el | 8 +-
test/hmouse-drv-tests.el | 4 +-
25 files changed, 641 insertions(+), 586 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index b1dee73..95ee23a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,4 +1,97 @@
-<<<<<<< HEAD
+2021-11-07 Bob Weiner <rsw@gnu.org>
+
+* hui-mini.el (hyperbole-set-key): Rename parameters.
+
+* man/hyperbole.texi (Default Hyperbole Bindings):
+ DEMO:
+ hyperbole.el (hkey-bindings, hkey-bindings-flag,
+ hmouse-toggle-bindings, hkey-bindings, hkey-bindings-flag,
+ hkey-previous-bindings, hkey-set-bindings, hkey-bindings-keys,
+ hkey-binding-entry): Remove since hyperbole-mode handles all of this now
+ and regular key bindings can be used, enabled and disabled.
+ (hkey-get-bindings, hkey-global-set-key, hkey-maybe-global-set-key):
+ Rewrote to use hyperbole-mode-map.
+ (hkey-global-set-key): Replace all usage with hkey-set-key and make
obsolete.
+ hui-select.el (hui-select-initialize):
+ (hkey-maybe-global-set-key): Replace all usage with hkey-maybe-set-key
+ and make obsolete.
+ (hkey-maybe-set-key): Rewrote to check for prior key bindings only in
+ hyperbole-mode-map.
+
+* test/hbut-tests.el (ebut-delete-removes-ebut-and-returns-button-data):
+ hui.el (hui:hbut-delete, hui:ebut-delete-op): Fix to match doc and return
+ t when successful. Simplify test function. Use button at point if
+ but-key is not given. Also set key-src if null.
+* hui-mouse.el (hkey-alist): Fix so smart-org call when used as a predicate
+ has no side-effects and move actions to proper part of the alist.
+
+* hbut.el (ibut:at-p): Trigger error if any ibtype predicate moves point.
+ hmouse-drv.el (hkey-execute): Trigger error if any predicate moves point
+ (only actions should).
+ (ibut:to): Optimized, reducing expensive ibut:at-p calls.
+ (ibut:to-text): Optimized, reducing movement and handling all cases.
+
+* hbut.el (ibut:at-p, ibut:to-text): Fix to leave point at the start of ibut
text,
+ only skipping past an optional name, if any, not skipping past the text
itself.
+ (hbut:act): Use with-current-buffer instead of set-buffer to move
+ point so current-buffer setting does not leak outside this function. Also
+ reset original point in any active window displaying the original buffer
+ to ensure point does not move if the action took place in another buffer.
+
+* hui-window.el (hmouse-x-coord, hmouse-y-coord): Pass 'args' lexically rather
+ than dynamically, thereby, fixing action key error of unbound argument
+
+2021-10-31 Bob Weiner <rsw@gnu.org>
+
+* hactypes.el (link-to-ibut): Remove requirement that implicit button linked to
+ be in a buffer with a file attached. Also, trigger error if `key' arg is
null.
+
+* hbut.el (ebut:modify): Add save-restriction and removed doc string saying
+ caller should use save-excursion since this function handles that.
+ (ebut:operate): Add save-restriction around ebut:modify and
ebut:create
+ calls.
+
+2021-10-24 Bob Weiner <rsw@gnu.org>
+
+* hmouse-drv.el (mouse-drag-mode-line): Remove XEmacs 'mouse-drag-frame-move'
+ reference.
+ (hmouse-save-region): Remove unused optional 'frame' arg.
+
+* hbut.el (ibut:to): Fix to handle ibuts with text-only, no separate name
+ by using ibut:-at-p instead of ibut:label-p.
+ (ibut:to-text): Prevent error when lbl-key-end is not found and
+ find double-quoted ibuts with no optional label.
+ (ibut:at-p): Fix handling of double-quoted implicit buttons without
+ any separate name/label.
+ (hbut:at-p): Display button properties when called interactively.
+ (ebut:label-p): Fix handling of start pos if delims are double
quotes.
+
+* hpath.el (hpath:relative-arguments): Leave strings that match buffer names
+ unchanged, e.g. link-to-ibut may have a key-src arg that is a buffer name.
+
+* hbut.el (hbut:key-src-set-buffer):
+ hactypes.el (link-to-ibut): Generalize 'key-src' parameter to 'but-src' so
+ handles buffers as well as files.
+
+* hbdata.el (hbdata:apply-entry): Added save-restriction in case in hbdata
+ is stored in a displayable buffer, e.g. *scratch*, which may have a prior
+ visible restriction. Also, added support for such non-mail/news buffers.
+
+* hui.el (hui:link-possible-types): Fix link-to-ibut use to include ibut's
+ filename or buffer name.
+
+2021-10-21 Bob Weiner <rsw@gnu.org>
+
+* kotl/kotl-mode.el (kotl-mode:copy-to-buffer, kotl-mode:mail-tree): Change
+ passing of free variable, label-default, to lexically scoped, fixing
+ new bug when using kotl-mode:mail-tree.
+
+2021-10-18 Bob Weiner <rsw@gnu.org>
+
+* kotl/kexport.el (kexport:html): Remove any extra newline added at the end of
some
+ cells after kexport:html-markup is called. This fixes a bug where HTMLized
+ cells are separated by 2 newlines.
+
2021-10-17 Bob Weiner <rsw@gnu.org>
* hpath.el (hpath:symlink-referent): Fix handling of relative symlinks, adding
diff --git a/DEMO b/DEMO
index 7357b45..ba754ab 100644
--- a/DEMO
+++ b/DEMO
@@ -1353,17 +1353,14 @@ See the Hyperbole menu item, Doc/SmartKeys {C-h h d s},
for a summary of
all Smart Key operations. For extensive details on Smart Key operation,
see the Hyperbole manual section, "(hyperbole)Smart Key Reference".
-If you ever want to restore the mouse bindings that existed before Hyperbole
-was loaded, use the `hmouse-toggle-bindings' command. It switches between
-the Hyperbole mouse key bindings and those set prior to loading Hyperbole
-and then back again if invoked once more. There is no default key binding
-for this command, so you must use `M-x hmouse-toggle-bindings RET'.
-Alternatively, you may select a key and bind it as part of any setting of
-`hyperbole-init-hook' within your personal .emacs file.
+If you ever want to disable Hyperbole key and mouse bindings, simply toggle
+Hyperbole minor mode off with {M-x hyperbole-mode RET}. Alternatively, you may
+select a key and bind it as part of any setting of `hyperbole-init-hook'
+within your personal .emacs file.
For example:
(add-hook 'hyperbole-init-hook
- (lambda () (global-set-key <YOUR-KEY-HERE> #'hmouse-toggle-bindings)))
+ (lambda () (global-set-key <YOUR-KEY-HERE> 'hyperbole-mode)))
** Thing Selection
diff --git a/HY-NEWS b/HY-NEWS
index 66ac216..2e3c842 100644
--- a/HY-NEWS
+++ b/HY-NEWS
@@ -20,6 +20,7 @@
- M-RET: Reworked M-RET interface so can control how much or little of
Hyperbole works in Org mode when Hyperbole minor mode is enabled.
+ See "(hyperbole)enable org-mode support".
- hsys-org-enable-smart-keys: New customization to replace
'inhibit-hsys-org'. This applies only in Org major/minor modes when
@@ -37,6 +38,53 @@
| t | Activate | Activate | Activate | None
|
|--------------+-------------------+------------------+----------+------------------|
+ SIMPLE BUTTON TYPE CREATION
+
+ - Simple Action Link Button Type Creation: `defal' is a new,
+ easy-to-use construct that generates new action button types from
+ a type name and a single simple format expression, allowing
+ non-programmers to create their own implicit action button link
+ types that execute key series, display URLs, display the contents
+ of pathnames or invoke functions. See "(hyperbole)Action Button
+ Link Types" or the "DEMO#Defining New Action Button Types"
+ section.
+
+ - Easy Implicit Link Button Type Creation: `defil' is a new,
+ construct for those familiar with regular expressions but not
+ much Emacs Lisp. This macro creates more flexible implicit
+ button types than `defal' where the delimiters and text
+ substitution can be specified with regular expressions. Actions
+ are limited to executing key series, displaying URLs, displaying
+ the contents of pathnames or invoking functions. See
+ "(hyperbole)Implicit Button Link Types".
+
+ Elisp programmers should use the existing `defib' macro for full
+ flexibility in implicit button type creation. See "hibytpes.el"
+ for examples and "(hyperbole)Programmatic Implicit Button Types"
+ for documentation.
+
+ TEST CASES
+
+ - Hyperbole Automated Testing: Hyperbole now includes over 170 test cases
+ in the test/ subdirectory. Simply run 'make test' or 'make test-all'
+ from the command-line when in the Hyperbole source directory and you
+ should see all tests pass. If any fail, you can press the Action Key
+ to see the source of the failure.
+
+ - Defal implicit buttons hypb-ert-sym and hypb-ert-sel: For running
+ hyperbole ert test from hyperbole source files.
+ Defines an implicit button for running an ert test
+
+ Example:
+ Run the test hbut-defal-url
+ <hypb-ert-sym hbut-defal-url>
+
+ Run the tests specified by the test selector hbut-defal
+ <hypb-ert-sel hbut-defal>
+
+ Run all tests
+ <hypb-ert-sel t>
+
HYROLO
- Faster searching within HyRolo match buffer: After performing a HyRolo
@@ -56,7 +104,9 @@
- Org Table Support: Org table editing now automatically works in the
Koutliner via Org table minor mode. Use {M-x orgtbl-mode RET} to
- toggle this on and off. See "(Org)Tables" for details.
+ toggle this on and off. A press of the Action Key on a | symbol
+ separating fields, also toggles this minor mode on or off. See
+ "(Org)Tables" for details.
- New Mail Tree Key Binding: The kotl-mode:mail-tree command that
extracts the current view of a Koutline in text-only format and
@@ -122,38 +172,15 @@
PROGRAMMING
- - Simple Action Link Button Type Creation: `defal' is a new,
- easy-to-use construct that generates new action button types from
- a type name and a single simple format expression, allowing
- non-programmers to create their own implicit action button link
- types that execute key series, display URLs, display the contents
- of pathnames or invoke functions. See "(hyperbole)Action Button
- Link Types" or the "DEMO#Defining New Action Button Types"
- section.
-
- - Easy Implicit Link Button Type Creation: `defil' is a new,
- construct for those familiar with regular expressions but not
- much Emacs Lisp. This macro creates more flexible implicit
- button types than `defal' where the delimiters and text
- substitution can be specified with regular expressions. Actions
- are limited to executing key series, displaying URLs, displaying
- the contents of pathnames or invoking functions. See
- "(hyperbole)Implicit Button Link Types".
-
- Elisp programmers should use the existing `defib' macro for full
- flexibility in implicit button type creation. See "hibytpes.el"
- for examples and "(hyperbole)Programmatic Implicit Button Types"
- for documentation.
-
- Edebuggable Hyperbole Types: `defib' and `defact' type definitions
are now interactively debuggable via edebug-defun {C-M-x}.
- - kbd-key:is-p: Added this new predicate to test whether point is within
- a brace-delimited key series.
-
- ebut:program: Programmatically create an explicit Hyperbole button at
point from LABEL, ACTYPE (action type), and optional actype ARGS.
+ - kbd-key:is-p: Added this new predicate to test whether point is within
+ a brace-delimited key series.
+
ACE WINDOW PACKAGE INTEGRATION - fast window and buffer switching
- After installing the ace-window package and loading Hyperbole, execute
@@ -165,30 +192,6 @@
See "DEMO#Displaying File and Buffer Items and Moving Buffers".
- TEST CASES
-
- - Hyperbole Automated Testing: Hyperbole now includes over 170 test cases
- in the test/ subdirectory. Simply run 'make test' or 'make test-all'
- from the command-line when in the Hyperbole source directory and you
- should see all tests pass. If any fail, you can press the Action Key
- to see the source of the failure.
-
- - Defal implicit buttons hypb-ert-sym and hypb-ert-sel: For running
- hyperbole ert test from hyperbole source files.
- Defines an implicit button for running an ert test
-
- Example:
- Run the test hbut-defal-url
- <hypb-ert-sym hbut-defal-url>
-
- Run the tests specified by the test selector hbut-defal
- <hypb-ert-sel hbut-defal>
-
- Run all tests
- <hypb-ert-sel t>
-
-
-
===========================================================================
* V7.1.3
===========================================================================
diff --git a/hact.el b/hact.el
index fa704a2..a87dbfa 100644
--- a/hact.el
+++ b/hact.el
@@ -406,7 +406,8 @@ performing ACTION."
;; string arguments like "tags" as a pathname, when it is not
;; being used as a path. So do this only if actype is a defact
;; and not a defun to limit any potential impact. RSW - 9/22/2017
- (and (symbolp action) (symtable:actype-p action)
+ (and (symbolp action)
+ (symtable:actype-p action)
(setq args (hpath:absolute-arguments args)))
(let ((hist-elt (hhist:element)))
(run-hooks 'action-act-hook)
diff --git a/hactypes.el b/hactypes.el
index b769af5..33fe8cc 100644
--- a/hactypes.el
+++ b/hactypes.el
@@ -472,44 +472,53 @@ available. Filename may be given without the .info
suffix."
(id-info string)
(hypb:error "(link-to-Info-node): Invalid Info node: `%s'" string)))
-(defact link-to-ibut (key &optional key-file point)
- "Perform an action given by an implicit button, specified by KEY, optional
KEY-FILE and POINT.
-KEY-FILE defaults to the current buffer's file and POINT to the current point.
-
-When creating the button, point must be on the implicit button to which to link
-and its buffer must have a file attached."
+(defact link-to-ibut (key &optional but-src point)
+ "Perform an action given by an implicit button, specified by KEY, optional
BUT-SRC and POINT.
+BUT-SRC defaults to the current buffer's file or if there is no
+attached file, then to its buffer name. POINT defaults to the
+current point.
+
+When the button with this action type is created, point must be
+on the implicit button to which to link."
(interactive
(let ((ibut-key (ibut:at-p t)))
- (if (and ibut-key buffer-file-name)
- (list ibut-key buffer-file-name (point))
- ;; TODO: If default is null below and are creating, rather than
modifying,
- ;; the link, it would be better to throw an error than create
- ;; an invalid link, but it is difficult to tell which operation
- ;; is in progress, so ignore this for now. -- RSW, 01-25-2020
-
- ;; When not on an ibut and modifying the link, use existing arguments
- (if (and (bound-and-true-p defaults) (listp defaults))
- defaults
- (list nil nil nil)))))
+ (cond (ibut-key
+ (list ibut-key (or buffer-file-name (buffer-name)) (point)))
+ ;; TODO: If default is null below and are creating, rather than
modifying,
+ ;; the link, it would be better to throw an error than create
+ ;; an invalid link, but it is difficult to tell which operation
+ ;; is in progress, so ignore this for now. -- RSW, 01-25-2020
+
+ ;; When not on an ibut and modifying the link, use existing arguments
+ ((and (bound-and-true-p defaults) (listp defaults) defaults)
+ defaults)
+ (t
+ (hypb:error "(link-to-ibut): Point must be on an implicit button to
create a link-to-ibut")))))
+ (when (null key)
+ (hypb:error "(link-to-ibut): Point must be on an implicit button to create
a link-to-ibut"))
(let (but
normalized-file)
- (if key-file
- (unless (called-interactively-p 'interactive)
- (setq normalized-file (hpath:normalize key-file)))
- (setq normalized-file buffer-file-name))
+ (cond (but-src
+ (unless (and (get-buffer but-src)
+ (not (buffer-file-name (get-buffer but-src))))
+ (setq normalized-file (hpath:normalize but-src))))
+ (t (setq normalized-file buffer-file-name)))
(save-excursion
(save-restriction
- (when key-file
- (set-buffer (get-file-buffer normalized-file)))
+ (when but-src
+ (set-buffer (or (get-buffer but-src) (get-file-buffer
normalized-file))))
(widen)
- (if (integerp point) (goto-char (min point (point-max))))
+ (when (or (not normalized-file) (hmail:editor-p) (hmail:reader-p))
+ (hmail:msg-narrow))
+ (when (integerp point)
+ (goto-char (min point (point-max))))
(setq but (ibut:to key))))
(cond (but
(hbut:act but))
(key
(hypb:error "(link-to-ibut): No implicit button `%s' found in `%s'"
(ibut:key-to-label key)
- (or key-file (buffer-name))))
+ (or but-src (buffer-name))))
(t
(hypb:error "(link-to-ibut): Link reference is null/empty")))))
diff --git a/hbdata.el b/hbdata.el
index aa7a857..5725911 100644
--- a/hbdata.el
+++ b/hbdata.el
@@ -173,10 +173,11 @@ Nil BUT-SYM means use 'hbut:current'. If successful,
return a cons of
(when (setq lbl-instance (hbdata:instance-last new-key loc dir))
(setq lbl-instance (concat ebut:instance-sep
(int-to-string (1+ lbl-instance))))
- ;; This line is needed to ensure that the highest
+ ;; This expression is needed to ensure that the highest
;; numbered instance of a label appears before
;; other instances, so 'hbdata:instance-last' will work.
- (if (hbdata:to-entry-buf loc dir) (forward-line 1))))
+ (when (hbdata:to-entry-buf loc dir)
+ (forward-line 1))))
(let ((inst-num (hbdata:instance-last new-key loc dir)))
(setq lbl-instance (if inst-num
(hbdata:instance-next
@@ -304,59 +305,70 @@ but-key."
;;; Private functions
;;; ************************************************************************
-(defun hbdata:apply-entry (function lbl-key key-src &optional directory
+(defun hbdata:apply-entry (func lbl-key key-src &optional directory
create-flag instance-flag)
- "Invoke FUNCTION with point at hbdata entry given by LBL-KEY, KEY-SRC,
optional DIRECTORY.
+ "Invoke FUNC with point at hbdata entry given by LBL-KEY, KEY-SRC, optional
DIRECTORY.
With optional CREATE-FLAG, if no such line exists, insert a new file entry at
the
beginning of the hbdata file (which is created if necessary).
INSTANCE-FLAG non-nil means search for any button instance matching LBL-KEY and
-call FUNCTION with point right after any 'ebut:instance-sep' in match.
+call FUNC with point right after any 'ebut:instance-sep' in match.
Return value of evaluation when a matching entry is found or nil."
(let (found
rtn
opoint
end-func)
(save-excursion
- (unwind-protect
- (progn
- (when (bufferp key-src)
- (set-buffer key-src)
- (cond ((hmail:editor-p)
- (setq end-func (lambda ()
- (hmail:msg-narrow))))
- ((and (hmail:lister-p)
- (progn (rmail:summ-msg-to) (rmail:to)))
- (setq opoint (point)
- key-src (current-buffer)
- end-func (lambda ()
- (hmail:msg-narrow)
- (goto-char opoint)
- (lmail:to))))
- ((and (hnews:lister-p)
- (progn (rnews:summ-msg-to) (rnews:to)))
- (setq opoint (point)
- key-src (current-buffer)
- end-func (lambda ()
- (hmail:msg-narrow)
- (goto-char opoint)
- (lnews:to))))))
- (setq found (hbdata:to-entry-buf key-src directory create-flag)))
- (when found
- (let ((case-fold-search t)
- (qkey (regexp-quote lbl-key))
- (end (save-excursion (if (search-forward "\n\^L" nil t)
- (point) (point-max)))))
- (if (if instance-flag
- (re-search-forward
- (concat "\n(\"" qkey "["
- ebut:instance-sep "\"]") end t)
- (search-forward (concat "\n(\"" lbl-key "\"") end t))
- (progn
- (unless instance-flag
- (beginning-of-line))
- (let (buffer-read-only)
- (setq rtn (funcall function)))))))
- (when end-func (funcall end-func))))
+ (save-restriction
+ (unwind-protect
+ (progn
+ (when (get-buffer key-src)
+ (set-buffer key-src)
+ (unless buffer-file-name
+ (cond ((hmail:editor-p)
+ (setq end-func (lambda ()
+ (hmail:msg-narrow))))
+ ((and (hmail:lister-p)
+ (progn (rmail:summ-msg-to) (rmail:to)))
+ (setq opoint (point)
+ key-src (current-buffer)
+ end-func (lambda ()
+ (hmail:msg-narrow)
+ (goto-char opoint)
+ (lmail:to))))
+ ((and (hnews:lister-p)
+ (progn (rnews:summ-msg-to) (rnews:to)))
+ (setq opoint (point)
+ key-src (current-buffer)
+ end-func (lambda ()
+ (hmail:msg-narrow)
+ (goto-char opoint)
+ (lnews:to))))
+ ;; Any non-file buffer
+ (t
+ (setq opoint (point)
+ key-src (current-buffer)
+ end-func (lambda ()
+ (widen)
+ (goto-char opoint)
+ (narrow-to-region (point-min)
+
(hmail:hbdata-start))))))))
+ (setq found (hbdata:to-entry-buf key-src directory create-flag)))
+ (when found
+ (let ((case-fold-search t)
+ (qkey (regexp-quote lbl-key))
+ (end (save-excursion (if (search-forward "\n\^L" nil t)
+ (point) (point-max)))))
+ (if (if instance-flag
+ (re-search-forward
+ (concat "\n(\"" qkey "["
+ ebut:instance-sep "\"]") end t)
+ (search-forward (concat "\n(\"" lbl-key "\"") end t))
+ (progn
+ (unless instance-flag
+ (beginning-of-line))
+ (let (buffer-read-only)
+ (setq rtn (funcall func)))))))
+ (when end-func (funcall end-func)))))
rtn))
(defun hbdata:to-hbdata-buffer (dir &optional create)
@@ -392,12 +404,13 @@ With optional CREATE, if no such line exists, insert a
new file entry at the
beginning of the hbdata file (which is created if necessary).
Return non-nil if KEY-SRC is found or created, else nil."
(let ((rtn) (ln-dir))
- (if (bufferp key-src)
+ (if (and (get-buffer key-src)
+ (setq rtn (set-buffer key-src))
+ (not buffer-file-name))
;; Button buffer has no file attached
- (progn (setq rtn (set-buffer key-src)
- buffer-read-only nil)
- (if (not (hmail:hbdata-to-p))
- (insert "\n" hmail:hbdata-sep "\n"))
+ (progn (setq buffer-read-only nil)
+ (unless (hmail:hbdata-to-p)
+ (insert "\n" hmail:hbdata-sep "\n"))
(backward-char 1))
(setq directory (or (file-name-directory key-src) directory))
(let ((ln-file) (link-p key-src))
diff --git a/hbut.el b/hbut.el
index 6729b91..a03d9e1 100644
--- a/hbut.el
+++ b/hbut.el
@@ -183,13 +183,13 @@ Return nil if no matching button is found."
This is the normalized key form of the explicit button's label.
Assume point is within the first line of any button label. All
-following arguments are optional. If AS-LABEL is non-nil, label
-is returned rather than the key derived from the label.
-START-DELIM and END-DELIM are strings that override default
-button delimiters. With POS-FLAG non-nil, returns list of
-label-or-key, but-start-position, but-end-position. Positions
-include delimiters. With TWO-LINES-FLAG non-nil, constrains
-label search to two lines."
+following arguments are optional. If AS-LABEL is non-nil, return
+label rather than the key derived from the label. START-DELIM
+and END-DELIM are strings that override default button
+delimiters. With POS-FLAG non-nil, return the list of label-or-key,
+but-start-position, but-end-position. Positions include
+delimiters. With TWO-LINES-FLAG non-nil, constrain label search
+to two lines."
(let ((opoint (point))
(quoted "\\(^\\|[^\\{]\\)")
(hbut:max-len hbut:max-len)
@@ -219,8 +219,8 @@ label search to two lines."
(forward-char -1)
(forward-list)
(forward-char -2))
- (error (goto-char (1- opoint))))
- (goto-char (1- opoint)))
+ (error (goto-char (max (1- opoint) start))))
+ (goto-char (max (1- opoint) start)))
(when two-lines-flag
(save-excursion
(forward-line 2)
@@ -279,8 +279,7 @@ If successful, return button's instance number, except when
instance
number is 1, then return t. On failure, as when button does not exist,
return nil.
-If successful, leave point in button data buffer, so caller should use
-`save-excursion'. Do not save button data buffer."
+Do not save button data buffer."
(save-excursion
(let ((lbl-instance (hbdata:write lbl-key but-sym)))
(run-hooks 'ebut-modify-hook)
@@ -858,11 +857,16 @@ Default is 'hbut:current."
(prog1 (apply hrule:action
(hattr:get hbut 'actype)
(hattr:get hbut 'args))
- ;; Restore original point prior to ibut:to-text call if action
switched buffers or did not move point within the current buffer
+ ;; Restore point as it was prior to ibut:to-text call if the action
+ ;; switched buffers or did not move point within the
+ ;; current buffer.
(when (or (equal text-point (point-marker))
(not (eq (current-buffer) (marker-buffer orig-point))))
- (set-buffer (marker-buffer orig-point))
- (goto-char orig-point))
+ (with-current-buffer (marker-buffer orig-point)
+ (let ((owind (get-buffer-window nil t)))
+ (if owind
+ (set-window-point owind orig-point)
+ (goto-char orig-point)))))
(set-marker orig-point nil)
(set-marker text-point nil))))
((and hbut (symbolp hbut))
@@ -885,8 +889,15 @@ Default is 'hbut:current."
(defun hbut:at-p ()
"Return symbol for explicit or implicit Hyperbole button at point or nil.
Then use (hbut:act) to activate the button."
- (or (ebut:at-p) (ibut:at-p)))
-
+ (interactive)
+ (if (called-interactively-p 'interactive)
+ (let ((hbut (or (ebut:at-p) (ibut:at-p))))
+ (when hbut
+ (if (fboundp #'hkey-help)
+ (hkey-help)
+ (message "%S" (symbol-plist hbut)))
+ hbut))
+ (or (ebut:at-p) (ibut:at-p))))
(defun hbut:comment (start end)
"Comment button label spanning region START to END in current buffer.
@@ -1000,7 +1011,7 @@ nil. BUFFER defaults to the current buffer."
(defun hbut:key-src (&optional full)
"Return key source (usually unqualified) for current Hyperbole button.
-Als sets current buffer to key source.
+Also sets current buffer to key source.
With optional FULL when source is a pathname, return the full pathname."
(let ((src (cond ((hmail:mode-is-p) (current-buffer))
;; If buffer represents the output of a document
@@ -1034,7 +1045,7 @@ With optional FULL when source is a pathname, return the
full pathname."
(file-name-nondirectory buffer-file-name)))
;; Handle any preceding @loc hyp-source implicit button
location references.
;; This is used in report buffers of explicit buttons, i.e.
hui:hbut-report
- ;; and the *Rolo* output buffer.
+ ;; and the *Hyperbole Rolo* output buffer.
((save-excursion
(save-restriction
(widen)
@@ -1063,9 +1074,9 @@ represent the output of particular document formatters."
((current-buffer))))))
(defun hbut:key-src-set-buffer (src)
- "Set buffer to SRC, a buffer, file, directory or symlink and return SRC or
nil if invalid."
+ "Set buffer to SRC, a buffer, buffer name, file, directory or symlink and
return SRC or nil if invalid."
(cond ((null src) nil)
- ((bufferp src)
+ ((or (bufferp src) (get-buffer src))
(set-buffer src)
src)
((file-directory-p src)
@@ -1401,26 +1412,29 @@ excluding delimiters, not just one."
;; when point is at the end of a line. -- RSW, 02-16-2020
(unless (eolp)
(let* ((opoint (point))
- (label-key-start-end (ibut:label-p nil nil nil t t))
- (lbl-key (car label-key-start-end)))
+ (name-start-end (ibut:label-p nil nil nil t t))
+ (lbl-key (or (car name-start-end)
+ (ibut:label-p nil "\"" "\"" nil t))))
(unwind-protect
(progn
(when (not (hbut:outside-comment-p))
- ;; Skip past any optional label and separators
- (when label-key-start-end
- (goto-char (nth 2 label-key-start-end))
- (when (looking-at ibut:label-separator-regexp)
- ;; Move past up to 2 possible characters of ibut
- ;; delimiters; this prevents recognizing labeled,
- ;; delimited ibuts of a single character but no one
- ;; should need that.
- (goto-char (min (+ 2 (match-end 0)) (point-max))))))
+ ;; Skip past any optional name and separators
+ (when name-start-end
+ (goto-char (nth 2 name-start-end))
+ (if (looking-at ibut:label-separator-regexp)
+ ;; Move past up to 2 possible characters of ibut
+ ;; delimiters; this prevents recognizing labeled,
+ ;; delimited ibuts of a single character since no one
+ ;; should need that.
+ (goto-char (min (+ 2 (match-end 0)) (point-max)))
+ (goto-char opoint))))
;; Check for an implicit button at current point, record its
;; attributes and return a button symbol for it.
(let ((types (htype:category 'ibtypes))
;; Global var used in (hact) function, don't delete.
(hrule:action 'actype:identity)
+ (ibpoint (point-marker))
(itype)
(args)
(is-type))
@@ -1428,9 +1442,14 @@ excluding delimiters, not just one."
(hattr:clear 'hbut:current))
(while (and (not is-type) types)
(setq itype (car types))
- (if (and itype (setq args (funcall itype)))
- (setq is-type itype)
- (setq types (cdr types))))
+ (when (and itype (setq args (funcall itype)))
+ (setq is-type itype)
+ ;; Any implicit button type check should leave point
+ ;; unchanged. Trigger an error if not.
+ (unless (equal (point-marker) ibpoint)
+ (hypb:error "(Hyperbole): `ibtypes::%s' implicit button
type test failed to restore point to %s" is-type ibpoint)))
+ (setq types (cdr types)))
+ (set-marker ibpoint nil)
(when is-type
(hattr:set 'hbut:current 'categ is-type)
(when lbl-key
@@ -1701,6 +1720,9 @@ Return the symbol for the button, else nil."
(when (string-match-p "\\s-" lbl-key)
(setq lbl-key (ibut:label-to-key lbl-key)))
(let ((regexp (hbut:label-regexp lbl-key t))
+ (start (point))
+ at-lbl-key
+ ibut
pos
found)
(save-excursion
@@ -1716,31 +1738,60 @@ Return the symbol for the button, else nil."
;; character to prevent this.
found (save-excursion
(goto-char (1- (point)))
- (equal (ibut:label-p nil nil nil nil t) lbl-key))))
+ (setq ibut (ibut:at-p)
+ at-lbl-key (hattr:get ibut 'lbl-key))
+ (equal at-lbl-key lbl-key))))
+ (unless found
+ (goto-char start))
;; re-search backward
(while (and (not found) (re-search-backward regexp nil t))
(setq pos (match-beginning 0)
- found (equal (ibut:label-p nil nil nil nil t) lbl-key))))
+ ibut (ibut:at-p)
+ at-lbl-key (hattr:get ibut 'lbl-key)
+ found (equal at-lbl-key lbl-key))))
(when found
(goto-char pos)
- (ibut:at-p)))))
+ ibut))))
(defun ibut:to-text (lbl-key)
"Find the nearest implicit button with LBL-KEY (a label or label key) within
the visible portion of the current buffer and move to within its button text.
-Return the symbol for the button, else nil."
- (let ((ibut (ibut:to lbl-key))
- (lbl-key-end (nth 2 (ibut:label-p nil nil nil t t))))
- (when ibut
- ;; Skip past any optional label and separators
- (goto-char lbl-key-end)
- (when (and (not (hbut:outside-comment-p))
- (looking-at ibut:label-separator-regexp))
- ;; Move past up to 2 possible characters of ibut
- ;; delimiters; this prevents recognizing labeled,
- ;; delimited ibuts of a single character but no one
- ;; should need that.
- (goto-char (min (+ 2 (match-end 0)) (point-max))))
- ibut)))
+This will find an implicit button if point is within its name or text
+or if LBL-KEY is a name/name-key of an existing implicit button. It
+will not find other unnamed implicit buttons.
+
+Return the symbol for the button if found, else nil."
+ (let* ((name-start-end (ibut:label-p nil nil nil t t))
+ (name-end (nth 2 name-start-end))
+ (at-name (car name-start-end))
+ (at-lbl-key (ibut:label-p nil "\"" "\"" nil t))
+ (opoint (point))
+ move-flag
+ start
+ ibut)
+ ;; Do not move point if it is already in the text of an
+ ;; implicit button matching LBL-KEY. If on the name of
+ ;; the same button, move into the text of the button.
+ (cond ((and lbl-key (equal at-lbl-key lbl-key))
+ (setq ibut 'hbut:current))
+ ((and at-name (equal at-name lbl-key))
+ (setq ibut 'hbut:current
+ move-flag t))
+ ((and lbl-key (setq ibut (ibut:to lbl-key)))
+ (setq move-flag t)))
+ (when (and move-flag (not (hbut:outside-comment-p)))
+ ;; Skip past any optional name and separators
+ (if (setq start (hattr:get ibut 'lbl-start))
+ (goto-char start)
+ (when name-end
+ (goto-char name-end)
+ (if (looking-at ibut:label-separator-regexp)
+ ;; Move past up to 2 possible characters of ibut
+ ;; delimiters; this prevents recognizing labeled,
+ ;; delimited ibuts of a single character since no one
+ ;; should need that.
+ (goto-char (min (+ 2 (match-end 0)) (point-max)))
+ (goto-char opoint)))))
+ ibut))
;;; ------------------------------------------------------------------------
(defconst ibut:label-start "<["
diff --git a/hmouse-drv.el b/hmouse-drv.el
index 03d6812..807ec08 100644
--- a/hmouse-drv.el
+++ b/hmouse-drv.el
@@ -19,10 +19,6 @@
(require 'hui-window)
(require 'hypb)
-;; Quiet byte compiler warnings for these free variables.
-(defvar hkey-action)
-(defvar pred-value)
-
;;; ************************************************************************
;;; Public variables
;;; ************************************************************************
@@ -840,9 +836,7 @@ frame instead."
((and (frame-parameter frame 'drag-with-mode-line)
(window-at-side-p window 'bottom))
;; Drag frame when the window is on the bottom of its frame.
- (if (fboundp 'mouse-drag-frame)
- (mouse-drag-frame start-event 'move)
- (mouse-drag-frame-move start-event))))))
+ (mouse-drag-frame start-event 'move)))))
(defun hkey-debug (pred pred-value hkey-action)
(message (format "(HyDebug) %sContext: %s; %s: %s; Buf: %s; Mode: %s;
MinibufDepth: %s"
@@ -858,27 +852,35 @@ frame instead."
(hypb:format-quote (format "%s" hkey-action))
(current-buffer) major-mode (minibuffer-depth))))
-(defun hkey-execute (assist-flag)
- "Evaluate Action Key form (or Assist Key form with ASSIST-FLAG non-nil) for
first non-nil predicate from `hkey-alist'.
-Non-nil ASSIST-FLAG means evaluate second form, otherwise evaluate first form.
+(defun hkey-execute (assisting)
+ "Evaluate Action Key form (or Assist Key form with ASSISTING non-nil) for
first non-nil predicate from `hkey-alist'.
+Non-nil ASSISTING means evaluate second form, otherwise evaluate first form.
Return non-nil iff a non-nil predicate is found."
;; Keep in mind that hkey-alist may be set to hmouse-alist here, with
additional predicates.
(let ((hkey-forms hkey-alist)
+ (pred-point (point-marker))
pred-value hkey-action hkey-form pred)
(while (and (null pred-value) (setq hkey-form (car hkey-forms)))
- (if (setq hkey-action (if assist-flag (cddr hkey-form) (cadr hkey-form))
+ (if (setq hkey-action (if assisting (cddr hkey-form) (cadr hkey-form))
pred (car hkey-form)
pred-value (eval pred))
- ;; Conditionally debug after Smart Key release and evaluation
- ;; of matching predicate but before hkey-action is executed.
- (progn (when hkey-debug (hkey-debug pred pred-value hkey-action))
- (eval hkey-action))
+ (progn
+ ;; Any Smart Key predicate should leave point unchanged.
+ ;; Trigger an error if not.
+ (unless (equal (point-marker) pred-point)
+ (hypb:error "(Hyperbole): `%s' predicate failed to restore point
to %s" pred pred-point))
+ (set-marker pred-point nil)
+ ;; Conditionally debug after Smart Key release and evaluation
+ ;; of matching predicate but before hkey-action is executed.
+ (when hkey-debug
+ (hkey-debug pred pred-value hkey-action))
+ (eval hkey-action))
(setq hkey-forms (cdr hkey-forms))))
pred-value))
-(defun hkey-help (&optional assist-flag)
+(defun hkey-help (&optional assisting)
"Display help for the Action Key command in current context.
-With optional ASSIST-FLAG prefix arg non-nil, display help for the Assist Key
command.
+With optional ASSISTING prefix arg non-nil, display help for the Assist Key
command.
Return non-nil iff associated help documentation is found."
(interactive "P")
(let* ((mouse-flag (when (mouse-event-p last-command-event)
@@ -891,20 +893,20 @@ Return non-nil iff associated help documentation is
found."
(or (setq pred-value (eval (car hkey-form)))
(setq hkey-forms (cdr hkey-forms))))
(if pred-value
- (setq call (if assist-flag (cdr (cdr hkey-form))
+ (setq call (if assisting (cdr (cdr hkey-form))
(cadr hkey-form))
cmd-sym (if (eq (car call) #'funcall)
(cadr call)
(car call)))
- (setq cmd-sym (if assist-flag assist-key-default-function
action-key-default-function)
+ (setq cmd-sym (if assisting assist-key-default-function
action-key-default-function)
call cmd-sym))
(if (and (consp call) (eq (car call) 'call-interactively))
- (if (consp (cadr call))
- (setq cmd-sym (if (memq (caadr call) '(function quote))
- (cadadr call)
- (caadr call)))))
+ (when (consp (cadr call))
+ (setq cmd-sym (if (memq (caadr call) '(function quote))
+ (cadadr call)
+ (caadr call)))))
(setq calls (if (and (consp call) (eq (car call) 'or))
- (mapcar 'identity (cdr call))
+ (mapcar #'identity (cdr call))
(list cmd-sym)))
(unless (or action-key-depressed-flag action-key-help-flag)
@@ -937,13 +939,13 @@ Return non-nil iff associated help documentation is
found."
(with-output-to-temp-buffer
(hypb:help-buf-name
(format "%s %sKey"
- (if assist-flag "Assist" "Action")
+ (if assisting "Assist" "Action")
(if mouse-flag "Mouse " "")))
(princ (format "A %s of the %s %sKey"
(if mouse-flag
(if mouse-drag-flag "drag" "click")
"press")
- (if assist-flag "Assist" "Action")
+ (if assisting "Assist" "Action")
(if mouse-flag "Mouse " "")))
(terpri)
(princ "WHEN ")
@@ -955,8 +957,8 @@ Return non-nil iff associated help documentation is found."
(mapc (lambda (c)
(when (and (> (length calls) 1)
(not (eq (car calls) c)))
- ;; Is an 'or' set of calls
- (princ "OR "))
+ ;; Is an 'or' set of calls
+ (princ "OR "))
(princ "CALLS ") (princ (if (consp c) c (list c)))
(when (and (fboundp (setq call (if (consp c) (car
c) c)))
(setq doc (documentation call)))
@@ -982,7 +984,7 @@ Return non-nil iff associated help documentation is found."
))
"")
(message "No %s Key command for current context."
- (if assist-flag "Assist" "Action"))))
+ (if assisting "Assist" "Action"))))
doc))
(defun hkey-assist-help ()
@@ -1006,7 +1008,8 @@ details."
(let ((buf (current-buffer)))
(if (window-configuration-p hkey--wconfig)
(progn (set-window-configuration hkey--wconfig)
- (if kill (kill-buffer buf)
+ (if kill
+ (kill-buffer buf)
(bury-buffer buf)))
(hkey-quit-window kill window)))
(setq hkey--wconfig nil))
@@ -1065,30 +1068,31 @@ the current window. By default, it is displayed
according to the setting of
(when (derived-mode-p 'help-mode)
(local-set-key "q" #'hkey-help-hide)))))
;; If in an *Org Help* buffer, reselect the Org buffer.
- (if org-help (select-window owind))
+ (when org-help
+ (select-window owind))
;; If in a *Completions* buffer, re-select the window that
;; generated the completions.
- (if (buffer-live-p completion-reference-buffer)
- (select-window (get-buffer-window completion-reference-buffer t))))))
+ (when (buffer-live-p completion-reference-buffer)
+ (select-window (get-buffer-window completion-reference-buffer t))))))
-(defun hkey-mouse-help (assist-flag args)
+(defun hkey-mouse-help (assisting args)
"If a Smart Key help flag is set and the other Smart Key is not down, show
help.
-Takes two args: ASSIST-FLAG should be non-nil iff command applies to the
Assist Key.
+Takes two args: ASSISTING should be non-nil iff command applies to the Assist
Key.
ARGS is a list of arguments passed to `hmouse-function'.
Return t if help is displayed, nil otherwise."
(let ((help-shown)
- (other-key-released (not (if assist-flag
+ (other-key-released (not (if assisting
action-key-depressed-flag
assist-key-depressed-flag))))
(unwind-protect
(setq help-shown
(cond ((and action-key-help-flag other-key-released)
(setq action-key-help-flag nil)
- (hmouse-function #'hkey-help assist-flag args)
+ (hmouse-function #'hkey-help assisting args)
t)
((and assist-key-help-flag other-key-released)
(setq assist-key-help-flag nil)
- (hmouse-function #'hkey-assist-help assist-flag args)
+ (hmouse-function #'hkey-assist-help assisting args)
t)))
(when help-shown
;; Then both Smart Keys have been released.
@@ -1104,8 +1108,8 @@ Action Key.
Only works when running under a window system, not from a dumb terminal."
(interactive "P")
- (or (hyperb:window-system)
- (hypb:error "(hkey-operate): Drag actions require mouse support"))
+ (unless (hyperb:window-system)
+ (hypb:error "(hkey-operate): Drag actions require mouse support"))
(if arg
(if assist-key-depressed-flag
(progn (assist-mouse-key)
@@ -1133,11 +1137,10 @@ the current window. By default, it is displayed in
another window."
(interactive)
(let* ((doc-file (hypb:hkey-help-file))
(buf-name (hypb:help-buf-name "Smart Keys"))
- (wind (get-buffer-window buf-name))
- owind)
+ (wind (get-buffer-window buf-name)))
(when (file-readable-p doc-file)
- (if (br-in-browser)
- (br-to-view-window))
+ (when (br-in-browser)
+ (br-to-view-window))
(if wind
(select-window wind)
(hkey-help-show buf-name current-window)
@@ -1163,7 +1166,8 @@ With optional ARG, enable iff ARG is positive."
(defun hmouse-depress-inactive-minibuffer-p (event)
"Return the minibuffer window if the last Smart Mouse Key depress EVENT was
in it and it was inactive, else nil."
(let ((window (posn-window (event-start event))))
- (if (framep window) (setq window (frame-selected-window window)))
+ (when(framep window)
+ (setq window (frame-selected-window window)))
(and (window-minibuffer-p window)
(not (minibuffer-window-active-p window))
window)))
@@ -1382,9 +1386,8 @@ compute the actual release location and include that."
((boundp 'transient-mark-mode)
(and transient-mark-mode mark-active))))
-(defun hmouse-save-region (&optional frame)
+(defun hmouse-save-region ()
"Save to `hkey-region' and return any active region within the current
buffer.
-Under InfoDock and XEmacs, `zmacs-region' must be t; under GNU Emacs,
`transient-mark-mode' must be t or the function does nothing."
(setq hkey-region
(when (hmouse-use-region-p)
@@ -1429,14 +1432,14 @@ line to bottom of window. Repeated presses then scroll
up or down a
windowful. Nil value instead ignores current line and always scrolls up or
down a windowful."))
-(defun hmouse-function (func assist-flag set-point-arg-list)
- "Execute FUNC for Action Key (Assist Key with ASSIST-FLAG non-nil) and set
point from SET-POINT-ARG-LIST.
+(defun hmouse-function (func assisting set-point-arg-list)
+ "Execute FUNC for Action Key (Assist Key with ASSISTING non-nil) and set
point from SET-POINT-ARG-LIST.
FUNC may be nil in which case no function is called.
SET-POINT-ARG-LIST is passed to the call of the command bound to
`hmouse-set-point-command'. Return nil if `hmouse-set-point-command' variable
is not bound to a valid function."
(when (fboundp hmouse-set-point-command)
- (if assist-flag
+ (if assisting
(setq assist-key-release-window (hmouse-key-release-window
assist-key-release-position)
assist-key-release-prev-point (point-marker))
(setq action-key-release-window (hmouse-key-release-window
action-key-release-position)
@@ -1450,7 +1453,7 @@ is not bound to a valid function."
(selected-window))))
(setq action-mouse-key-prefix-arg current-prefix-arg)
(let ((release-args (hmouse-set-point set-point-arg-list)))
- (if assist-flag
+ (if assisting
(setq assist-key-release-args release-args)
(setq action-key-release-args release-args)))
(when func
@@ -1515,7 +1518,9 @@ not."
(setq rtn nil)
(scroll-up)))
(end-of-line)
- (or rtn (progn (beep) (message "End of buffer")))
+ (unless rtn
+ (beep)
+ (message "End of buffer"))
rtn))
(provide 'hmouse-drv)
diff --git a/hpath.el b/hpath.el
index 5dd3175..b39f954 100644
--- a/hpath.el
+++ b/hpath.el
@@ -641,10 +641,11 @@ Other arguments are returned unchanged."
(defun hpath:absolute-to (path &optional default-dirs)
"Return PATH as an absolute path relative to one directory from optional
DEFAULT-DIRS or `default-directory'.
-Return PATH unchanged when it is not a valid path or when DEFAULT-DIRS
+Return PATH unchanged when it is a buffer name or not a valid path or when
DEFAULT-DIRS
is invalid. DEFAULT-DIRS when non-nil may be a single directory or a list of
directories. The first one in which PATH is found is used."
(cond ((not (and (stringp path)
+ (not (get-buffer path))
(not (hypb:object-p path))
(hpath:is-p (hpath:trim path) nil t)))
path)
diff --git a/hui-mini.el b/hui-mini.el
index a350902..604f687 100644
--- a/hui-mini.el
+++ b/hui-mini.el
@@ -84,16 +84,16 @@ documentation, not the full text."
(setq hui:menu-p nil))))
;;;###autoload
-(defun hyperbole-set-key (key command)
- "Give KEY a global binding of Hyperbole minibuffer COMMAND keys.
-KEY is a key sequence; noninteractively, it is a string or vector
+(defun hyperbole-set-key (global-key menu-keys)
+ "Bind GLOBAL-KEY to Hyperbole minibuffer MENU-KEYS.
+GLOBAL-KEY is a key sequence; noninteractively, it is a string or vector
of characters or event types, and non-ASCII characters with codes
above 127 (such as ISO Latin-1) can be included if you use a vector.
-COMMAND is a string of the ASCII key presses used to invoke a
+MENU-KEYS is a string of the ASCII key presses used to invoke a
Hyperbole minibuffer command.
-Note that if KEY has a local binding in the current buffer,
+Note that if GLOBAL-KEY has a local binding in the current buffer,
that local binding will continue to shadow any global binding
that you make with this function."
(interactive
@@ -105,13 +105,13 @@ that you make with this function."
;; Normalize the key prefix that invokes the Hyperbole minibuffer
menu
(kbd (key-description (car (where-is-internal 'hyperbole))))
(hui:get-keys)))))
- (or (vectorp key) (stringp key)
- (signal 'wrong-type-argument (list 'arrayp key)))
- (if (or (not (stringp command)) (string-empty-p command))
+ (or (vectorp global-key) (stringp global-key)
+ (signal 'wrong-type-argument (list 'arrayp global-key)))
+ (if (or (not (stringp menu-keys)) (string-empty-p menu-keys))
(user-error "(hyperbole-set-key): No Hyperbole menu item selected")
- (define-key (current-global-map) key `(lambda () (interactive)
(kbd-key:act ,command)))
+ (define-key (current-global-map) global-key `(lambda () (interactive)
(kbd-key:act ,menu-keys)))
(when (called-interactively-p 'interactive)
- (message "{%s} globally set to invoke {%s}" (key-description key)
(key-description command)))))
+ (message "{%s} globally set to invoke {%s}" (key-description global-key)
(key-description menu-keys)))))
(defun hui:menu-act (menu &optional menu-list doc-flag help-string-flag)
"Prompt user with Hyperbole MENU (a symbol) and perform selected item.
diff --git a/hui-mouse.el b/hui-mouse.el
index 697da43..d0b0801 100644
--- a/hui-mouse.el
+++ b/hui-mouse.el
@@ -176,9 +176,9 @@ Its default value is #'smart-scroll-down. To disable it,
set it to
((smart-company-to-definition) . (smart-company-help)))
;; Handle any Org mode-specific contexts
((and (not (hyperb:stack-frame '(smart-org)))
- (smart-org current-prefix-arg)) .
- ;; smart-org performs the actions and assist help
- ((identity t) . (identity t)))
+ (let ((hrule:action #'actype:identity))
+ (smart-org current-prefix-arg))) .
+ ((smart-org current-prefix-arg) . (smart-org current-prefix-arg)))
;; Ivy minibuffer completion mode
((and (boundp 'ivy-mode) ivy-mode (minibuffer-window-active-p
(selected-window))) .
((ivy-done) . (ivy-dispatching-done)))
diff --git a/hui-select.el b/hui-select.el
index 8bee86c..31f20b2 100644
--- a/hui-select.el
+++ b/hui-select.el
@@ -319,10 +319,10 @@ Also, add language-specific syntax setups to aid in thing
selection."
(require 'hyperbole))
(when hkey-init
(transient-mark-mode 1)
- (hkey-global-set-key [double-down-mouse-1] nil)
- (hkey-global-set-key [double-mouse-1] 'hui-select-thing-with-mouse)
- (hkey-global-set-key [triple-down-mouse-1] nil)
- (hkey-global-set-key [triple-mouse-1] 'hui-select-thing-with-mouse))
+ (hkey-set-key [double-down-mouse-1] nil)
+ (hkey-set-key [double-mouse-1] 'hui-select-thing-with-mouse)
+ (hkey-set-key [triple-down-mouse-1] nil)
+ (hkey-set-key [triple-mouse-1] 'hui-select-thing-with-mouse))
;;
;; These hooks let you select C++ and Java methods and classes by
;; double-clicking on the first character of a definition or on its
diff --git a/hui-window.el b/hui-window.el
index 3324402..b411c77 100644
--- a/hui-window.el
+++ b/hui-window.el
@@ -1157,8 +1157,7 @@ of the Smart Key."
(hmouse-x-coord
(if assist-flag assist-key-release-args
action-key-release-args)))
- (shrink-amount (- right-side-ln last-release-x))
- )
+ (shrink-amount (- right-side-ln last-release-x)))
;; Restore position of point prior to Action Key release.
(if action-key-release-prev-point
(let ((obuf (current-buffer)))
@@ -1187,13 +1186,10 @@ of the Smart Key."
(w2 (if assist-flag assist-key-release-window
action-key-release-window))
(w1-buf (and w1 (window-buffer w1)))
- (w2-buf (and w2 (window-buffer w2)))
- )
+ (w2-buf (and w2 (window-buffer w2))))
(cond ((not (and w1 w2))
(error "(hmouse-swap-buffers): Last depress or release was not
within a window"))
- ((eq w1 w2)
- ;; Do nothing silently.
- )
+ ((eq w1 w2)) ;; Do nothing silently.
(t ;; Swap window buffers.
(set-window-buffer w1 w2-buf)
(set-window-buffer w2 w1-buf)))))
@@ -1207,27 +1203,24 @@ of the Smart Key."
(w1-width (and w1 (window-width w1)))
(w1-height (and w1 (window-height w1)))
(w2-width (and w2 (window-width w2)))
- (w2-height (and w2 (window-height w2)))
- )
+ (w2-height (and w2 (window-height w2))))
(or (and w1 w2)
(error "(hmouse-swap-windows): Last depress or release was not within a
window"))
(unwind-protect
(progn
(select-window w1)
- (if (not (= w1-height (frame-height)))
- (shrink-window (- w1-height w2-height)))
- (if (not (= w1-width (frame-width)))
- (shrink-window-horizontally (- w1-width w2-width)))
+ (unless (= w1-height (frame-height))
+ (shrink-window (- w1-height w2-height)))
+ (unless (= w1-width (frame-width))
+ (shrink-window-horizontally (- w1-width w2-width)))
(select-window w2)
(setq w2-width (window-width w2)
w2-height (window-height w2))
- (if (not (= w2-height (frame-height)))
- (shrink-window (- w2-height w1-height)))
- (if (not (= w2-width (frame-width)))
- (shrink-window-horizontally (- w2-width w1-width)))
- )
- (select-window w2)
- )))
+ (unless (= w2-height (frame-height))
+ (shrink-window (- w2-height w1-height)))
+ (unless (= w2-width (frame-width))
+ (shrink-window-horizontally (- w2-width w1-width))))
+ (select-window w2))))
(defun hmouse-x-coord (args)
"Return x coordinate in characters from window system dependent ARGS or nil."
@@ -1235,8 +1228,9 @@ of the Smart Key."
(save-excursion
(hypb:goto-marker args)
(current-column))
- (eval (cdr (assoc (hyperb:window-system)
- '(("emacs" . (progn (when (eventp args) (setq
args (event-start args)))
+ (funcall (cdr (assoc (hyperb:window-system)
+ '(("emacs" . (lambda (args)
+ (when (eventp args) (setq args
(event-start args)))
(cond
((posnp args)
(let ((w-or-f (posn-window
args)))
@@ -1247,26 +1241,29 @@ of the Smart Key."
(error 0))
(nth 0 (window-edges
w-or-f)))))
(t (car args)))))
- ("next" . (nth 1 args))
- )))))))
- (if (integerp x) x)))
+ ("next" . (lambda (args) (nth 1 args))))))
+ args))))
+ (when (integerp x)
+ x)))
(defun hmouse-y-coord (args)
"Return y coordinate in frame lines from window system dependent ARGS or
nil."
- (let ((y (eval (cdr (assoc (hyperb:window-system)
- '(("emacs" . (progn (when (eventp args) (setq args
(event-start args)))
- (cond ((posnp args)
- (let ((w-or-f
(posn-window args)))
- (when (framep w-or-f)
- (setq w-or-f
(frame-selected-window w-or-f)))
- (+ (condition-case ()
- (cdr
(posn-col-row args))
- (error 0))
- (nth 1
(window-edges w-or-f)))))
- (t (cdr args)))))
- ("next" . (nth 2 args))
- ))))))
- (if (integerp y) y)))
+ (let ((y (funcall (cdr (assoc (hyperb:window-system)
+ '(("emacs" . (lambda (args)
+ (when (eventp args) (setq args
(event-start args)))
+ (cond ((posnp args)
+ (let ((w-or-f
(posn-window args)))
+ (when (framep
w-or-f)
+ (setq w-or-f
(frame-selected-window w-or-f)))
+ (+ (condition-case
()
+ (cdr
(posn-col-row args))
+ (error 0))
+ (nth 1
(window-edges w-or-f)))))
+ (t (cdr args)))))
+ ("next" . (lambda (args) (nth 2 args))))))
+ args)))
+ (when (integerp y)
+ y)))
;;; ************************************************************************
;;; Private variables
diff --git a/hui.el b/hui.el
index 2c37d15..d587eb2 100644
--- a/hui.el
+++ b/hui.el
@@ -230,7 +230,7 @@ Signal an error when no such button is found in the current
buffer."
(and hui:ebut-prompt-for-action (hui:action actype))))
(ebut:operate lbl new-lbl)
(when (called-interactively-p 'interactive)
- (hui:ebut-message t))))
+ (hui:ebut-message t))))
(defun hui:ebut-rename (curr-label new-label)
"Rename explicit Hyperbole button given by CURR-LABEL to NEW-LABEL.
@@ -281,7 +281,7 @@ Signal an error if any problem occurs."
new-label)))
(or (ebut:get (ebut:label-to-key curr-label))
(hypb:error "(ebut-rename): Can't rename %s since no button data"
- curr-label)))
+ curr-label)))
(cond (new-label
(ebut:operate curr-label new-label)
(setq hui:ebut-label-prev nil)
@@ -315,12 +315,12 @@ a menu to find any of the occurrences."
(outline-minor-mode 1)))
(if (fboundp 'hproperty:but-create)
(hproperty:but-create nil nil (regexp-quote
- (if match-part string
- (concat ebut:start string ebut:end)))))
+ (if match-part string
+ (concat ebut:start string
ebut:end)))))
(goto-char (point-min))
(pop-to-buffer out-buf)
(if (called-interactively-p 'interactive) (message "%d match%s." total
- (if (> total 1) "es" ""))
+ (if (> total 1)
"es" ""))
total))
(if (called-interactively-p 'interactive) (message "No matches.")
total))))
@@ -510,14 +510,17 @@ The default is the current button."
(hypb:error "(hbut-act): Button is invalid; it has no attributes"))
(t (hui:but-flash) (hbut:act but)))))
-(defun hui:hbut-delete (but-key &optional key-src)
- "Delete a Hyperbole button given by BUT-KEY in optional KEY-SRC (default is
current buffer).
+(defun hui:hbut-delete (&optional but-key key-src)
+ "Delete a Hyperbole button given by optional BUT-KEY in optional KEY-SRC
(default is current buffer).
Return t if button is deleted, nil if user chooses not to delete or signal
an error otherwise. If called interactively, prompt user whether to delete
and derive BUT-KEY from the button that point is within.
Signal an error if point is not within a button."
- (interactive (list (when (hbut:at-p)
- (hattr:get 'hbut:current 'lbl-key))))
+ (interactive)
+ (when (and (null but-key) (hbut:at-p))
+ (setq but-key (hattr:get 'hbut:current 'lbl-key)))
+ (unless key-src
+ (setq key-src (or buffer-file-name (current-buffer))))
(cond ((null but-key)
(hypb:error
"(hbut-delete): Point is not over the label of an existing button"))
@@ -608,8 +611,8 @@ Also has side effect of moving point to start of default
label, if any."
(when (markerp end) (setq end (marker-position end)))
;; Test whether to use region as default button label.
(when (and (integerp start) (integerp end)
- (or skip-len-test
- (<= (max (- end start) (- start end)) (hbut:max-len))))
+ (or skip-len-test
+ (<= (max (- end start) (- start end)) (hbut:max-len))))
(goto-char start)
(buffer-substring-no-properties start end)))
@@ -652,7 +655,7 @@ Default is any implicit button at point."
(hui:hbut-operate #'ibut:act "Activate labeled implicit button: " but))
(defun hui:ibut-label-create ()
- "Create an implicit button label preceding an existing implicit button at
point, if any.
+ "Create an implicit button label preceding the text of an existing implicit
button at point, if any.
Add the label and delimiters around it plus any necessary label instance
number.
Signal an error if point is not on an implicit button or if the button already
has a label.
@@ -732,8 +735,7 @@ See also documentation for `hui:link-possible-types'."
(interactive (hmouse-choose-windows #'hui:link))
(let ((but-window (or depress-window action-key-depress-window))
(referent-window (or release-window action-key-release-window
(selected-window)))
- (but-modify nil)
- link-types num-types type-and-args lbl-key but-loc but-dir)
+ but-modify link-types num-types type-and-args lbl-key but-loc but-dir)
(select-window referent-window)
(setq link-types (hui:link-possible-types)
num-types (length link-types))
@@ -764,29 +766,29 @@ See also documentation for `hui:link-possible-types'."
(setq type-and-args (hui:list-remove-text-properties (car
link-types)))
(hui:link-create but-modify but-window lbl-key but-loc but-dir
type-and-args))
(t ;; more than 1
- (let ((item)
- type)
- (setq type-and-args
- (hui:menu-select
- (cons '("Link to>")
- (mapcar
- (lambda (type-and-args)
- (setq type (car type-and-args))
- (list
- (capitalize
- (if (string-match
- "^\\(link-to\\|eval\\)-"
- (setq item (symbol-name type)))
- (setq item (substring
- item (match-end 0)))
- item))
- type-and-args
- (documentation (symtable:actype-p type))))
- link-types)))
- type-and-args (hui:list-remove-text-properties
type-and-args))
- (hui:link-create
- but-modify but-window
- lbl-key but-loc but-dir type-and-args))))
+ (let ((item)
+ type)
+ (setq type-and-args
+ (hui:menu-select
+ (cons '("Link to>")
+ (mapcar
+ (lambda (type-and-args)
+ (setq type (car type-and-args))
+ (list
+ (capitalize
+ (if (string-match
+ "^\\(link-to\\|eval\\)-"
+ (setq item (symbol-name type)))
+ (setq item (substring
+ item (match-end 0)))
+ item))
+ type-and-args
+ (documentation (symtable:actype-p type))))
+ link-types)))
+ type-and-args (hui:list-remove-text-properties
type-and-args))
+ (hui:link-create
+ but-modify but-window
+ lbl-key but-loc but-dir type-and-args))))
(hui:ebut-message but-modify)))
;;; ************************************************************************
@@ -802,35 +804,35 @@ See also documentation for `hui:link-possible-types'."
(params-str (and params (concat " " (prin1-to-string params))))
)
(while (progn
- (while (and (setq act-str
- (hargs:read
- (or prompt (concat "Action" params-str
- ": ")) nil nil
- nil 'string))
- (not (string-equal act-str ""))
- (condition-case ()
- (progn (setq act (read act-str)) nil)
- (error
- (beep) (message "Invalid action syntax.")
- (sit-for 3) t))))
- (and (not (symbolp act))
- params-no-keywords
- ;; Use the weak condition that action must
- ;; involve at least one of actype's parameters
- ;; or else we assume the action is invalid, tell
- ;; the user and provide another chance for entry.
- (not (memq t
- (mapcar
- (lambda (param)
- (setq param (symbol-name param))
- (and (string-match
- (concat "[\( \t\n\r,']"
- (regexp-quote param)
- "[\(\) \t\n\r\"]")
- act-str)
- t))
- params-no-keywords)))
- ))
+ (while (and (setq act-str
+ (hargs:read
+ (or prompt (concat "Action" params-str
+ ": ")) nil nil
+ nil 'string))
+ (not (string-equal act-str ""))
+ (condition-case ()
+ (progn (setq act (read act-str)) nil)
+ (error
+ (beep) (message "Invalid action syntax.")
+ (sit-for 3) t))))
+ (and (not (symbolp act))
+ params-no-keywords
+ ;; Use the weak condition that action must
+ ;; involve at least one of actype's parameters
+ ;; or else we assume the action is invalid, tell
+ ;; the user and provide another chance for entry.
+ (not (memq t
+ (mapcar
+ (lambda (param)
+ (setq param (symbol-name param))
+ (and (string-match
+ (concat "[\( \t\n\r,']"
+ (regexp-quote param)
+ "[\(\) \t\n\r\"]")
+ act-str)
+ t))
+ params-no-keywords)))
+ ))
(beep) (message "Action must use at least one parameter.")
(sit-for 3))
(let (head)
@@ -903,7 +905,7 @@ DEFAULT-ACTYPE may be a valid symbol or symbol name."
nil t (buffer-name) 'buffer))
(or (null buf-name) (equal buf-name "")))
(beep))
- (get-buffer buf-name)))
+ (get-buffer buf-name)))
(defun hui:ebut-delete-op (interactive but-key key-src)
"INTERACTIVEly or not delete explicit Hyperbole button given by BUT-KEY in
KEY-SRC.
@@ -923,7 +925,7 @@ within."
(if ebut
(ebut:delete ebut)
(hypb:error "(ebut-delete): No valid %s button in %s"
- (ebut:key-to-label but-key) buf)))
+ (ebut:key-to-label but-key) buf)))
(with-current-buffer buf
(if interactive
(progn
@@ -932,7 +934,8 @@ within."
(hui:ebut-unmark but-key key-src))
(when (hmail:reader-p)
(hmail:msg-narrow))
- (message "Button '%s' deleted." (ebut:key-to-label but-key)))
+ (message "Button '%s' deleted." (ebut:key-to-label but-key))
+ t)
(hypb:error "(ebut-delete): You may not delete buttons from this
buffer"))))
(defun hui:ebut-delimit (start end instance-str)
@@ -1013,7 +1016,7 @@ With a prefix argument, also delete the button text
between the delimiters."
(if (and (stringp file-name) (file-readable-p file-name))
(find-file file-name)
(hypb:error "(file-find): \"%s\" does not exist or is not readable"
- file-name)))
+ file-name)))
(defun hui:hbut-operate (operation operation-str &optional but)
"Execute OPERATION (a function) described by OPERATION-STR action on a
Hyperbole button.
@@ -1022,23 +1025,23 @@ for with completion of all labeled buttons within the
current buffer."
(unless (or but (setq but (hbut:at-p)))
(let (lst)
(cond ((setq lst (nconc (ebut:alist) (ibut:alist)))
- (setq but (hbut:get (hbut:label-to-key
- (hargs:read-match operation-str
- lst nil t
-
(hbut:label-p 'as-label) 'hbut)))))
- (t (hypb:error "(hbut-operate): No labeled buttons in
buffer")))))
+ (setq but (hbut:get (hbut:label-to-key
+ (hargs:read-match operation-str
+ lst nil t
+ (hbut:label-p 'as-label)
'hbut)))))
+ (t (hypb:error "(hbut-operate): No labeled buttons in buffer")))))
(cond ((and (called-interactively-p 'interactive) (null but))
- (hypb:error "(hbut-operate): No current button upon which to
operate."))
- ((progn (unless but (setq but 'hbut:current))
- (hbut:is-p but))
- (hui:but-flash)
- (apply hrule:action
- operation
- (list but)))
- ((and but (symbolp but))
- (hypb:error "(hbut-operate): Symbol, %s, has invalid Hyperbole
button attributes:\n %S" but (hattr:list but)))
- (t
- (hypb:error "(hbut-operate): Invalid Hyperbole button: %s"
but))))
+ (hypb:error "(hbut-operate): No current button upon which to
operate."))
+ ((progn (unless but (setq but 'hbut:current))
+ (hbut:is-p but))
+ (hui:but-flash)
+ (apply hrule:action
+ operation
+ (list but)))
+ ((and but (symbolp but))
+ (hypb:error "(hbut-operate): Symbol, %s, has invalid Hyperbole button
attributes:\n %S" but (hattr:list but)))
+ (t
+ (hypb:error "(hbut-operate): Invalid Hyperbole button: %s" but))))
(defun hui:hbut-term-highlight (start end)
"For terminals only: Emphasize a button spanning from START to END."
@@ -1114,17 +1117,17 @@ Optional NO-SORT means display in decreasing priority
order (natural order)."
(setq nm-list
(if (member term '("" "*"))
(let ((type-names
- (mapcar (lambda (nm) (concat tprefix nm))
- names)))
+ (mapcar (lambda (nm) (concat tprefix nm))
+ names)))
(if no-sort type-names
(sort type-names #'string<)))
(cons (concat tprefix term) nil))
doc-list (delq nil (mapcar
- (lambda (name)
- (let ((doc (documentation
- (intern-soft name))))
- (if doc (cons name doc))))
- nm-list)))
+ (lambda (name)
+ (let ((doc (documentation
+ (intern-soft name))))
+ (if doc (cons name doc))))
+ nm-list)))
(with-output-to-temp-buffer buf-name
(mapcar (lambda (nm-doc-cons)
(princ (car nm-doc-cons)) (terpri)
@@ -1156,7 +1159,7 @@ within."
(if ibut
(ibut:delete ibut)
(hypb:error "(ibut-delete): No valid %s button in %s"
- (ibut:key-to-label but-key) buf)))
+ (ibut:key-to-label but-key) buf)))
(progn (set-buffer buf)
(when (hmail:reader-p) (hmail:msg-narrow))
(message "Button '%s' deleted." (ibut:key-to-label but-key)))
@@ -1233,8 +1236,8 @@ Koutline Cell link-to-kcell
Outline Heading link-to-string-match
Buffer attached to File link-to-file
Buffer without File link-to-buffer-tmp"
-;; Elisp Buffer at Start
-;; or End of Sexpression eval-elisp
+ ;; Elisp Buffer at Start
+ ;; or End of Sexpression eval-elisp
(let (val)
(delq nil
@@ -1243,14 +1246,14 @@ Buffer without File link-to-buffer-tmp"
((ebut:at-p)
(list 'link-to-ebut (ebut:label-p)))
((setq val (ibut:at-p t))
- (list 'link-to-ibut val)))
+ (list 'link-to-ibut val (or buffer-file-name
(buffer-name)))))
(cond ((and (require 'bookmark)
(derived-mode-p #'bookmark-bmenu-mode))
(list 'link-to-bookmark (bookmark-bmenu-bookmark))))
(cond ((derived-mode-p #'Info-mode)
(if (and Info-current-node
(member Info-current-node
- (Info-index-nodes Info-current-file))
+ (Info-index-nodes Info-current-file))
(Info-menu-item-at-p))
(let ((hargs:reading-p 'Info-index-item))
(list 'link-to-Info-index-item (hargs:at-p)))
diff --git a/hyperbole.el b/hyperbole.el
index c85e3cf..b62f0f0 100644
--- a/hyperbole.el
+++ b/hyperbole.el
@@ -178,62 +178,36 @@ context (wherever point is). {C-u \\[hkey-help]} shows
what the Assist Key will
;;; Public key bindings
;;; ************************************************************************
-;;
-;; Hyperbole key binding for many read-only modes. Set to nil if unwanted.
-;; No longer used; use regular Action Key instead.
-;;(defvar action-key-read-only "\C-m"
-;; "Local Action Key binding for special read-only modes. Set to nil if
unwanted.")
-
-(defvar hkey-bindings nil
- "List of global key sequences bound by Hyperbole.
-See `hkey-binding-entry' for format.")
-
-(defvar hkey-bindings-flag nil
- "True if Hyperbole key bindings are in use, else nil.")
-
-(defvar hkey-previous-bindings nil
- ;; !! FIXME: We should probably instead use a keymap that we just add/remove
- ;; from the `global-map' so we don't actually modify any keybindings (and
- ;; hence don't need this var)?
- "List of bindings that Hyperbole has overridden.
-Holds the global key sequences and their pre-Hyperbole bindings.
-See `hkey-binding-entry' for format.")
-
-(defun hkey-binding-entry (key)
- "Given an Emacs KEY that may be bound, return an entry to save the
associated binding.
-Entry format is: (key-description key-sequence key-binding)."
- (list (key-description key) key (key-binding key)))
-
-(defun hkey-bindings-keys (entries)
- (mapcar #'cadr entries))
-
(defun hkey-get-bindings ()
- "Return a list of entries for storage of Hyperbole key bindings.
+ "Return a keymap of Hyperbole key bindings.
`hkey-initialize' must have already been called or the list will be empty."
- (mapcar (lambda (key) (hkey-binding-entry key))
- (hkey-bindings-keys hkey-previous-bindings)))
+ hyperbole-mode-map)
+(make-obsolete 'hkey-global-set-key 'hkey-set-key "8.0.0")
(defun hkey-global-set-key (key command &optional no-add)
- "Same as `global-set-key' except saves prior binding for later restoration
unless optional 3rd argument NO-ADD is given as a non-nil value."
- (unless no-add
- (add-to-list 'hkey-previous-bindings (hkey-binding-entry key)))
- (global-set-key key command))
+ "Define a Hyperbole KEY bound to COMMAND. Optional third arg, NO-ADD is
ignored."
+ (define-key hyperbole-mode-map key command))
+(make-obsolete 'hkey-maybe-global-set-key 'hkey-maybe-set-key "8.0.0")
(defun hkey-maybe-global-set-key (key command &optional no-add)
- "Globally set KEY to COMMAND if KEY is unbound and COMMAND is not on any
global key.
-With third argument NO-ADD non-nil, skip storage of prior KEY binding
-which prevents automatic removal of any local bindings to the same key."
- (or (global-key-binding key)
- (where-is-internal command)
- (hkey-global-set-key key command no-add)))
+ "Define a Hyperbole KEY bound to COMMAND if KEY is not bound in
`hyperbole-mode-map'.
+Third argument NO-ADD is ignored."
+ (unless (lookup-key hyperbole-mode-map key)
+ (hkey-set-key key command no-add)))
+
+(defun hkey-set-key (key command)
+ "Define a Hyperbole global minor mode KEY bound to COMMAND."
+ (define-key hyperbole-mode-map key command))
+
+(defun hkey-maybe-set-key (key command &optional no-add)
+ "Define a Hyperbole KEY bound to COMMAND if KEY is not bound in
`hyperbole-mode-map'.
+Third argument NO-ADD is ignored."
+ (unless (lookup-key hyperbole-mode-map key)
+ (hkey-set-key key command)))
(defvar hmouse-middle-flag)
(defvar hmouse-bindings-flag)
(defvar hyperb:user-email)
-;; (defvar hyperbole-help-map (make-sparse-keymap)
-;; "Help prefix keymap available only when Hyperbole minor mode is enabled.")
-;; (defvar hyperbole-mode-specific-map (make-sparse-keymap)
-;; "C-c prefix keymap available only when Hyperbole minor mode is enabled.")
(defun hkey-initialize ()
"If `hkey-init' is non-nil, initialize Hyperbole key bindings.
@@ -244,22 +218,14 @@ of the commands."
;; Setup so Hyperbole menus can be accessed from a key. If not
;; already bound to a key, this typically binds the command `hyperbole'
;; globally to {C-h h} and activates Hyperbole minor mode.
- (or (where-is-internal #'hyperbole)
- ;; In GNU Emacs, this binding replaces a command that shows
- ;; the word hello in foreign languages; this binding makes this
- ;; key much more useful.
- (global-set-key (vector help-char ?h) #'hyperbole))
- ;;
- ;; Define help prefix key in this keymap.
- ;; (set-keymap-parent hyperbole-help-map help-map)
- ;; (hkey-set-key (vector help-char) hyperbole-help-map)
- ;;
- ;; Define C-c prefix key in this keymap.
- ;; (set-keymap-parent hyperbole-mode-specific-map mode-specific-map)
- ;; (hkey-set-key "\C-c" hyperbole-mode-specific-map)
+ (unless (where-is-internal #'hyperbole (current-global-map))
+ ;; In GNU Emacs, this binding replaces a command that shows
+ ;; the word hello in foreign languages; this binding makes this
+ ;; key much more useful.
+ (global-set-key (vector help-char ?h) #'hyperbole))
;;
- ;; Binds the Action Key to {M-RET} and the Assist Key to {C-u M-RET}
- ;; and loads the Hyperbole mouse key bindings.
+ ;; Bind the Action Key to {M-RET} and the Assist Key to {C-u M-RET}
+ ;; and load the Hyperbole mouse key bindings.
(unless (where-is-internal #'hkey-either)
;; Need to map all these variants to ensure can override
;; org-meta-return in Org mode when desired.
@@ -271,19 +237,19 @@ of the commands."
(or (where-is-internal #'hkey-help)
(hkey-set-key (vector help-char ?A) #'hkey-help))
;;
- ;; Provides a site standard way of emulating most Hyperbole mouse drag
+ ;; Provide a site standard way of emulating most Hyperbole mouse drag
;; commands from the keyboard. This is most useful for rapidly creating
;; Hyperbole link buttons from the keyboard without invoking the Hyperbole
- ;; menu. Only works if Hyperbole is run under a window system.
+ ;; menu. Works only if Hyperbole is run under a window system.
(when (hyperb:window-system)
- (if (eq (global-key-binding "\M-o") 'facemenu-keymap)
+ (if (eq (global-key-binding "\M-o") #'facemenu-keymap)
;; Override facemenu package that adds a keymap on M-o,
;; since this binding is more important to Hyperbole
;; users.
(hkey-set-key "\M-o" #'hkey-operate)
(hkey-maybe-set-key "\M-o" #'hkey-operate)))
;;
- ;; Binds {C-c @} to create a user-specified sized grid of windows
+ ;; Bind {C-c @} to create a user-specified sized grid of windows
;; displaying different buffers.
;;
;; Don't override prior bindings of this key.
@@ -294,65 +260,32 @@ of the commands."
;; Don't override prior bindings of this key.
;; (hkey-maybe-set-key "\C-cr" #'hui:ebut-rename)
;;
- ;; Binds {C-c RET} to select larger and larger syntactical units in a
+ ;; Bind {C-c RET} to select larger and larger syntactical units in a
;; buffer when invoked repeatedly, showing in the minibuffer the type
;; of unit selected each time.
(hkey-maybe-set-key "\C-c\C-m" #'hui-select-thing)
;;
- ;; Binds {C-c \} to interactively manage windows and frames.
+ ;; Bind {C-c \} to interactively manage windows and frames.
(hkey-maybe-set-key "\C-c\\" #'hycontrol-enable-windows-mode)
;;
- ;; Binds {C-c /} to display the Hyperbole Find/Web search menu.
+ ;; Bind {C-c /} to display the Hyperbole Find/Web search menu.
(hkey-maybe-set-key "\C-c/" #'hui-search-web)
;;
- ;; Binds {C-c .} to jump between the start and end of a delimited thing.
+ ;; Bind {C-c .} to jump between the start and end of a delimited thing.
;; Don't override prior bindings of this key.
(hkey-maybe-set-key "\C-c." #'hui-select-goto-matching-delimiter)
;;
- ;; This initializes the Smart Mouse Key bindings. Shifted mouse buttons
+ ;; Initialize the Smart Mouse Key bindings. Shifted mouse buttons
;; are always set up. Under InfoDock or with `hmouse-middle-flag'
- ;; non-nil, this also binds the middle mouse button to the Action Key.
+ ;; non-nil, also bind the middle mouse button to the Action Key.
;; These bindings are ignored if a particular frame does not have mouse
;; support.
(hmouse-install hmouse-middle-flag)
;;
- ;; This makes a double or triple click of the left mouse button do the
+ ;; Make a double or triple click of the left mouse button do the
;; same thing as {C-c RET}. It also sets up Java, C++ and HTML modes
;; for proper entity selection.
- (hui-select-initialize)
- ;;
- ;; Store Hyperbole key bindings so can turn them on and off.
- (setq hkey-bindings (hkey-get-bindings)
- hkey-bindings-flag t)))
-
-(defun hkey-set-bindings (key-binding-list)
- "Set keys bound by Hyperbole to those in KEY-BINDING-LIST.
-KEY-BINDING-LIST is the value of either `hkey-previous-bindings'
-\(key bindings prior to Hyperbole load) or `hkey-bindings' (Hyperbole
-bindings after load)."
- (dolist (key-and-binding key-binding-list)
- (global-set-key (cadr key-and-binding) (car (cddr key-and-binding)))))
-
-(defun hyperbole-toggle-bindings ()
- "Toggle between Hyperbole mouse and keyboard keys and their prior bindings."
- (interactive)
- (let ((key-binding-list (if hkey-bindings-flag
- hkey-previous-bindings
- hkey-bindings))
- (other-bindings-var (if hkey-bindings-flag
- 'hkey-bindings
- 'hkey-previous-bindings)))
- (if key-binding-list
- (progn
- (set other-bindings-var (hkey-get-bindings))
- (hkey-set-bindings key-binding-list)
- (setq hkey-bindings-flag (not hkey-bindings-flag)
- hmouse-bindings-flag (not hmouse-bindings-flag))
- (if (called-interactively-p 'interactive)
- (message "%s mouse and keyboard bindings are now in use."
- (if hkey-bindings-flag "Hyperbole" "Non-Hyperbole"))))
- (error "(hyperbole-toggle-bindings): `%s' is empty"
- (if hkey-bindings-flag 'hkey-previous-bindings 'hkey-bindings)))))
+ (hui-select-initialize)))
;;; ************************************************************************
;;; Load Hyperbole mouse bindings
@@ -427,49 +360,6 @@ directory or directories specified."
(hypb:with-suppressed-warnings ((obsolete update-directory-autoloads))
(update-directory-autoloads dir))))
-;; Before the 6.0.1 release, Hyperbole used to patch the
package-generate-autoloads
-;; function to ensure that kotl/ subdirectories were autoloaded. This
-;; is no longer used but is left here temporarily for reference.
-;;
-;; Ensure Koutliner autoloads in kotl/ subdirectory are generated and loaded.
-;; (unless (or (fboundp 'kotl-mode)
-;; (and (load "hyperbole-autoloads" t t)
-;; (fboundp 'kotl-mode)))
-;; (defun hyperb:package-autoloads-subdirectories-p ()
-;; (require 'package)
-;; (let ((func (symbol-function 'package-generate-autoloads)))
-;; ;; If this function contains a call to apply, then it is patched
-;; ;; with support for finding autoloads in subdirectories and
-;; ;; nothing more need be done.
-;; (if (byte-code-function-p func)
-;; (delq nil (mapcar (lambda (item) (eq item 'apply)) (aref func 2)))
-;; (string-match "(apply " (prin1-to-string func)))))
-
-;; (unless (hyperb:package-autoloads-subdirectories-p)
-;; ;; Function is not patched, so define it here, call it, and then load
-;; ;; the generated autoloads. This will happen maximally only once
-;; ;; per installation of a Hyperbole release.
-;; (if (not (file-writable-p (expand-file-name "hyperbole-autoloads.el"
hyperb:dir)))
-;; (error "(Hyperbole): Failure loading, need write permission to \"%s\""
hyperb:dir))
-;; (defun package-generate-autoloads (name pkg-dir)
-;; (let* ((auto-name (format "%s-autoloads.el" name))
-;; (generated-autoload-file (expand-file-name auto-name pkg-dir))
-;; ;; Silence `autoload-generate-file-autoloads'.
-;; (noninteractive t)
-;; (backup-inhibited t)
-;; (version-control 'never))
-;; (package-autoload-ensure-default-file generated-autoload-file)
-;; (apply #'update-directory-autoloads pkg-dir
-;; (delq nil (mapcar (lambda (f) (and (file-directory-p f)
-;; (not (file-symlink-p f))
-;; f))
-;; (directory-files pkg-dir t "[a-zA-Z].*" nil))))
-;; (let ((buf (find-buffer-visiting generated-autoload-file)))
-;; (when buf (kill-buffer buf)))
-;; auto-name))
-;; (package-generate-autoloads "hyperbole" hyperb:dir))
-;; (load "hyperbole-autoloads"))
-
;; Menu items could call this function before Info is loaded.
(autoload 'Info-goto-node "info" "Jump to specific Info node." t)
@@ -707,16 +597,6 @@ This is used only when running from git source and not a
package release."
;; This call loads the rest of the Hyperbole system.
(require 'hinit)
-(defun hkey-set-key (key command)
- "Define a Hyperbole global minor mode KEY bound to COMMAND."
- (define-key hyperbole-mode-map key command))
-
-(defun hkey-maybe-set-key (key command)
- "Define a Hyperbole global minor mode KEY bound to COMMAND only if not bound
in current keymaps."
- (or (key-binding key)
- (where-is-internal command)
- (hkey-set-key key command)))
-
(defun hyperbole--enable-mode ()
"Enable Hyperbole global minor mode."
;;
diff --git a/hyrolo-logic.el b/hyrolo-logic.el
index 4dd9f99..d1b5285 100644
--- a/hyrolo-logic.el
+++ b/hyrolo-logic.el
@@ -131,8 +131,7 @@ single argument."
(if (= total-matches 1) "y" "ies")))
total-matches))
-(defun hyrolo-logic (sexp &optional in-bufs count-only include-sub-entries
- no-sub-entries-out)
+(defun hyrolo-logic (sexp &optional in-bufs count-only include-sub-entries
no-sub-entries-out)
"Apply SEXP to all entries in optional IN-BUFS, display entries where SEXP
is non-nil.
If IN-BUFS is nil, `hyrolo-file-list' is used. If optional COUNT-ONLY is
non-nil, don't display entries, return count of matching entries only. If
diff --git a/kotl/kexport.el b/kotl/kexport.el
index 350ec80..fa69ad8 100644
--- a/kotl/kexport.el
+++ b/kotl/kexport.el
@@ -510,7 +510,12 @@ hard newlines are not used. Also converts Urls and Klinks
into Html hyperlinks.
(princ "</div>"))))
(when (not is-parent)
(terpri) (terpri)))
- kview t))
+ kview t)
+ ;; Remove any extra newline at the end of any <pre> text
+ (save-excursion
+ (goto-char (point-min))
+ (when (re-search-forward "\r?\n\\'" nil t)
+ (replace-match "" nil nil))))
;; JavaScript
(princ kexport:font-awesome-collapsible-javascript)
(princ "</body></html>\n")))
diff --git a/kotl/kotl-mode.el b/kotl/kotl-mode.el
index 22ce277..d64c3ab 100644
--- a/kotl/kotl-mode.el
+++ b/kotl/kotl-mode.el
@@ -1051,10 +1051,10 @@ whole outline buffer."
(interactive
(let ((label-default (kcell-view:label)))
(hargs:iform-read
- '(interactive
+ `(interactive
(list
(hargs:read "Copy tree without attributes: (0 for whole outline) "
- nil label-default nil 'kcell)
+ nil ,label-default nil 'kcell)
(read-buffer "To buffer: "
(save-window-excursion
(if (one-window-p)
@@ -2386,10 +2386,10 @@ non-nil."
(interactive
(let ((label-default (kcell-view:label)))
(hargs:iform-read
- '(interactive
+ `(interactive
(list
(hargs:read "Mail tree: (0 for whole outline) "
- nil label-default nil 'kcell)
+ nil ,label-default nil 'kcell)
(y-or-n-p "Include invisible text? "))))))
(if (equal cell-ref "0")
(hmail:buffer nil invisible-flag)
diff --git a/man/hyperbole.html b/man/hyperbole.html
index 52c75f3..e23e3d0 100644
--- a/man/hyperbole.html
+++ b/man/hyperbole.html
@@ -1,7 +1,7 @@
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
"http://www.w3.org/TR/html4/loose.dtd";>
<html>
<!-- This manual is for GNU Hyperbole
-(Edition 8.0.0pre, Published May, 2021).
+(Edition 8.0.0pre, Published November, 2021).
Copyright (C) 1989-2021 Free Software Foundation, Inc.
@@ -358,7 +358,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.</P>
<PRE>
Edition 8.0.0pre
-Printed May 16, 2021.
+Printed November 7, 2021.
Published by the Free Software Foundation, Inc.
Author: Bob Weiner
@@ -9017,20 +9017,20 @@ file. For example, <code>(add-hook
'hyperbole-init-hook (lambda ()
(global-set-key "\C-ch" 'hyperbole-toggle-bindings)))</code>.
</p>
<span id="index-file_002c-_002eemacs-5"></span>
-<span id="index-hmouse_002dtoggle_002dbindings"></span>
+<span id="index-hyperbole_002dmode"></span>
<span id="index-mouse-key-toggle"></span>
<span id="index-Smart-Mouse-Key-toggle"></span>
<span id="index-C_002dc-t"></span>
-<p>If you want to restore only the mouse bindings that existed before
-Hyperbole was loaded, use the <code>hmouse-toggle-bindings</code> command.
-It switches between the Hyperbole mouse key bindings and those set
+<p>If you ever want to disable Hyperbole key and mouse bindings, simply toggle
+Hyperbole minor mode off with the <code>hyperbole-mode</code> command.
+It switches between Hyperbole mouse key and mouse bindings and those set
prior to loading Hyperbole and then back again if invoked once more.
There is no default key binding for this command; use <kbd>{M-x
-hmouse-toggle-bindings <span class="key">RET</span>}</kbd>. Alternatively,
you may select a
+hyperbole-mode <span class="key">RET</span>}</kbd>. Alternatively, you may
select a
key and bind it as part of any setting of <code>hyperbole-init-hook</code>
within your personal <samp>~/.emacs</samp> file. For example, <code>(add-hook
'hyperbole-init-hook (lambda () (global-set-key "\C-ct"
-'hmouse-toggle-bindings)))</code>.
+'hyperbole-mode)))</code>.
</p>
<hr>
<span id="Koutliner-Keys"></span><div class="header">
@@ -12748,7 +12748,6 @@ Next: <a href="#Concept-Index" accesskey="n"
rel="next">Concept Index</a>, Previ
<tr><td></td><td valign="top"><a
href="#index-hmouse_002dmiddle_002dflag-1">hmouse-middle-flag</a>:</td><td> </td><td
valign="top"><a href="#Smart-Key-Bindings">Smart Key Bindings</a></td></tr>
<tr><td></td><td valign="top"><a
href="#index-hmouse_002dsetup"><code>hmouse-setup</code></a>:</td><td> </td><td
valign="top"><a href="#Questions-and-Answers">Questions and
Answers</a></td></tr>
<tr><td></td><td valign="top"><a
href="#index-hmouse_002dsetup-1"><code>hmouse-setup</code></a>:</td><td> </td><td
valign="top"><a href="#Questions-and-Answers">Questions and
Answers</a></td></tr>
-<tr><td></td><td valign="top"><a
href="#index-hmouse_002dtoggle_002dbindings"><code>hmouse-toggle-bindings</code></a>:</td><td> </td><td
valign="top"><a href="#Default-Hyperbole-Bindings">Default Hyperbole
Bindings</a></td></tr>
<tr><td></td><td valign="top"><a
href="#index-hmouse_002dx_002ddiagonal_002dsensitivity">hmouse-x-diagonal-sensitivity</a>:</td><td> </td><td
valign="top"><a href="#Smart-Mouse-Drags-within-a-Window">Smart Mouse Drags
within a Window</a></td></tr>
<tr><td></td><td valign="top"><a
href="#index-hmouse_002dx_002ddrag_002dsensitivity">hmouse-x-drag-sensitivity</a>:</td><td> </td><td
valign="top"><a href="#Smart-Mouse-Drags-within-a-Window">Smart Mouse Drags
within a Window</a></td></tr>
<tr><td></td><td valign="top"><a
href="#index-hmouse_002dy_002ddiagonal_002dsensitivity">hmouse-y-diagonal-sensitivity</a>:</td><td> </td><td
valign="top"><a href="#Smart-Mouse-Drags-within-a-Window">Smart Mouse Drags
within a Window</a></td></tr>
@@ -12802,6 +12801,7 @@ Next: <a href="#Concept-Index" accesskey="n"
rel="next">Concept Index</a>, Previ
<tr><td></td><td valign="top"><a
href="#index-hyperbole"><code>hyperbole</code></a>:</td><td> </td><td
valign="top"><a href="#Invocation">Invocation</a></td></tr>
<tr><td></td><td valign="top"><a
href="#index-hyperbole-1"><code>hyperbole</code></a>:</td><td> </td><td
valign="top"><a href="#Smart-Key-_002d-Default-Context">Smart Key - Default
Context</a></td></tr>
<tr><td></td><td valign="top"><a
href="#index-hyperbole_002dinit_002dhook">hyperbole-init-hook</a>:</td><td> </td><td
valign="top"><a href="#Hook-Variables">Hook Variables</a></td></tr>
+<tr><td></td><td valign="top"><a
href="#index-hyperbole_002dmode"><code>hyperbole-mode</code></a>:</td><td> </td><td
valign="top"><a href="#Default-Hyperbole-Bindings">Default Hyperbole
Bindings</a></td></tr>
<tr><td></td><td valign="top"><a
href="#index-hyperbole_002dpopup_002dmenu"><code>hyperbole-popup-menu</code></a>:</td><td> </td><td
valign="top"><a href="#Menus">Menus</a></td></tr>
<tr><td></td><td valign="top"><a
href="#index-hyperbole_002dpopup_002dmenu-1"><code>hyperbole-popup-menu</code></a>:</td><td> </td><td
valign="top"><a href="#Smart-Key-_002d-Default-Context">Smart Key - Default
Context</a></td></tr>
<tr><td></td><td valign="top"><a
href="#index-hyperbole_002dset_002dkey"><code>hyperbole-set-key</code></a>:</td><td> </td><td
valign="top"><a href="#Binding-Minibuffer-Menu-Items">Binding Minibuffer Menu
Items</a></td></tr>
diff --git a/man/hyperbole.info b/man/hyperbole.info
index 9384015..7037977 100644
Binary files a/man/hyperbole.info and b/man/hyperbole.info differ
diff --git a/man/hyperbole.pdf b/man/hyperbole.pdf
index a93a1ce..f9c9f04 100644
Binary files a/man/hyperbole.pdf and b/man/hyperbole.pdf differ
diff --git a/man/hyperbole.texi b/man/hyperbole.texi
index 2acefd3..b2e0dac 100644
--- a/man/hyperbole.texi
+++ b/man/hyperbole.texi
@@ -155,7 +155,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.</P>
<PRE>
Edition 8.0.0pre
-Printed May 16, 2021.
+Printed November 7, 2021.
Published by the Free Software Foundation, Inc.
Author: Bob Weiner
@@ -197,7 +197,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
@example
Edition 8.0.0pre
-May 16, 2021
+November 7, 2021
Published by the Free Software Foundation, Inc.
Author: Bob Weiner
@@ -7723,20 +7723,20 @@ file. For example, @code{(add-hook
'hyperbole-init-hook (lambda ()
(global-set-key "\C-ch" 'hyperbole-toggle-bindings)))}.
@vindex file, .emacs
-@findex hmouse-toggle-bindings
+@findex hyperbole-mode
@cindex mouse key toggle
@cindex Smart Mouse Key toggle
@kindex C-c t
-If you want to restore only the mouse bindings that existed before
-Hyperbole was loaded, use the @code{hmouse-toggle-bindings} command.
-It switches between the Hyperbole mouse key bindings and those set
+If you ever want to disable Hyperbole key and mouse bindings, simply toggle
+Hyperbole minor mode off with the @code{hyperbole-mode} command.
+It switches between Hyperbole mouse key and mouse bindings and those set
prior to loading Hyperbole and then back again if invoked once more.
There is no default key binding for this command; use @bkbd{M-x
-hmouse-toggle-bindings @key{RET}}. Alternatively, you may select a
+hyperbole-mode @key{RET}}. Alternatively, you may select a
key and bind it as part of any setting of @code{hyperbole-init-hook}
within your personal @file{~/.emacs} file. For example, @code{(add-hook
'hyperbole-init-hook (lambda () (global-set-key "\C-ct"
-'hmouse-toggle-bindings)))}.
+'hyperbole-mode)))}.
@node Koutliner Keys, Smart Key Reference, Hyperbole Key Bindings, Top
@appendix Koutliner Keys
diff --git a/man/version.texi b/man/version.texi
index 608d0ec..58f9b6f 100644
--- a/man/version.texi
+++ b/man/version.texi
@@ -1,4 +1,4 @@
-@set UPDATED May, 2021
-@set UPDATED-MONTH May 2021
+@set UPDATED November, 2021
+@set UPDATED-MONTH November 2021
@set EDITION 8.0.0pre
@set VERSION 8.0.0pre
diff --git a/test/hbut-tests.el b/test/hbut-tests.el
index 575a40b..66fa4be 100644
--- a/test/hbut-tests.el
+++ b/test/hbut-tests.el
@@ -21,7 +21,7 @@
(require 'el-mock)
(defun hbut-tests:should-match-tmp-folder (tmp)
- "Check that TMP match either a list of a single element of \"/tmp\" or
\"private/tmp\".
+ "Check that TMP matches either a list of a single element of \"/tmp\" or
\"private/tmp\".
Needed since hyperbole expands all links to absolute paths and
/tmp can be a symbolic link."
(should (member tmp '(("/tmp") ("./tmp") ("/private/tmp")))))
@@ -70,11 +70,9 @@ Needed since hyperbole expands all links to absolute paths
and
(find-file file)
(ebut:program "label" 'link-to-directory "/tmp")
(should (hbut:at-p))
- (let ((args (hbut:delete)))
+ (let ((success-flag (hui:hbut-delete)))
(should-not (hbut:at-p))
- (should (equal (hbdata:actype args) "actypes::link-to-directory"))
- (hbut-tests:should-match-tmp-folder (hbdata:args args))
- ))
+ (should (eq success-flag t))))
(delete-file file))))
(ert-deftest gbut-program-calls-ebut-program ()
diff --git a/test/hmouse-drv-tests.el b/test/hmouse-drv-tests.el
index 33aef19..0e6d4ea 100644
--- a/test/hmouse-drv-tests.el
+++ b/test/hmouse-drv-tests.el
@@ -452,10 +452,10 @@
;; info-node
(ert-deftest hbut-info-node-test ()
- "Got to info node."
+ "Test Info node link."
(unwind-protect
(with-temp-buffer
- (insert "\"(emacs)top\"")
+ (insert "\"(emacs)Top\"")
(goto-char 6)
(action-key)
(should (string= "*info*" (buffer-name))))