[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/hyperbole a923edcf01 11/16: Merge branch 'master' into
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/hyperbole a923edcf01 11/16: Merge branch 'master' into add-pathname-with-line-number-spec-test |
|
Date: |
Tue, 1 Aug 2023 03:58:12 -0400 (EDT) |
branch: externals/hyperbole
commit a923edcf01702f317adf2264e8f348143fa39a7b
Merge: e75a1d30d4 3a45510382
Author: Robert Weiner <rsw@gnu.org>
Commit: GitHub <noreply@github.com>
Merge branch 'master' into add-pathname-with-line-number-spec-test
---
.gitignore | 1 +
ChangeLog | 63 +++++++++++++++-
Makefile | 4 +-
hargs.el | 177 +++++++++++++++++++++++++++++----------------
hbut.el | 119 +++++++++++++++++-------------
hib-social.el | 23 ++++--
hmouse-drv.el | 32 ++++----
hmouse-tag.el | 6 +-
hsys-org.el | 10 ++-
hui-mouse.el | 4 +-
hui.el | 10 ++-
hypb-ert.el | 29 +++++---
hyperbole.el | 9 ++-
install-test/MANIFEST | 1 +
install-test/elpaca/.emacs | 68 +++++++++++++++++
kotl/kfill.el | 20 +++--
kotl/kotl-mode.el | 58 ++++++++-------
test/hbut-tests.el | 67 +++++++++--------
18 files changed, 469 insertions(+), 232 deletions(-)
diff --git a/.gitignore b/.gitignore
index 4fa7d9afce..eeb068dfbb 100644
--- a/.gitignore
+++ b/.gitignore
@@ -32,3 +32,4 @@ TODO*
# Video Demos
videos
+*.el
diff --git a/ChangeLog b/ChangeLog
index 545ee5368e..6eecf0281b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,49 @@
+2023-07-30 Bob Weiner <rsw@gnu.org>
+
+* kotl/kotl-mode.el (kotl-mode:next-line, kotl-mode:previous-line): Fix that
moving from
+ 2nd line to first triggers a begin-of-buffer error and the same at the end
of the
+ buffer.
+
+* kotl/kfill.el (kfill:forward-line): Fix to report number of lines left to
move relative
+ to N.
+
+* hmouse-tag.el (smart-tags-display): Replace obsolete 'find-tag' call with
+ 'xref-find-definitions'.
+
+* hargs.el (hargs:at-p): FIX: Ensure 'vertico-mouse--index' is fboundp before
calling it.
+ Also fix to return whole string rather than the empty string when point is
at the
+ end of the minibuffer.
+ (hargs:select-p): Clarify potential use of 'value' argument in doc
str.
+ Also fix so during completion, minibuffer contents are not used unless
they match
+ a valid completion or are empty and default can be used.
+ (hargs:match-p): Add for when vertico.el is not available and use in
+ `hargs:select-p'.
+
+* hmouse-drv.el (action-key, action-key-internal): FIX: Set
'action-key-depressed-flag'
+ to t when executing keyboard action-key actions.
+ (assist-key, assist-key-internal): FIX: Set
'assist-key-depressed-flag'
+ to t when executing keyboard assist-key actions.
+
+* hsys-org.el (hsys-org-global-cycle, hsys-org-cycle): FIX: Temp move point to
beginning
+ of heading so TAB invocations cycle through all states properly.
+
+2023-07-24 Mats Lidell <matsl@gnu.org>
+
+* Makefile (install-elpaca):
+ install-test/MANIFEST:
+ install-test/elpaca/.emacs: Add elpaca install test.
+
+2023-07-22 Bob Weiner <rsw@gnu.org>
+
+* hargs.el (hargs:at-p): Make Action Keyboard Key behave the same as the
Action Mouse
+ Key when in the minibuffer, deleting any characters to the right of point
to
+
+2023-07-17 Bob Weiner <rsw@gnu.org>
+
+* hypb-ert.el (require): Wrap 'eval-and-compile' call around this to force
require
+ of "hbut" which defines 'defal' and prevents compilation error when
"hibtypes"
+ tries to load this.
+
2023-07-14 Mats Lidell <matsl@gnu.org>
* test/hmouse-drv-tests.el (hbut-pathname-line-test)
@@ -13,7 +59,7 @@
2023-07-11 Mats Lidell <matsl@gnu.org>
* Makefile (version, $(pkg_parent)/hyperbole-$(HYPB_VERSION).tar): Do not
- include hyperbole-pgk.el. It is generated by elpa and not needed for a
+ include hyperbole-el.pkg. It is generated by elpa and not needed for a
plain tar archive of the package.
2023-07-10 Mats Lidell <matsl@gnu.org>
@@ -27,7 +73,7 @@
* hycontrol.el:
hui-mouse.el:
hmouse-drv.el:
- hyrolo.el: Public declarations added for multiple packages.
+ hyrolo.el: Add public declarations for multiple libraries.
* hargs.el: Add public declarations for vertico and ivy.
@@ -37,8 +83,21 @@
2023-07-09 Bob Weiner <rsw@gnu.org>
+* hbut.el (ibut:delimit): Add name separator after delimiting name if not
already
+ there but ensure point stays at end of the delimited name.
+ (ibut:operate): Update doc string with caller responsibilities.
+ (ibut:program): Fix to send 'edit-flag' to 'ibut:operate' call when
point
+ is on an existing ibutton. Remove 'cannot nest error' since
'ibut:operate' will
+ now modify the existing ibutton.
+ (ibut:insert-text): Don't insert name separator if looking at one in
the buffer.
+ (ibut:operate): Fix to not trigger an error when adding a name to an
ibut
+ that does not have one.
+
* hypb-ert.el (hypb-ert-*): Change all calls of 'ert' to disable ert's messages
so that any test's message is displayed after an hypb-ert test case run.
+ (hypb-ert): Change 'ert' calls to use 'hypb-ert' and centralize
+ 'message' function override when possible to deal with different 'ert'
+ calling conventions in different Emacs versions.
* hbut.el (ibut:operate): Update doc of each state.
diff --git a/Makefile b/Makefile
index 533ac4134c..334f4ec6d2 100644
--- a/Makefile
+++ b/Makefile
@@ -3,7 +3,7 @@
# Author: Bob Weiner
#
# Orig-Date: 15-Jun-94 at 03:42:38
-# Last-Mod: 11-Jul-23 at 10:48:40 by Mats Lidell
+# Last-Mod: 24-Jul-23 at 20:25:51 by Mats Lidell
#
# Copyright (C) 1994-2023 Free Software Foundation, Inc.
# See the file HY-COPY for license information.
@@ -509,7 +509,7 @@ test-all-output:
.PHONY: install-elpa install-elpa-devel install-tarball install-straight
install-all install-local
install-all: install-elpa install-elpa-devel install-tarball install-straight
install-local
-install-elpa install-elpa-devel install-tarball install-straight:
+install-elpa install-elpa-devel install-tarball install-straight
install-elpaca:
@echo "Install Hyperbole using $@"
(cd ./install-test/ && ./local-install-test.sh $(subst install-,,$@))
diff --git a/hargs.el b/hargs.el
index bf582b5033..20a04215d6 100644
--- a/hargs.el
+++ b/hargs.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 31-Oct-91 at 23:17:35
-;; Last-Mod: 11-Jul-23 at 10:36:27 by Mats Lidell
+;; Last-Mod: 30-Jul-23 at 13:15:34 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -270,6 +270,18 @@ two variables `prompt' and `default'."
iform-alist)
,vecsym)))
+;; Replicated from `vertico--match-p' in "vertico.el"
+(defun hargs:match-p (str)
+ "Return t if STR is a valid completion match."
+ (let ((rm minibuffer--require-match))
+ (or (memq rm '(nil confirm-after-completion))
+ (equal "" str) ;; Null completion, returns default value
+ (and (functionp rm) (funcall rm str)) ;; Emacs 29 supports functions
+ (test-completion str minibuffer-completion-table
minibuffer-completion-predicate)
+ (if (eq rm 'confirm)
+ (eq (ignore-errors (read-char "Confirm")) 13)
+ (minibuffer-message "Match required") nil))))
+
(defun hargs:prompt (prompt default &optional default-prompt)
"Return string of PROMPT including DEFAULT.
Optional DEFAULT-PROMPT is used to describe default value."
@@ -349,41 +361,62 @@ Handles all of the interactive argument types that
`hargs:iform-read' does."
;; Ensure vertico is prompting for an argument
(vertico--command-p nil (current-buffer))
(active-minibuffer-window))
- (if (and action-key-release-args
- (fboundp #'vertico-mouse--index)
- (eq (posn-window (event-end action-key-release-args))
- (active-minibuffer-window)))
- (with-selected-window (active-minibuffer-window)
- (let ((index (vertico-mouse--index action-key-release-args))
- mini)
- (if index
- (save-excursion
- (vertico--goto index)
- (vertico--update t)
- (vertico--candidate))
- ;; Assume event occurred within the
- ;; minibufer-contents and return just the contents
- ;; before point so that those after are deleted and
- ;; more completions are shown.
- (setq mini (minibuffer-contents-no-properties))
- ;; The minibuffer may have some read-only contents
- ;; at the beginning, e.g. M-x, not included in the 'mini'
- ;; string, so we have to offset the max index into
- ;; the string in such cases and protect against
- ;; when point is set into this read-only area with
- ;; the 'max' call below.
- (list (substring mini 0 (max (- (point) (point-max)) (-
(length mini)))) nil))))
- (list (vertico--candidate) t)))
+ (cond
+ ((or
+ ;; Action Key press
+ (and action-key-depressed-flag
+ (eq (selected-window) (active-minibuffer-window)))
+ ;; Action Mouse Key press
+ (and action-key-release-args
+ (fboundp #'vertico-mouse--index)
+ (eq (posn-window (event-end action-key-release-args))
+ (active-minibuffer-window))))
+ (with-selected-window (active-minibuffer-window)
+ (let ((index (when (and action-key-release-args
+ (fboundp #'vertico-mouse--index))
+ (vertico-mouse--index action-key-release-args)))
+ mini
+ mini-to-point)
+ (if index
+ (save-excursion
+ (vertico--goto index)
+ (vertico--update t)
+ (vertico--candidate))
+ ;; Assume event occurred within the minibufer-contents
+ ;; and return just the contents before point so
+ ;; that those after are deleted and more
+ ;; completions are shown.
+ (setq mini (minibuffer-contents-no-properties))
+ ;; The minibuffer may have some read-only contents
+ ;; at the beginning, e.g. M-x, not included in the 'mini'
+ ;; string, so we have to offset the max index into
+ ;; the string in such cases and protect against
+ ;; when point is set into this read-only area with
+ ;; the 'max' call below.
+ (setq mini-to-point (substring mini 0 (max (- (point)
(point-max)) (- (length mini)))))
+ (list (if (and (= (point) (point-max)) (string-empty-p
mini-to-point))
+ mini
+ mini-to-point)
+ nil)))))
+ (t (list (vertico--candidate) t))))
((and (null hargs:reading-type)
- action-key-release-args
- (eq (posn-window (event-end action-key-release-args))
- (active-minibuffer-window)))
- ;; Event occurred within the minibufer-contents and return
+ (or
+ ;; Action Key press
+ (and action-key-depressed-flag
+ (eq (selected-window) (active-minibuffer-window)))
+ ;; Action Mouse Key press
+ (and action-key-release-args
+ (eq (posn-window (event-end action-key-release-args))
+ (active-minibuffer-window)))))
+ ;; Event occurred within the minibufer-contents. Return
;; just the contents before point so that those after are
;; deleted and more completions are shown.
- (let (mini)
- (setq mini (minibuffer-contents-no-properties))
- (list (substring mini 0 (max (- (point) (point-max)) (- (length
mini)))) nil)))
+ (let* ((mini (minibuffer-contents-no-properties))
+ (mini-to-point (substring mini 0 (max (- (point) (point-max))
(- (length mini))))))
+ (list (if (and (= (point) (point-max)) (string-empty-p
mini-to-point))
+ mini
+ mini-to-point)
+ nil)))
((and (eq hargs:reading-type 'kcell)
(eq major-mode 'kotl-mode)
(not (looking-at "^$")))
@@ -728,16 +761,23 @@ of value to be read."
(switch-to-buffer obuf))))))
(defun hargs:select-p (&optional value assist-bool)
- "Return optional VALUE or value selected at point if any, else nil.
-If value is the same as the contents of the minibuffer, it is used as
-the current minibuffer argument, otherwise, the minibuffer is erased
-and value is inserted there.
-Optional ASSIST-BOOL non-nil triggers display of Hyperbole menu item
-help when appropriate."
+ "Return optional VALUE or value in the minibuffer if any, else nil.
+If VALUE is a list, it must be of the form:
+\(<str-to-compare-against-minibuffer-contents> <is-exact-completion-flag>).
+The first argument is then set to VALUE. If
+<is-exact-completion-flag> is non-null, then Hyperbole will not try to
+show completions for VALUE when standard completion is used.
+
+If VALUE is the same as the contents of the minibuffer, it is
+used as the desired minibuffer argument and the minibuffer is
+exited; otherwise, the minibuffer is erased and VALUE is inserted
+there. Optional ASSIST-BOOL non-nil triggers display of
+Hyperbole menu item help when appropriate."
(when (and (> (minibuffer-depth) 0) (or value (setq value (hargs:at-p))))
(let ((owind (selected-window)) (back-to)
;; This command requires recursive minibuffers.
- (enable-recursive-minibuffers t))
+ (enable-recursive-minibuffers t)
+ mini)
(when (stringp value)
(setq value (list value nil)))
(unwind-protect
@@ -745,6 +785,7 @@ help when appropriate."
(setq str-value (and str-value (format "%s" str-value)))
(select-window (minibuffer-window))
(set-buffer (window-buffer (minibuffer-window)))
+ (setq mini (minibuffer-contents-no-properties))
(cond
;;
;; Selecting a Hyperbole minibuffer menu item
@@ -753,35 +794,38 @@ help when appropriate."
(setq hargs:reading-type 'hmenu-help))
(hui:menu-enter str-value))
;;
- ;; Exit minibuffer and use its existing value as the desired
parameter.
- ((string-equal str-value (minibuffer-contents))
+ ;; Exit minibuffer and use its existing value as the desired
parameter
+ ;; if value matches a completion and the minibuffer contents.
+ ;;
+ ;; with vertico-mode
+ ((and (bound-and-true-p vertico-mode)
+ ;; Ensure vertico is prompting for an argument
+ (vertico--command-p nil (current-buffer))
+ (string-equal str-value mini)
+ (vertico--match-p str-value))
(goto-char (point-max))
- (cond
- ;; vertico-mode
- ((and (bound-and-true-p vertico-mode)
- ;; Ensure vertico is prompting for an argument
- (vertico--command-p nil (current-buffer)))
- (vertico-exit))
- ;; ivy-mode
- ((bound-and-true-p ivy-mode)
- (if assist-bool
- (ivy-dispatching-done)
- (ivy-done)))
- ;; standard minibuffer completion
- (t (exit-minibuffer))))
+ (vertico-exit))
+ ;; with ivy-mode
+ ((and (bound-and-true-p ivy-mode)
+ (string-equal str-value mini)
+ (hargs:match-p str-value))
+ (goto-char (point-max))
+ (if assist-bool
+ (ivy-dispatching-done)
+ (ivy-done)))
+ ;; with standard minibuffer completion
+ ((and (string-equal str-value mini)
+ (hargs:match-p str-value))
+ (goto-char (point-max))
+ (exit-minibuffer))
;;
- ;; Clear minibuffer and insert value.
+ ;; Value is different than minibuffer contents; clear
+ ;; minibuffer and insert value.
(t
(delete-minibuffer-contents)
(goto-char (point-max))
(cond
- ;; ivy-mode
- ((bound-and-true-p ivy-mode)
- (if assist-bool
- (ivy-dispatching-done)
- (ivy-done)))
- ;; standard minibuffer completion
- ;; vertico-mode
+ ;; with vertico-mode
((and (bound-and-true-p vertico-mode)
;; Ensure vertico is prompting for an argument
(vertico--command-p nil (current-buffer)))
@@ -789,6 +833,13 @@ help when appropriate."
(insert str-value)
(vertico-insert))
(vertico--update t))
+ ;; with ivy-mode
+ ((bound-and-true-p ivy-mode)
+ (insert str-value)
+ (if assist-bool
+ (ivy-dispatching-done)
+ (ivy-done)))
+ ;; with standard minibuffer completion
(t
(insert str-value)
(unless exact-completion-flag
diff --git a/hbut.el b/hbut.el
index ec56853ba0..2f26608232 100644
--- a/hbut.el
+++ b/hbut.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 18-Sep-91 at 02:57:09
-;; Last-Mod: 9-Jul-23 at 02:09:54 by Bob Weiner
+;; Last-Mod: 15-Jul-23 at 23:22:28 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -1950,9 +1950,12 @@ Insert INSTANCE-FLAG after END, before ending delimiter."
;; Insert any comment delimiter before the start marker.
(set-marker-insertion-type start t)
(hbut:comment start end)
- (when (fboundp 'hproperty:but-add)
- (hproperty:but-add start end hproperty:ibut-face))
- (goto-char end)
+ (let ((delim-end (point)))
+ (unless (looking-at ibut:label-separator-regexp)
+ (insert ibut:label-separator))
+ (when (fboundp 'hproperty:but-add)
+ (hproperty:but-add start end hproperty:ibut-face))
+ (goto-char delim-end))
(move-marker start nil)
(move-marker end nil)
t))
@@ -2018,8 +2021,8 @@ arguments). If delimiters are given as arguments, return
the key form
of the implicit button text at point between those delimiters.
Use `ibut:at-p' instead to test if point is on either the
-implicit button text itself or the label. Assume point is within the
-first line of any button label.
+implicit button text itself or the name. Assume point is within the
+first line of any button.
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
@@ -2172,6 +2175,12 @@ move to the first occurrence of the button."
(defun ibut:operate (&optional new-name edit-flag)
"Insert/modify an ibutton based on `hbut:current' in current buffer.
+
+Caller must either call `hbut:at-p' or manually set the attributes of
+`hbut:current' prior to invoking this function. If point is on an existing
+Hyperbole button, `edit-flag' must be set to t; otherwise, this may create
+a new ibutton inserted within the prior one, making the prior one unusable.
+
Optional non-nil NEW-NAME is new name to give button. With optional
EDIT-FLAG non-nil, modify an existing in-buffer ibutton rather
than creating a new one.
@@ -2187,19 +2196,19 @@ Summary of operations based on inputs (name arg comes
from \\='hbut:current attr
|----+------+----------+--------+------+-----------------------------------------------|
| # | name | new-name | region | edit | operation
|
|----+------+----------+--------+------+-----------------------------------------------|
-| 1 | nil | nil | nil | nil | create: unnamed ibut from
hbut:current attrs |
-| 2 | nil | new-name | nil | nil | ERROR: create can't rename without
edit flag |
-| 3 | name | nil | nil | nil | create: ibut with name
|
-| 4 | name | new-name | nil | nil | ERROR: create can't have name and
new-name |
-| 5 | name | new-name | region | nil | ERROR: create can't have name and
new-name |
+|* 1 | nil | nil | nil | nil | create: unnamed ibut from
hbut:current attrs |
+| 2 | nil | new-name | nil | nil | ERROR: edit-flag must be t to set
new-name |
+|* 3 | name | nil | nil | nil | create: ibut with name
|
+|* 4 | name | new-name | nil | nil | ERROR: create can't have name and
new-name |
+|* 5 | name | new-name | region | nil | ERROR: create can't have name and
new-name |
| 6 | name | nil | region | nil | create: ibut with name (ignore
region) |
-| 7 | nil | nil | region | nil | create: region named ibut
|
-| 8 | nil | new-name | region | nil | create: ibut with new-name (ignore
region) |
+|* 7 | nil | nil | region | nil | create: region named ibut
|
+| 8 | nil | new-name | region | nil | ERROR: edit-flag must be t to set
new-name |
|----+------+----------+--------+------+-----------------------------------------------|
-| 9 | nil | nil | nil | t | mod: remove any name from ibut
|
-| 10 | nil | new-name | nil | t | mod: set ibut's name to new-name
|
-| 11 | name | nil | nil | t | mod: name of ibut from hbut:current
attrs |
-| 12 | name | new-name | nil | t | mod: rename ibut with name to
new-name |
+|* 9 | nil | nil | nil | t | mod: remove any name from ibut
|
+|*10 | nil | new-name | nil | t | mod: add new-name as ibut's name
attribute |
+|*11 | name | nil | nil | t | mod: name of ibut from hbut:current
attrs |
+|*12 | name | new-name | nil | t | mod: rename ibut with name to
new-name |
| 13 | name | new-name | region | t | ERROR: Can't use region to mod
existing ibut |
| 14 | name | nil | region | t | ERROR: Can't use region to mod
existing ibut |
| 15 | nil | nil | region | t | ERROR: Can't use region to mod
existing ibut |
@@ -2211,13 +2220,14 @@ Summary of operations based on inputs (name arg comes
from \\='hbut:current attr
(region-flag (hmouse-use-region-p))
(instance-flag))
(unless actype
- (hypb:error "(ibut:operate): hbut:current ibut actype (%s) must be
non-nil"
- actype))
+ (hypb:error "(ibut:operate): hbut:current actype must be non-nil"))
(when (and new-name (or (not (stringp new-name)) (string-empty-p
new-name)))
(hypb:error "(ibut:operate): 'new-name' value must be a non-empty
string, not: '%s'"
new-name))
(when (and name new-name (not edit-flag))
(hypb:error "(ibut:operate): 'edit-flag' must be t to rename a button
(hbut:current name and new-name both given)"))
+ (when (and new-name (not edit-flag))
+ (hypb:error "(ibut:operate): 'edit-flag' must be t to rename a button"))
(when (and region-flag edit-flag)
(hypb:error "(ibut:operate): 'edit-flag' must be nil when region is
highlighted to use region as new button name"))
@@ -2257,8 +2267,7 @@ Summary of operations based on inputs (name arg comes
from \\='hbut:current attr
(progn (insert new-name) (point))
instance-flag))
name-regexp 'include-delims))
- (at-but)
- ((hypb:error "(ibut:operate): No button matching:
%s" name)))))
+ (at-but))))
(new-name
;; Add new-name to nameless button at point
(goto-char (or (hattr:get 'hbut:current 'lbl-start)
(point)))
@@ -2352,8 +2361,7 @@ Summary of operations based on inputs (name arg comes
from \\='hbut:current attr
(ibut:at-p)) ;; Sets lbl-key for non-delimited ibtypes
(setq lbl-key (hattr:get 'hbut:current 'lbl-key))))
(unless (and (stringp lbl-key) (not (string-empty-p lbl-key)))
- (hypb:error "(ibut:operate): hbut:current ibut lbl-key '%s' must be
non-nil"
- lbl-key)))
+ (hypb:error "(ibut:operate): hbut:current lbl-key must be non-nil")))
(run-hooks (if edit-flag 'ibut-edit-hook 'ibut-create-hook))
@@ -2362,8 +2370,10 @@ Summary of operations based on inputs (name arg comes
from \\='hbut:current attr
(defun ibut:insert-text (ibut)
"Space, delimit and insert the activatable text of IBUT."
- (when (not (string-empty-p (or (hattr:get ibut 'name) "")))
- (insert ibut:label-separator))
+ (cond ((looking-at ibut:label-separator-regexp)
+ (goto-char (match-end 0)))
+ ((not (or (string-empty-p (or (hattr:get ibut 'name) ""))))
+ (insert ibut:label-separator)))
(let* ((orig-actype (or (hattr:get ibut 'actype)
(hattr:get ibut 'categ)))
(actype (or (actype:elisp-symbol orig-actype)
@@ -2464,33 +2474,38 @@ function, followed by a list of arguments for the
actype, aside from
the button NAME which is automatically provided as the first argument.
For interactive creation, use `hui:ibut-create' instead."
- ;; Throw an error if on a named or delimited Hyperbole button since
- ;; cannot create another button within such contexts.
- (when (hbut:at-p)
- (let ((name (hattr:get 'hbut:current 'name))
- (lbl (hbut:key-to-label (hattr:get 'hbut:current 'lbl-key)))
- (lbl-start (hattr:get 'hbut:current 'lbl-start))
- (lbl-end (hattr:get 'hbut:current 'lbl-end)))
- (when (or name lbl (and lbl-start lbl-end))
- (error "(ibut:program): Cannot nest an ibut within the existing button:
%s"
- (or name lbl (buffer-substring-no-properties lbl-start
lbl-end))))))
- (save-excursion
- (let ((but-buf (current-buffer))
- (actype-sym (actype:action actype)))
- (hui:buf-writable-err but-buf "ibut:program")
- (hattr:clear 'hbut:current)
- (hattr:set 'hbut:current 'name name)
- (hattr:set 'hbut:current 'categ 'implicit)
- (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
- (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
- (if (or (and actype-sym (fboundp actype-sym))
- (functionp actype))
- (hattr:set 'hbut:current 'actype actype)
- (error "actype arg must be a bound symbol (not a string): %S" actype))
- (hattr:set 'hbut:current 'args args)
- (condition-case err
- (ibut:operate)
- (error "(ibut:program): name: %S actype: %S args: %S - %S" name actype
args err)))))
+ (hui:buf-writable-err (current-buffer) "ibut:program")
+ (when (ebut:at-p)
+ (error "(ibut:program): Move off explicit button at point to create an
implicit button"))
+ (let ((ibut (ibut:at-p)))
+ ;; Throw an error if on a named or delimited Hyperbole button since
+ ;; cannot create another button within such contexts.
+ (when ibut
+ (let ((name (hattr:get ibut 'name))
+ (lbl (hbut:key-to-label (hattr:get ibut 'lbl-key)))
+ (lbl-start (hattr:get ibut 'lbl-start))
+ (lbl-end (hattr:get ibut 'lbl-end)))
+ (when (or name lbl (and lbl-start lbl-end))
+ (error "(ibut:program): Cannot nest an ibut within the existing
button: '%s'"
+ (or name lbl (buffer-substring-no-properties lbl-start
lbl-end))))))
+
+ (save-excursion
+ (let ((but-buf (current-buffer))
+ (actype-sym (actype:action actype)))
+ (hui:buf-writable-err but-buf "ibut:program")
+ (hattr:clear 'hbut:current)
+ (hattr:set 'hbut:current 'name name)
+ (hattr:set 'hbut:current 'categ 'implicit)
+ (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
+ (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
+ (if (or (and actype-sym (fboundp actype-sym))
+ (functionp actype))
+ (hattr:set 'hbut:current 'actype actype)
+ (error "actype arg must be a bound symbol (not a string): %S" actype))
+ (hattr:set 'hbut:current 'args args)
+ (condition-case err
+ (ibut:operate)
+ (error "(ibut:program): name: %S actype: %S args: %S - %S" name
actype args err))))))
(defun ibut:rename (old-lbl new-lbl)
"Change an implicit button name in the current buffer from OLD-LBL to
NEW-LBL.
diff --git a/hib-social.el b/hib-social.el
index c51e612768..2b496397e3 100644
--- a/hib-social.el
+++ b/hib-social.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 20-Jul-16 at 22:41:34
-;; Last-Mod: 10-Jul-23 at 12:03:12 by Mats Lidell
+;; Last-Mod: 17-Jul-23 at 00:22:44 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -197,31 +197,38 @@
(defcustom hibtypes-social-display-function #'browse-url
"Function of one arg, url, to display when activating a social media
reference."
- :type 'function)
+ :type 'function
+ :group 'hyperbole-buttons)
(defcustom hibtypes-git-default-project nil
"Default project name to associate with any local git commit link."
- :type 'string)
+ :type 'string
+ :group 'hyperbole-buttons)
(defcustom hibtypes-git-use-magit-flag nil
"Non-nil means use `magit' rather than `dired' for a git directory button."
- :type 'boolean)
+ :type 'boolean
+ :group 'hyperbole-buttons)
(defcustom hibtypes-github-default-project nil
"Default project name to associate with any Github commit link."
- :type 'string)
+ :type 'string
+ :group 'hyperbole-buttons)
(defcustom hibtypes-github-default-user nil
"Default user name to associate with any Github commit link."
- :type 'string)
+ :type 'string
+ :group 'hyperbole-buttons)
(defcustom hibtypes-gitlab-default-project nil
"Default project name to associate with any Github commit link."
- :type 'string)
+ :type 'string
+ :group 'hyperbole-buttons)
(defcustom hibtypes-gitlab-default-user nil
"Default user name to associate with any Github commit link."
- :type 'string)
+ :type 'string
+ :group 'hyperbole-buttons)
;;; ************************************************************************
;;; Public declarations
diff --git a/hmouse-drv.el b/hmouse-drv.el
index 718c6692fd..39c20ef167 100644
--- a/hmouse-drv.el
+++ b/hmouse-drv.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 04-Feb-90
-;; Last-Mod: 10-Jul-23 at 12:24:50 by Mats Lidell
+;; Last-Mod: 30-Jul-23 at 10:06:29 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -48,14 +48,14 @@ See function `hmouse-window-at-absolute-pixel-position' for
more details.")
(defvar action-key-depressed-flag nil "t while Action Key is depressed.")
(defvar assist-key-depressed-flag nil "t while Assist Key is depressed.")
(defvar action-key-depress-args nil
- "List of mouse event args from most recent depress of the Action Key.")
+ "List of event args from most recent depress of the Action Mouse Key.")
(defvar assist-key-depress-args nil
- "List of mouse event args from most recent depress of the Assist Key.")
+ "List of event args from most recent depress of the Assist Mouse Key.")
(defvar action-key-release-args nil
- "List of mouse event args from most recent release of the Action Key.")
+ "List of event args from most recent release of the Action Mouse Key.")
(defvar assist-key-release-args nil
- "List of mouse event args from most recent release of the Assist Key.")
+ "List of event args from most recent release of the Assist Mouse Key.")
(defvar action-key-depress-buffer nil
"The last buffer in which the Action Key was depressed or nil.
@@ -334,11 +334,13 @@ unless the `action-key-default-function' variable is not
bound to
a valid function."
(interactive)
(action-key-clear-variables)
- (prog1 (action-key-internal)
- (run-hooks 'action-key-depress-hook 'action-key-release-hook)))
+ (unwind-protect
+ (prog1 (action-key-internal)
+ (run-hooks 'action-key-depress-hook 'action-key-release-hook))
+ (setq action-key-depressed-flag nil)))
(defun action-key-internal ()
- (setq action-key-depressed-flag nil)
+ (setq action-key-depressed-flag t)
(when action-key-cancelled
(setq action-key-cancelled nil
assist-key-depressed-flag nil))
@@ -355,11 +357,13 @@ non-nil unless `assist-key-default-function' variable is
not
bound to a valid function."
(interactive)
(assist-key-clear-variables)
- (prog1 (assist-key-internal)
- (run-hooks 'assist-key-depress-hook 'assist-key-release-hook)))
+ (unwind-protect
+ (prog1 (assist-key-internal)
+ (run-hooks 'assist-key-depress-hook 'assist-key-release-hook))
+ (setq assist-key-depressed-flag nil)))
(defun assist-key-internal ()
- (setq assist-key-depressed-flag nil)
+ (setq assist-key-depressed-flag t)
(when assist-key-cancelled
(setq assist-key-cancelled nil
action-key-depressed-flag nil))
@@ -791,13 +795,13 @@ buffer to the end window. The selected window does not
change."
(if (fboundp #'aw-select) ;; ace-window selection
(let ((aw-scope 'global))
(aw-select "Select link referent window"))
- (message "Now click on the %s end window..." func)
- (let (end-event)
+ (message "Now click on the end window...")
+ (let (end-event)
(prog1 (cl-loop do (setq end-event (read-event))
until (and (mouse-event-p end-event)
(not (string-match "\\`down-"
(symbol-name (car end-event)))))
finally return (posn-window (event-start
end-event)))
- (message "Done"))))))))
+ (message "Done"))))))))
(when (eq link-but-window referent-window)
(error "(hmouse-choose-link-and-referent-windows): No other visible
window with a link referent"))
(unless (window-live-p link-but-window)
diff --git a/hmouse-tag.el b/hmouse-tag.el
index 260fa2d9d4..690e6cb784 100644
--- a/hmouse-tag.el
+++ b/hmouse-tag.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 24-Aug-91
-;; Last-Mod: 19-Jun-23 at 12:54:03 by Bob Weiner
+;; Last-Mod: 30-Jul-23 at 13:50:59 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -1398,12 +1398,12 @@ See the \"${hyperb:dir}/smart-clib-sym\" script for
more information."
;; Signals an error if tag is not found which is caught by
;; many callers of this function.
;; Find exact identifier matches only.
- (with-no-warnings (find-tag (concat "\\`" (regexp-quote tag)
"\\'") nil t)))))
+ (with-no-warnings (xref-find-definitions tag)))))
((or tags-table-list tags-file-name)
;; Signals an error if tag is not found which is caught by
;; many callers of this function.
;; Find exact identifier matches only.
- (with-no-warnings (find-tag (concat "\\`" (regexp-quote tag) "\\'")
nil t)))
+ (with-no-warnings (xref-find-definitions tag)))
(t
(error "No existing tag tables in which to find `%s'" tag)))))
diff --git a/hsys-org.el b/hsys-org.el
index 5134d3ba9f..aea44c4283 100644
--- a/hsys-org.el
+++ b/hsys-org.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 2-Jul-16 at 14:54:14
-;; Last-Mod: 21-May-23 at 04:32:45 by Bob Weiner
+;; Last-Mod: 30-Jul-23 at 09:18:01 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -153,7 +153,9 @@ an error."
(defun hsys-org-cycle ()
"Call `org-cycle' and set as `this-command' to cycle through all states."
(setq this-command 'org-cycle)
- (org-cycle))
+ (save-excursion
+ (org-back-to-heading)
+ (org-cycle)))
(defun hsys-org-get-value (attribute)
"Within the current Org context, return the ATTRIBUTE value."
@@ -167,7 +169,9 @@ an error."
(defun hsys-org-global-cycle ()
"Call `org-global-cycle' and set as `this-command' to cycle through all
states."
(setq this-command 'org-cycle)
- (org-global-cycle nil))
+ (save-excursion
+ (org-back-to-heading)
+ (org-global-cycle nil)))
(defun hsys-org-todo-cycle ()
"Call `org-todo' and set as `this-command' to cycle through all states."
diff --git a/hui-mouse.el b/hui-mouse.el
index 97f1a4bb3a..c9448be23d 100644
--- a/hui-mouse.el
+++ b/hui-mouse.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 04-Feb-89
-;; Last-Mod: 10-Jul-23 at 18:27:44 by Mats Lidell
+;; Last-Mod: 23-Jul-23 at 10:03:27 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -230,7 +230,7 @@ Its default value is `smart-scroll-down'. To disable it,
set it to
(eq (selected-window) (minibuffer-window))
(not (bound-and-true-p ivy-mode))
(not (and (bound-and-true-p vertico-mode)
- ;; Ensure vertico is prompting for an argument
+ ;; Is vertico is prompting for an argument?
(vertico--command-p nil (current-buffer))))
(not (eq hargs:reading-type 'hmenu))
(not (smart-helm-alive-p)))
diff --git a/hui.el b/hui.el
index e29d556015..dfa7552e9b 100644
--- a/hui.el
+++ b/hui.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 19-Sep-91 at 21:42:03
-;; Last-Mod: 10-Jul-23 at 18:31:05 by Mats Lidell
+;; Last-Mod: 17-Jul-23 at 00:21:28 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -927,15 +927,17 @@ and adding any necessary instance number to the button
label.
For programmatic creation, use `ibut:program' instead."
(interactive (list (when (use-region-p) (region-beginning))
(when (use-region-p) (region-end))))
+ (hui:buf-writable-err (current-buffer) "ibut-create")
+ (when (ebut:at-p)
+ (error "(ibut:program): Move off explicit button at point to create an
implicit button"))
(hypb:assert-same-start-and-end-buffer
(let (default-name name but-buf actype)
(setq but-buf (current-buffer))
- (hui:buf-writable-err but-buf "ibut-create")
(hattr:clear 'hbut:current)
;; Throw an error if on a named or delimited Hyperbole button since
;; cannot create another button within such contexts.
- (when (hbut:at-p)
+ (when (ibut:at-p)
(let ((name (hattr:get 'hbut:current 'name))
(lbl (hbut:key-to-label (hattr:get 'hbut:current 'lbl-key)))
(lbl-start (hattr:get 'hbut:current 'lbl-start))
@@ -1706,7 +1708,7 @@ arguments."
(ebut:operate label (when edit-flag label))))
(defun hui:ibut-link-create (edit-flag but-window name-key but-loc but-dir
type-and-args)
- "Create or edit a new Hyperbole implicit link button.
+ "Edit or create a new Hyperbole implicit link button.
With EDIT-FLAG non-nil, edit an existing ibutton at point in
BUT-WINDOW; otherwise, create a new one.
diff --git a/hypb-ert.el b/hypb-ert.el
index d3c0fb58a4..50d860df9e 100644
--- a/hypb-ert.el
+++ b/hypb-ert.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <matsl@gnu.org> and Bob Weiner <rsw@gnu.org>
;;
;; Orig-Date: 31-Mar-21 at 21:11:00
-;; Last-Mod: 8-Jul-23 at 22:22:22 by Bob Weiner
+;; Last-Mod: 16-Jul-23 at 23:47:09 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -29,20 +29,32 @@
;;; Code:
-(mapc #'require '(lisp-mode hload-path ert hbut hargs))
+(eval-and-compile (mapc #'require '(lisp-mode hload-path ert hact hbut hargs)))
+
+(defun hypb-ert-message-function (_msg-pat &rest _args)
+ "Ignore messages ert outputs so can display messages from tests run."
+ ;; (identity (apply #'format msg-pat args)))))))
+ nil)
+
+(defun hypb-ert (selector)
+ (if (memq 'message-fn (actype:params #'ert-run-tests-interactively))
+ ;; Suppress ert messages so last test case message stays in the
minibuffer;
+ ;; 3rd arg message-fn available only in Emacs 27 and earlier
+ (ert selector nil #'hypb-ert-message-function)
+ (ert selector)))
(defun hypb-ert-run-test (test-name)
"Run the specified TEST-NAME ert test."
(hypb-ert-require-libraries)
(let ((test-sym (intern-soft test-name)))
(if test-sym
- (ert test-sym nil #'hypb-ert-message-function)
+ (hypb-ert test-sym)
(user-error "Invalid test name: %s" test-name))))
(defun hypb-ert-run-tests (test-selector)
"Run the specified TEST-SELECTOR defined ert test."
(hypb-ert-require-libraries)
- (ert (regexp-quote test-selector) nil #'hypb-ert-message-function))
+ (hypb-ert (regexp-quote test-selector)))
(defun hypb-ert-get-require-symbols ()
"Return the list of test Lisp library symbols to require."
@@ -60,7 +72,7 @@
"Run every ert test."
(interactive)
(hypb-ert-require-libraries)
- (ert t nil #'hypb-ert-message-function))
+ (hypb-ert t))
;; The following expression is true only when an ert-deftest has been
;; instrumented by edebug:
@@ -94,7 +106,7 @@ test when it is run."
(when (and test-sym (ert-test-boundp test-sym))
(when (and buffer-file-name (string-prefix-p hyperb:dir
buffer-file-name))
(hypb-ert-require-libraries))
- (ert test-sym nil #'hypb-ert-message-function))))
+ (hypb-ert test-sym))))
(defib hyperbole-run-test-definition ()
"If on the name in the first line of an ert test def, eval and run the test.
@@ -109,10 +121,5 @@ With an Assist Key press instead, edebug the test and step
through it."
(when test-name
(hypb-ert-run-test-at-definition test-name t))))
-(defun hypb-ert-message-function (_msg-pat &rest _args)
- "Ignore messages ert outputs so can display messages from tests run."
- ;; (identity (apply #'format msg-pat args)))))))
- nil)
-
(provide 'hypb-ert)
;;; hypb-ert.el ends here
diff --git a/hyperbole.el b/hyperbole.el
index c3d2954ff3..6746bcfc13 100644
--- a/hyperbole.el
+++ b/hyperbole.el
@@ -7,7 +7,7 @@
;; Author: Bob Weiner
;; Maintainer: Bob Weiner <rsw@gnu.org>, Mats Lidell <matsl@gnu.org>
;; Created: 06-Oct-92 at 11:52:51
-;; Last-Mod: 10-Jul-23 at 12:08:06 by Mats Lidell
+;; Last-Mod: 31-Jul-23 at 23:47:17 by Bob Weiner
;; Released: 03-Dec-22
;; Version: 8.0.1pre
;; Keywords: comm, convenience, files, frames, hypermedia, languages,
mail, matching, mouse, multimedia, outlines, tools, wp
@@ -487,9 +487,10 @@ frame, those functions by default still return the prior
frame."
t)))
;;
;; When vertico-mode is used, vertico-mouse-mode is needed for the
- ;; Action Key to properly select completions from the candidate list.
- (if (bound-and-true-p vertico-mode)
- (vertico-mouse-mode 1)
+ ;; Action Key to properly select completions from the candidate
+ ;; list, so force its usage when vertico-mode is invoked.
+ ;; vertico-mouse-mode should be an autoload.
+ (when (fboundp #'vertico-mouse-mode)
(add-hook 'vertico-mode-hook (lambda () (vertico-mouse-mode 1))))
;;
;; Hyperbole initialization is complete.
diff --git a/install-test/MANIFEST b/install-test/MANIFEST
index 9f06c3ffcc..f4a6775297 100644
--- a/install-test/MANIFEST
+++ b/install-test/MANIFEST
@@ -6,3 +6,4 @@ straight/.emacs - Straight git package personal
configuration
tarball/.emacs - Manual tarball personal configuration
tarball/install-local.sh - Manual tarball download and build script
local/.emacs - Straight git package from local repo and branch
+elpaca/.emacs - Elpaca package configuration (elpa-devel
install)
diff --git a/install-test/elpaca/.emacs b/install-test/elpaca/.emacs
new file mode 100644
index 0000000000..399a308b76
--- /dev/null
+++ b/install-test/elpaca/.emacs
@@ -0,0 +1,68 @@
+;; .emacs
+
+(when (< emacs-major-version 27)
+ (error "Hyperbole requires Emacs 27 or above; you are running version %d"
emacs-major-version))
+
+;; elpaca
+(defvar elpaca-installer-version 0.5)
+(defvar elpaca-directory (expand-file-name "elpaca/" user-emacs-directory))
+(defvar elpaca-builds-directory (expand-file-name "builds/" elpaca-directory))
+(defvar elpaca-repos-directory (expand-file-name "repos/" elpaca-directory))
+(defvar elpaca-order '(elpaca :repo "https://github.com/progfolio/elpaca.git";
+ :ref nil
+ :files (:defaults (:exclude "extensions"))
+ :build (:not elpaca--activate-package)))
+(let* ((repo (expand-file-name "elpaca/" elpaca-repos-directory))
+ (build (expand-file-name "elpaca/" elpaca-builds-directory))
+ (order (cdr elpaca-order))
+ (default-directory repo))
+ (add-to-list 'load-path (if (file-exists-p build) build repo))
+ (unless (file-exists-p repo)
+ (make-directory repo t)
+ (when (< emacs-major-version 28) (require 'subr-x))
+ (condition-case-unless-debug err
+ (if-let ((buffer (pop-to-buffer-same-window "*elpaca-bootstrap*"))
+ ((zerop (call-process "git" nil buffer t "clone"
+ (plist-get order :repo) repo)))
+ ((zerop (call-process "git" nil buffer t "checkout"
+ (or (plist-get order :ref) "--"))))
+ (emacs (concat invocation-directory invocation-name))
+ ((zerop (call-process emacs nil buffer nil "-Q" "-L" "."
"--batch"
+ "--eval" "(byte-recompile-directory
\".\" 0 'force)")))
+ ((require 'elpaca))
+ ((elpaca-generate-autoloads "elpaca" repo)))
+ (progn (message "%s" (buffer-string)) (kill-buffer buffer))
+ (error "%s" (with-current-buffer buffer (buffer-string))))
+ ((error) (warn "%s" err) (delete-directory repo 'recursive))))
+ (unless (require 'elpaca-autoloads nil t)
+ (require 'elpaca)
+ (elpaca-generate-autoloads "elpaca" repo)
+ (load "./elpaca-autoloads")))
+(add-hook 'after-init-hook #'elpaca-process-queues)
+(elpaca `(,@elpaca-order))
+
+;; Install use-package support
+(elpaca elpaca-use-package
+ ;; Enable :elpaca use-package keyword.
+ (elpaca-use-package-mode)
+ ;; Assume :elpaca t unless otherwise specified.
+ (setq elpaca-use-package-by-default t))
+
+;; Block until current queue processed.
+(elpaca-wait)
+
+;; (setq package-native-compile t)
+
+(use-package hyperbole
+ :pin #:elpa-devel
+ :elpaca (:files ("*" "man/*" (:exclude "man"))))
+
+(elpaca-process-queues)
+(elpaca-wait)
+
+;; (unless (package-installed-p 'hyperbole)
+;; (package-refresh-contents)
+;; (package-install 'hyperbole))
+(elpaca nil (hyperbole-mode 1))
+
+(elpaca nil (message "%s" "Hyperbole successfully installed and activated"))
diff --git a/kotl/kfill.el b/kotl/kfill.el
index f1bc6feb9e..76f5290c8c 100644
--- a/kotl/kfill.el
+++ b/kotl/kfill.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 23-Jan-94
-;; Last-Mod: 4-Jul-22 at 23:34:12 by Mats Lidell
+;; Last-Mod: 30-Jul-23 at 20:32:16 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -84,13 +84,21 @@ Setting this variable automatically makes it local to the
current buffer.")
(defun kfill:forward-line (&optional n)
"Move N lines forward (backward if N is negative) to the start of line.
-If there isn’t room, go as far as possible (no error). Always return 0."
+If there isn’t room, go as far as possible (no error).
+
+Return the count of lines left to move. If moving forward, that is N minus
+the number of lines moved; if backward, N plus the number moved.
+
+ Always return 0."
(unless (integerp n)
(setq n 1))
- (forward-visible-line n)
- (unless (< n 0)
- (skip-chars-forward "\n\r"))
- 0)
+ (let ((start-line (line-number-at-pos)))
+ (forward-visible-line n)
+ (unless (< n 0)
+ (skip-chars-forward "\n\r"))
+ (if (>= n 0)
+ (- n (min n (- (line-number-at-pos) start-line)))
+ (- n (max n (- (line-number-at-pos) start-line))))))
(defun kfill:do-auto-fill ()
(save-restriction
diff --git a/kotl/kotl-mode.el b/kotl/kotl-mode.el
index 2c5c2c39fa..3cf378d85d 100644
--- a/kotl/kotl-mode.el
+++ b/kotl/kotl-mode.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 6/30/93
-;; Last-Mod: 21-Jun-23 at 21:03:59 by Bob Weiner
+;; Last-Mod: 30-Jul-23 at 20:26:19 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -1901,19 +1901,25 @@ The paragraph marked is the one that contains point or
follows point."
(interactive "p")
(kotl-mode:maintain-region-highlight)
(kotl-mode:set-temp-goal-column)
- (let ((orig-arg arg))
+ (let ((lines-left 0))
(cond ((> arg 0)
- (while (and (> arg 0) (= 0 (kfill:forward-line 1)))
+ (while (and (> arg 0)
+ (= 0 (setq lines-left (+ lines-left (kfill:forward-line
1)))))
(cond ((kotl-mode:eobp)
- (kfill:forward-line -1)
- (goto-char (kcell-view:end-contents))
- (and (called-interactively-p 'interactive) (= orig-arg arg)
- (message "(kotl-mode:next-line): End of buffer")
(beep))
(setq arg 0))
;; Visible blank line between cells
((and (looking-at "^$") (not (eq (kproperty:get (point)
'invisible) t)))
nil) ;; Don't count this line.
- (t (setq arg (1- arg)))))
+ (t
+ (setq arg (1- arg)))))
+ (when (kotl-mode:eobp)
+ (when (zerop lines-left)
+ (setq lines-left 1))
+ (kfill:forward-line -1)
+ (goto-char (kcell-view:end-contents)))
+ (when (/= lines-left 0)
+ (and (called-interactively-p 'interactive)
+ (message "(kotl-mode:next-line): End of buffer") (beep)))
(kotl-mode:line-move 0)
(kotl-mode:to-valid-position))
((< arg 0)
@@ -1938,22 +1944,21 @@ non-nil iff there is a next tree within the koutline."
(interactive "p")
(kotl-mode:maintain-region-highlight)
(kotl-mode:set-temp-goal-column)
- (let ((orig-arg arg))
- (cond ((> arg 0)
- (while (and (> arg 0) (= 0 (kfill:forward-line -1)))
- (cond ((kotl-mode:bobp)
- (kotl-mode:beginning-of-cell)
- (and (called-interactively-p 'interactive) (= orig-arg arg)
- (message "(kotl-mode:previous-line): Beginning of
buffer") (beep))
- (setq arg 0))
- ;; Visible blank line between cells
- ((and (looking-at "^$") (not (eq (kproperty:get (point)
'invisible) t)))
- nil) ;; Don't count this line.
- (t (setq arg (1- arg)))))
- (kotl-mode:line-move 0)
- (kotl-mode:to-valid-position))
- ((< arg 0)
- (kotl-mode:next-line (- arg)))))
+ (cond ((> arg 0)
+ (while (and (> arg 0)
+ (not (kotl-mode:bobp))
+ (= 0 (kfill:forward-line -1)))
+ ;; Skip any visible blank line between cells
+ (unless (and (looking-at "^$") (not (eq (kproperty:get (point)
'invisible) t)))
+ (setq arg (1- arg))))
+ (when (/= arg 0)
+ (kotl-mode:beginning-of-cell)
+ (and (called-interactively-p 'interactive)
+ (message "(kotl-mode:previous-line): Beginning of buffer")
(beep)))
+ (kotl-mode:line-move 0)
+ (kotl-mode:to-valid-position))
+ ((< arg 0)
+ (kotl-mode:next-line (- arg))))
(setq this-command 'previous-line)
(point))
@@ -1998,7 +2003,7 @@ non-nil iff there is a next tree within the koutline."
(defun kotl-mode:tail-cell ()
"Move point to start of last visible cell at same level as current cell.
-Return t if successfull.
+Return t if successful.
If at tail cell already, do nothing and return nil."
(interactive "p")
(kotl-mode:maintain-region-highlight)
@@ -3305,7 +3310,8 @@ newlines at end of tree."
(vertical-motion -1)
(beginning-of-line)
(setq arg (1+ arg))))
- (let ((col (or goal-column (if (consp temporary-goal-column) (car
temporary-goal-column)
+ (let ((col (or goal-column (if (consp temporary-goal-column)
+ (car temporary-goal-column)
temporary-goal-column))))
(move-to-column (if (numberp col) (round col) 0) nil)))
diff --git a/test/hbut-tests.el b/test/hbut-tests.el
index 9adb2b8c5c..48d533bbd7 100644
--- a/test/hbut-tests.el
+++ b/test/hbut-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <matsl@gnu.org>
;;
;; Orig-Date: 30-may-21 at 09:33:00
-;; Last-Mod: 10-Jul-23 at 22:12:16 by Mats Lidell
+;; Last-Mod: 17-Jul-23 at 00:29:14 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -354,7 +354,7 @@ Needed since hyperbole expands all links to absolute paths
and
(should (hbut:at-p))
(should (eq (hattr:get 'hbut:current 'actype) 'actypes::link-to-file))
(hbut-tests:should-match-tmp-folder (buffer-substring-no-properties
(point-min) (point-max)))
- ;; Test that ibut:operate properly creates an in-buffer ibut from its
in-memory form
+ ;; Test that ibut:operate produces an error and leaves in-buffer button
unchanged
(erase-buffer)
(ibut:operate)
(setq buf-str (buffer-substring-no-properties (point-min) (point-max)))
@@ -363,27 +363,27 @@ Needed since hyperbole expands all links to absolute
paths and
(should (eq (hattr:get 'hbut:current 'actype) 'actypes::link-to-file))
(hbut-tests:should-match-tmp-folder (buffer-substring-no-properties
(point-min) (point-max))))))
-(ert-deftest hbut-tests--ibut-operate--rename ()
- "Test that unnamed ibut rename to `new-name' fails when `edit-flag' is nil.
+(ert-deftest hbut-tests--ibut-operate--fail-create-add-name ()
+ "Test that trying to add `new-name' to an unnamed ibutton fails when
`edit-flag' is nil.
+See #10 for the proper way to add an ibutton name.
|----+------+----------+--------+------+-----------------------------------------------|
| # | name | new-name | region | edit | operation
|
|----+------+----------+--------+------+-----------------------------------------------|
- | 2 | nil | new-name | nil | nil | ERROR: Can't rename without edit
flag |
+ | 2 | nil | new-name | nil | nil | ERROR: edit-flag must be t to set
new-name |
|----+------+----------+--------+------+-----------------------------------------------|"
(with-temp-buffer
;; Create in-buffer and in-memory ibut
- (let ((ibut-str "<[name]> - /tmp")
- buf-str)
- (insert ibut-str)
+ (let (buf-str)
+ (insert "/tmp")
(goto-char 2)
(should (hbut:at-p))
- (should (eq (hattr:get 'hbut:current 'actype) 'actypes::link-to-file))
- (hbut-tests:should-match-tmp-folder (buffer-substring-no-properties
(point-min) (point-max)))
- ;; Test that ibut:operate properly creates an in-buffer ibut from its
in-memory form
- (erase-buffer)
+ ;; Test that ibut:operate errors and leaves in-buffer button unchanged
+ (goto-char (point-min))
(should-error (ibut:operate "new-name"))
(setq buf-str (buffer-substring-no-properties (point-min) (point-max)))
- (message buf-str))))
+ (message buf-str)
+ (should (hbut:at-p))
+ (hbut-tests:should-match-tmp-folder buf-str))))
(ert-deftest hbut-tests--ibut-operate--name ()
"Test that ibut get created with `name' from button attributes.
@@ -425,11 +425,12 @@ Needed since hyperbole expands all links to absolute
paths and
(should (hbut:at-p))
(should (eq (hattr:get 'hbut:current 'actype) 'actypes::link-to-file))
(hbut-tests:should-match-tmp-folder (buffer-substring-no-properties
(point-min) (point-max)))
- ;; Test that ibut:operate properly creates an in-buffer ibut from its
in-memory form
- (erase-buffer)
+ ;; Test that ibut:operate produces an error and leaves in-buffer button
unchanged
(should-error (ibut:operate "new-name"))
(setq buf-str (buffer-substring-no-properties (point-min) (point-max)))
- (message buf-str))))
+ (message buf-str)
+ (should (hbut:at-p))
+ (hbut-tests:should-match-tmp-folder buf-str))))
(ert-deftest hbut-tests--ibut-operate--fail-rename-from-name-ignore-region ()
"Test that named ibut rename to `new-name' fails; region active, `edit-flag'
nil.
@@ -440,20 +441,23 @@ Needed since hyperbole expands all links to absolute
paths and
|----+------+----------+--------+------+-----------------------------------------------|"
(with-temp-buffer
;; Create in-buffer and in-memory ibut
- (let ((ibut-str "<[name]> - /tmp")
+ (let ((ibut-str "<[name]> - \"/tmp\"")
buf-str)
(insert ibut-str)
(goto-char 2)
(should (hbut:at-p))
(should (eq (hattr:get 'hbut:current 'actype) 'actypes::link-to-file))
(hbut-tests:should-match-tmp-folder (buffer-substring-no-properties
(point-min) (point-max)))
- ;; Test that ibut:operate properly creates an in-buffer ibut from its
in-memory form
- (erase-buffer)
- (insert "words in buffer\n")
+ ;; Test that ibut:operate produces an error and leaves in-buffer button
unchanged
+ (goto-char (point-min))
+ (insert "words in buffer ")
(mark-whole-buffer)
(should-error (ibut:operate "new-name"))
(setq buf-str (buffer-substring-no-properties (point-min) (point-max)))
- (message buf-str))))
+ (message buf-str)
+ (goto-char (- (point-max) 2))
+ (should (hbut:at-p))
+ (hbut-tests:should-match-tmp-folder buf-str))))
(ert-deftest hbut-tests--ibut-operate--name-ignore-region ()
"Test creation of a named ibut and ignore region.
@@ -506,32 +510,31 @@ Needed since hyperbole expands all links to absolute
paths and
(hbut-tests:should-match-tmp-folder buf-str)
(should (equal "region" (hattr:get 'hbut:current 'name))))))
-(ert-deftest hbut-tests--ibut-operate--new-name-ignore-region ()
+(ert-deftest hbut-tests--ibut-operate--fail-new-name-ignore-region ()
"Test creation of a named ibut and ignore region.
|----+------+----------+--------+------+-----------------------------------------------|
| # | name | new-name | region | edit | operation
|
|----+------+----------+--------+------+-----------------------------------------------|
- | 8 | nil | new-name | region | nil | create: ibut with new-name (ignore
region) |
+ | 8 | nil | new-name | region | nil | ERROR: edit-flag must be t to set
new-name |
|----+------+----------+--------+------+-----------------------------------------------|"
(skip-unless nil) ;; TODO: Disabled until ibut:operate is fixed
(with-temp-buffer
;; Create in-buffer and in-memory ibut
(let ((ibut-str "/tmp")
buf-str)
- (insert ibut-str "\nabcd")
+ (insert "abcd " ibut-str)
(mark-whole-buffer)
- (goto-char 2)
+ (goto-char (- (point-max) 2))
(should (hbut:at-p))
(should (region-active-p))
(should (eq (hattr:get 'hbut:current 'actype) 'actypes::link-to-file))
;; Test that ibut:operate properly creates an in-buffer ibut from its
in-memory form
- (erase-buffer)
- (ibut:operate "new-name"))
+ (should-error (ibut:operate "new-name"))
(setq buf-str (buffer-substring-no-properties (point-min) (point-max)))
(message buf-str)
(should (hbut:at-p))
(should (eq (hattr:get 'hbut:current 'actype) 'actypes::link-to-file))
- (hbut-tests:should-match-tmp-folder (buffer-substring-no-properties
(point-min) (point-max)))))
+ (hbut-tests:should-match-tmp-folder (buffer-substring-no-properties
(point-min) (point-max))))))
(ert-deftest hbut-tests--ibut-operate--remove-name ()
"Test removal of any name from ibut at point.
@@ -563,7 +566,7 @@ Needed since hyperbole expands all links to absolute paths
and
|----+------+----------+--------+------+-----------------------------------------------|
| # | name | new-name | region | edit | operation
|
|----+------+----------+--------+------+-----------------------------------------------|
- | 10 | nil | new-name | nil | t | mod: set ibut's name to new-name
|
+ | 10 | nil | new-name | nil | t | mod: add new-name as ibut's name
attribute |
|----+------+----------+--------+------+-----------------------------------------------|"
(skip-unless nil) ;; TODO: Disabled until ibut:operate is fixed
(with-temp-buffer
@@ -579,12 +582,12 @@ Needed since hyperbole expands all links to absolute
paths and
(message buf-str)
(goto-char 2)
(should (hbut:at-p))
+ (should (equal "new-name" (hattr:get 'hbut:current 'name)))
(should (eq (hattr:get 'hbut:current 'actype) 'actypes::link-to-file))
- (hbut-tests:should-match-tmp-folder (buffer-substring-no-properties
(point-min) (point-max)))
- (should (equal "new-name" (hattr:get 'hbut:current 'name))))))
+ (hbut-tests:should-match-tmp-folder (buffer-substring-no-properties
(point-min) (point-max))))))
(ert-deftest hbut-tests--ibut-operate--add-name ()
- "Test addition of `name' to ibut at point.
+ "Test addition of `name' to ibut at point and any in-buffer copies.
|----+------+----------+--------+------+-----------------------------------------------|
| # | name | new-name | region | edit | operation
|
|----+------+----------+--------+------+-----------------------------------------------|
- [elpa] externals/hyperbole 159a54a31b 02/16: Add elpaca recipe install test, (continued)
- [elpa] externals/hyperbole 159a54a31b 02/16: Add elpaca recipe install test, ELPA Syncer, 2023/08/01
- [elpa] externals/hyperbole 6e25c4e2e9 06/16: Fix potential unbound use of vertico-mouse-mode, ELPA Syncer, 2023/08/01
- [elpa] externals/hyperbole d304487618 07/16: Merge branch 'rsw' of hyperbole, ELPA Syncer, 2023/08/01
- [elpa] externals/hyperbole 3a45510382 10/16: Merge pull request #371 from rswgnu/install-test-for-elpaca-package-manager, ELPA Syncer, 2023/08/01
- [elpa] externals/hyperbole cba8f7f675 09/16: Merge branch 'master' into install-test-for-elpaca-package-manager, ELPA Syncer, 2023/08/01
- [elpa] externals/hyperbole 4491f44d3e 13/16: Merge branch 'master' into rsw, ELPA Syncer, 2023/08/01
- [elpa] externals/hyperbole 840ceb8b27 04/16: Merge branch 'master' into rsw, ELPA Syncer, 2023/08/01
- [elpa] externals/hyperbole b1dd46c6c6 05/16: Merge pull request #372 from rswgnu/rsw, ELPA Syncer, 2023/08/01
- [elpa] externals/hyperbole 055076ad80 03/16: Fix outstanding issues with Smart Keys and Koutliner, ELPA Syncer, 2023/08/01
- [elpa] externals/hyperbole b5e19a4ee6 08/16: Merge pull request #373 from rswgnu/rsw, ELPA Syncer, 2023/08/01
- [elpa] externals/hyperbole a923edcf01 11/16: Merge branch 'master' into add-pathname-with-line-number-spec-test,
ELPA Syncer <=
- [elpa] externals/hyperbole 1a1f446dda 12/16: ChangeLog: Fix potential unbound use of vertico-mouse-mode, ELPA Syncer, 2023/08/01
- [elpa] externals/hyperbole 6fb1e9624e 14/16: Merge pull request #374 from rswgnu/rsw, ELPA Syncer, 2023/08/01
- [elpa] externals/hyperbole 6c51fc1290 15/16: Merge branch 'master' into add-pathname-with-line-number-spec-test, ELPA Syncer, 2023/08/01
- [elpa] externals/hyperbole 81d0449aed 16/16: Merge pull request #366 from rswgnu/add-pathname-with-line-number-spec-test, ELPA Syncer, 2023/08/01