emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/hyperbole 055076ad80 03/16: Fix outstanding issues with


From: ELPA Syncer
Subject: [elpa] externals/hyperbole 055076ad80 03/16: Fix outstanding issues with Smart Keys and Koutliner
Date: Tue, 1 Aug 2023 03:58:11 -0400 (EDT)

branch: externals/hyperbole
commit 055076ad80e66c7866a0614f5853034662f4cdd0
Author: Bob Weiner <rsw@gnu.org>
Commit: Bob Weiner <rsw@gnu.org>

    Fix outstanding issues with Smart Keys and Koutliner
---
 ChangeLog          |  39 +++++++++++-
 hargs.el           | 176 ++++++++++++++++++++++++++++++++++-------------------
 hmouse-drv.el      |  26 ++++----
 hmouse-tag.el      |   6 +-
 hsys-org.el        |  10 ++-
 hui-mouse.el       |   4 +-
 hyperbole.el       |   5 +-
 kotl/kfill.el      |  20 ++++--
 kotl/kotl-mode.el  |  58 ++++++++++--------
 test/hbut-tests.el |  67 ++++++++++----------
 10 files changed, 261 insertions(+), 150 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 23f12c66d9..36c1129dac 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,38 @@
+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-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
+    increase the number of completions, if any are available.
+
 2023-07-17  Bob Weiner  <rsw@gnu.org>
 
 * hypb-ert.el (require): Wrap 'eval-and-compile' call around this to force 
require
@@ -13,7 +48,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 +62,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.
 
diff --git a/hargs.el b/hargs.el
index 3901411ba3..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:     17-Jul-23 at 00:23:46 by Bob Weiner
+;; 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,40 +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 (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 "^$")))
@@ -727,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
@@ -744,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
@@ -752,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)))
@@ -788,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/hmouse-drv.el b/hmouse-drv.el
index a9fb79eb25..39c20ef167 100644
--- a/hmouse-drv.el
+++ b/hmouse-drv.el
@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:    04-Feb-90
-;; Last-Mod:     17-Jul-23 at 00:22:26 by Bob Weiner
+;; 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))
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/hyperbole.el b/hyperbole.el
index c3d2954ff3..f54a4aa07e 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:     30-Jul-23 at 10:18:28 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
@@ -488,8 +488,7 @@ frame, those functions by default still return the prior 
frame."
   ;;
   ;; 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)
+  (when (fboundp #'vertico-mode)
     (add-hook 'vertico-mode-hook (lambda () (vertico-mouse-mode 1))))
   ;;
   ;; Hyperbole initialization is complete.
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                          
           |
    
|----+------+----------+--------+------+-----------------------------------------------|



reply via email to

[Prev in Thread] Current Thread [Next in Thread]