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

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

[elpa] externals/hyperbole 467d9690b3 3/4: Fixes for 4 failing Hyperbole


From: ELPA Syncer
Subject: [elpa] externals/hyperbole 467d9690b3 3/4: Fixes for 4 failing Hyperbole tests
Date: Sat, 20 May 2023 17:58:00 -0400 (EDT)

branch: externals/hyperbole
commit 467d9690b3995dff6c0c44ca49668e558839b955
Author: Robert Weiner <rsw@gnu.org>
Commit: Robert Weiner <rsw@gnu.org>

    Fixes for 4 failing Hyperbole tests
    
    hibtypes.el (grep-msg): Add support for *Warning* buffer entries like:
       Warning (comp): hbut.el:224:10: Warning: reference to free variable...
---
 ChangeLog     |  31 +++++++++++++++++
 hbut.el       |  74 +++++++++++++++++++++------------------
 hibtypes.el   |   3 +-
 hpath.el      | 109 ++++++++++++++++++++++++++++------------------------------
 hsys-org.el   |   8 +++--
 hui-mouse.el  |   6 ++--
 hui-window.el |   4 +--
 hui.el        |   1 +
 8 files changed, 138 insertions(+), 98 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 0928dc8f8a..07fe0e138a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,34 @@
+2023-05-20  Bob Weiner  <rsw@gnu.org>
+
+* hsys-org.el (hsys-org-link-at-p): Stop using (org-in-regexp org-link-any-re 
nil t)
+    to avoid rx warnings.  Use (eq (org-element-type (org-element-context)) 
'link)
+    instead.
+
+* hibtypes.el (grep-msg): Add support for *Warning* buffer entries like:
+    Warning (comp): hbut.el:224:10: Warning: reference to free variable...
+
+* hbut.el (ibut:insert-text): Add actype:elisp-symbol call to ensure all 
actype symbols
+    are expanded to Hyperbole internal namespace.  This fixes some link-to-rfc 
tests.
+
+* hui.el (hui:ibut-create): Add name property from label to ibut.
+
+* hpath.el (hpath:find): Simplify and fix so noselect argument is always 
handled
+    properly and findable path is used in places instead of pathname.
+    This fixes an issue with ilinks that include a pathname where hpath:find
+    was switching the current buffer improperly.
+           (hpath:display-buffer-alist, hpath:display-where-alist): Fix
+    'other-frame-one-window' option to return found buffer by adding a 'prog1'
+    call.
+  hbut.el (hbut:funcall): Update to use '(current-buffer)' when both buffer
+    and key-src args are null.
+  hbut.el (ebut:to, ibut:to, ibut:to-name, ibut:to-text):
+    Send (current-buffer) as _buffer arg to hbut:funcall so does not try to use
+     _key-src arg and end up in the wrong buffer.
+
+* hui-mouse.el (smart-imenu-item-at-p): Fix so only returns non-nil
+    when smart-menu-item-p call is non-nil.  Stops from triggering
+    when not on an imenu item.
+
 2023-05-20  Mats Lidell  <matsl@gnu.org>
 
 * test/MANIFEST: Add missing hargs-tests.el.
diff --git a/hbut.el b/hbut.el
index 85ff930554..55634caf37 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:     20-May-23 at 09:58:56 by Bob Weiner
+;; Last-Mod:     20-May-23 at 15:39:10 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -571,7 +571,8 @@ else nil."
                    (when found
                      (goto-char pos)
                      (ebut:at-p))))
-               lbl-key))
+               lbl-key
+               (current-buffer)))
 
 ;;; ------------------------------------------------------------------------
 (defun    ebut:delimit (start end instance-flag)
@@ -1077,29 +1078,30 @@ BUFFER defaults to the current buffer."
 
 (defun    hbut:funcall (func &optional lbl-key buffer key-src)
   "Move to an implicit button and return the result of calling FUNC.
-Call FUNC with optional argument values of LBL-KEY, BUFFER and KEY-SRC.
-The implicit button used is given by LBL-KEY (a label or label key)
-within BUFFER or KEY-SRC (full path to global button file).  Use
-`save-excursion' around this call to prevent permanent movement of
-point when desired."
-  (when buffer
-    (if (bufferp buffer)
-       (set-buffer buffer)
-      (error "(ibut:get): Invalid buffer argument: %s" buffer)))
-  (when (null key-src)
-    (let ((loc (hattr:get 'hbut:current 'loc)))
-      (when loc
-       (set-buffer (or (get-buffer loc) (find-file-noselect loc)))))
-    (setq key-src (hbut:to-key-src 'full)
-         ;; `hbut:to-key-src' sets current buffer to key-src buffer.
-         buffer (or buffer (current-buffer))))
-  (when (stringp lbl-key)
-    (when key-src
-      (set-buffer (if (bufferp key-src)
-                     key-src
-                   (find-file-noselect key-src))))
-    (when (or buffer key-src)
-      (funcall func lbl-key buffer key-src))))
+Call FUNC with optional argument values of LBL-KEY, BUFFER and
+KEY-SRC.  The implicit button used is given by LBL-KEY (a label
+or label key) within BUFFER or KEY-SRC (full path to global
+button file) or within the current buffer if both are null.  Use
+`save-excursion' around this call to prevent permanent movement
+of point when desired."
+  (if buffer
+      (if (bufferp buffer)
+         (set-buffer buffer)
+       (error "(ibut:get): Invalid buffer argument: %s" buffer))
+    (when (null key-src)
+      (let ((loc (hattr:get 'hbut:current 'loc)))
+       (when loc
+         (set-buffer (or (get-buffer loc) (find-file-noselect loc)))))
+      (setq key-src (hbut:to-key-src 'full)
+           ;; `hbut:to-key-src' sets current buffer to key-src buffer.
+           buffer (or buffer (current-buffer))))
+    (when (stringp lbl-key)
+      (when key-src
+       (set-buffer (if (bufferp key-src)
+                       key-src
+                     (find-file-noselect key-src))))))
+  (when (and (stringp lbl-key) (or buffer key-src))
+      (funcall func lbl-key buffer key-src)))
 
 (defun    hbut:get (&optional lbl-key buffer key-src)
   "Return explicit or labeled implicit button symbol given by LBL-KEY and 
BUFFER.
@@ -2129,9 +2131,9 @@ button is found in the current buffer."
 
 (defun    ibut:insert-text (ibut)
   "Space, delimit and insert the activatable text of IBUT."
-  (when (hattr:get ibut 'name)
+  (when (not (string-empty-p (or (hattr:get ibut 'name) "")))
     (insert ibut:label-separator))
-  (let* ((actype (hattr:get ibut 'actype))
+  (let* ((actype (actype:elisp-symbol (hattr:get ibut 'actype)))
         (args   (hattr:get ibut 'args))
         (arg1   (nth 0 args))
         (arg2   (nth 1 args))
@@ -2145,11 +2147,14 @@ button is found in the current buffer."
       ('actypes::exec-window-cmd (insert "\"&" arg1 "\""))
       ('actypes::link-to-gbut (insert "<glink:" arg1 ">"))
       ('actypes::link-to-ebut (progn (insert "<elink:" arg1)
-                                    (when arg2 (insert ": " arg2)) ">"))
+                                    (when arg2 (insert ": " arg2))
+                                    (insert ">")))
       ('actypes::link-to-ibut (progn (insert "<ilink:" arg1)
-                                    (when arg2 (insert ": " arg2)) ">"))
+                                    (when arg2 (insert ": " arg2))
+                                    (insert ">")))
       ('actypes::link-to-kcell (progn (insert "<") (when arg1 (insert arg1))
-                                     (when arg2 (insert ", " arg2)) ">"))
+                                     (when arg2 (insert ", " arg2))
+                                     (insert ">")))
       ('actypes::link-to-org-id (insert (format "\"id:%s\"" arg1)))
       ('actypes::link-to-rfc (insert (format "rfc%d" arg1)))
       ('actypes::man-show (insert arg1))
@@ -2285,7 +2290,8 @@ Return the symbol for the button, else nil."
                      (when found
                        (goto-char pos)
                        ibut))))
-               lbl-key))
+               lbl-key
+               (current-buffer)))
 
 (defun    ibut:at-to-name-p (&optional ibut)
   "If point is on an implicit button, optional IBUT, move to the start of its 
name.
@@ -2342,7 +2348,8 @@ Return the symbol for the button if found, else nil."
                (skip-chars-forward (regexp-quote ibut:label-start)))
               ((ibut:at-to-name-p ibut))))
        ibut))
-   lbl-key))
+   lbl-key
+   (current-buffer)))
 
 (defun    ibut:to-text (lbl-key)
   "Move to the text of the nearest implicit button matching LBL-KEY.
@@ -2391,7 +2398,8 @@ Return the symbol for the button if found, else nil."
                   (goto-char (min (+ 2 (match-end 0)) (point-max)))
                 (goto-char opoint)))))
         ibut))
-     lbl-key)))
+     lbl-key
+     (current-buffer))))
 
 ;;; ------------------------------------------------------------------------
 (defconst ibut:label-start "<["
diff --git a/hibtypes.el b/hibtypes.el
index 4f260be2c4..d576427aef 100644
--- a/hibtypes.el
+++ b/hibtypes.el
@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:    19-Sep-91 at 20:45:31
-;; Last-Mod:     14-May-23 at 10:57:23 by Bob Weiner
+;; Last-Mod:     20-May-23 at 16:10:20 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -988,6 +988,7 @@ in grep and shell buffers."
             ;; Emacs native compiler file lines
             (looking-at "Compiling \\(\\S-+\\)\\.\\.\\.$")
             (looking-at "Loading \\(\\S-+\\) (\\S-+)\\.\\.\\.$")
+            (looking-at "[a-zA-Z0-9]+ ([-a-zA-Z0-9]+): 
\\([^:\"'`]+\\):\\([0-9]+\\):")
              ;; Grep matches (allowing for Emacs Lisp vars with : in
             ;; name within the pathname), Ruby, UNIX C compiler and Introl 
68HC11 C compiler errors
              (looking-at "\\([^ \t\n\r\"'`]*[^ \t\n\r:\"'`0-9]\\): 
?\\([1-9][0-9]*\\)[ :]")
diff --git a/hpath.el b/hpath.el
index d2b613825b..e05d8ba3c7 100644
--- a/hpath.el
+++ b/hpath.el
@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:     1-Nov-91 at 00:44:23
-;; Last-Mod:     14-May-23 at 01:51:54 by Bob Weiner
+;; Last-Mod:     20-May-23 at 14:05:35 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -459,8 +459,8 @@ display program settings."
                          (switch-to-buffer b)))
    (list 'other-frame   #'hpath:display-buffer-other-frame)
    (list 'other-frame-one-window   (lambda (b)
-                                    (hpath:display-buffer-other-frame b)
-                                    (delete-other-windows))))
+                                    (prog1 (hpath:display-buffer-other-frame b)
+                                      (delete-other-windows)))))
   "*Alist of (DISPLAY-WHERE-SYMBOL  DISPLAY-BUFFER-FUNCTION) elements.
 This permits fine-grained control of where Hyperbole displays linked to 
buffers.
 
@@ -498,8 +498,8 @@ See Info node `(elisp)Choosing Window Options' for where 
Emacs displays buffers.
                           (hpath:find-other-frame f))))
    (list 'other-frame  #'hpath:find-other-frame)
    (list 'other-frame-one-window (lambda (f)
-                                  (hpath:find-other-frame f)
-                                  (delete-other-windows))))
+                                  (prog1 (hpath:find-other-frame f)
+                                    (delete-other-windows)))))
   "*Alist of (DISPLAY-WHERE-SYMBOL DISPLAY-FILE-FUNCTION) elements.
 This permits fine-grained control of where Hyperbole displays
 linked to files.  The default value of DISPLAY-WHERE-SYMBOL is
@@ -1377,10 +1377,15 @@ If PATHNAME does not start with a prefix character:
   matching display function.
 
 Optional third argument, NOSELECT, means simply find the file and return its
-buffer but don't display it."
+buffer but don't display it.  Any modifier prefix is ignored in such cases
+but locational suffixes within the file are utilized."
   (interactive "FFind file: ")
   (unless (stringp pathname)
     (error "(hpath:find): pathname arg must be a string, not, %S" pathname))
+  ;; `pathname' ends as the whole argument sent in except for any
+  ;; initial modifier character.
+  ;; `path' has extra location info (section, line num, col num)
+  ;; stripped off, so it is just a findable path.
   (let ((case-fold-search t)
        (default-directory default-directory)
        modifier loc anchor hash path line-num col-num)
@@ -1427,11 +1432,7 @@ buffer but don't display it."
          (file-readable-p pathname)
          (error "(hpath:find): \"%s\" is not readable"
                 (concat modifier pathname (when hash "#") anchor)))
-      (if noselect
-         (let ((buf (find-file-noselect pathname)))
-           (with-current-buffer buf
-             (when (or hash anchor) (hpath:to-markup-anchor hash anchor))
-             buf))
+      (unless noselect
        ;; If pathname is a remote file (not a directory), we have to copy it to
        ;; a temporary local file and then display that.
        (when (and remote-pathname (not (file-directory-p remote-pathname)))
@@ -1442,32 +1443,18 @@ buffer but don't display it."
          (setq pathname (cond (anchor (concat remote-pathname "#" anchor))
                               (hash   (concat remote-pathname "#"))
                               (t path))))))
-    (cond (modifier (cond ((= modifier ?!)
-                          (hact 'exec-shell-cmd pathname))
-                         ((= modifier ?&)
-                          (hact 'exec-window-cmd pathname))
-                         ((= modifier ?-)
-                          (hact 'load pathname)))
-                   nil)
-
-         ;; If no path, e.g. just an anchor link in a non-file buffer,
-         ;; then must display within Emacs, ignoring any external programs.
-         ((string-empty-p path)
-          (hpath:display-buffer (current-buffer) display-where)
-          (when (or hash anchor)
-            (hpath:to-markup-anchor hash anchor))
-          (when line-num
-            ;; With an anchor, goto line relative to anchor
-            ;; location, otherwise use absolute line number
-            ;; within the visible buffer portion.
-            (if (or hash anchor)
-                (forward-line line-num)
-              (hpath:to-line line-num)))
-          (when col-num (move-to-column col-num))
-          (current-buffer))
+    (cond ((and modifier (not noselect))
+          (cond ((= modifier ?!)
+                 (hact 'exec-shell-cmd pathname))
+                ((= modifier ?&)
+                 (hact 'exec-window-cmd pathname))
+                ((= modifier ?-)
+                 (hact 'load pathname)))
+          nil)
 
          ;; Display paths either internally or externally.
-         (t (let ((display-executables (hpath:find-program path))
+         (t (let ((display-executables (unless (or noselect (string-empty-p 
path))
+                                         (hpath:find-program path)))
                   executable)
               (cond ((stringp display-executables)
                      (hact 'exec-window-cmd
@@ -1483,27 +1470,37 @@ buffer but don't display it."
                                (hpath:command-string executable pathname))
                        (error "(hpath:find): No available executable from: %s"
                               display-executables)))
-                    (t (setq path (hpath:validate path))
-                       (funcall (hpath:display-path-function display-where) 
path)
-                       ;; Perform a loose test that the current buffer
-                       ;; file name matches the path file name since exact
-                       ;; matching of path is likely to be wrong in
-                       ;; certain cases, e.g. with mount point or os path
-                       ;; alterations.
-                       (when (and buffer-file-name
-                                  (equal (file-name-nondirectory path)
-                                         (file-name-nondirectory 
buffer-file-name)))
-                         (when (or hash anchor)
-                           (hpath:to-markup-anchor hash anchor))
-                         (when line-num
-                           ;; With an anchor, goto line relative to anchor
-                           ;; location, otherwise use absolute line number
-                           ;; within the visible buffer portion.
-                           (if (or hash anchor)
-                               (forward-line line-num)
-                             (hpath:to-line line-num)))
-                         (when col-num (move-to-column col-num))
-                         (current-buffer)))))))))
+                    (t (setq path (hpath:validate path)) ;; signals error when 
invalid
+                       (let ((buf (cond
+                                   ;; If no path, e.g. just an anchor link in 
a non-file buffer,
+                                   ;; then must display within Emacs, ignoring 
any external programs.
+                                   ((string-empty-p path)
+                                    (if noselect
+                                        (current-buffer)
+                                      (hpath:display-buffer (current-buffer) 
display-where)))
+                                   (noselect
+                                    (find-file-noselect path))
+                                   (t (funcall (hpath:display-path-function 
display-where) path)))))
+                         (with-current-buffer buf
+                           ;; Perform a loose test that the current buffer
+                           ;; file name matches the path file name since exact
+                           ;; matching of path is likely to be wrong in
+                           ;; certain cases, e.g. with mount point or os path
+                           ;; alterations.
+                           (when (and buffer-file-name
+                                      (equal (file-name-nondirectory path)
+                                             (file-name-nondirectory 
buffer-file-name)))
+                             (when (or hash anchor)
+                               (hpath:to-markup-anchor hash anchor))
+                             (when line-num
+                               ;; With an anchor, goto line relative to anchor
+                               ;; location, otherwise use absolute line number
+                               ;; within the visible buffer portion.
+                               (if (or hash anchor)
+                                   (forward-line line-num)
+                                 (hpath:to-line line-num)))
+                             (when col-num (move-to-column col-num))
+                             (current-buffer)))))))))))
 
 (defun hpath:to-markup-anchor (hash anchor)
   "Move point to ANCHOR if found or, if null, to the beginning of the buffer."
diff --git a/hsys-org.el b/hsys-org.el
index 38579647da..ef596ec6ff 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:     15-May-23 at 00:32:17 by Bob Weiner
+;; Last-Mod:     20-May-23 at 16:28:08 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -226,7 +226,7 @@ Return the (start . end) buffer positions of the region."
 Assume caller has already checked that the current buffer is in `org-mode'
 or are looking for an Org link in another buffer type."
   (unless (or (smart-eolp) (smart-eobp))
-    (org-in-regexp org-link-any-re nil t)))
+    (eq (org-element-type (org-element-context)) 'link)))
 
 ;; Assume caller has already checked that the current buffer is in org-mode.
 (defun hsys-org-heading-at-p (&optional _)
@@ -312,8 +312,9 @@ The region is (start . end) and includes any delimiters, 
else nil."
              (and (listp face-prop) (memq org-face-type face-prop)))
       org-face-type)))
 
+;; Adapted from Org code
 (defun hsys-org-search-internal-link-p (target)
-  "Search buffer start for the first Org internal link to matching <<TARGET>>.
+  "Search buffer start for the first Org internal link matching <<TARGET>>.
 White spaces are insignificant.  Return t if a link is found, else nil."
   (when (string-match "<<.+>>" target)
     (setq target (substring target 2 -2)))
@@ -335,6 +336,7 @@ White spaces are insignificant.  Return t if a link is 
found, else nil."
       (goto-char origin)
       nil)))
 
+;; Adapted from Org code
 (defun hsys-org-search-radio-target-link-p (target)
   "Search from point for a radio target link matching TARGET.
 White spaces are insignificant.  Return t if a target link is found, else nil."
diff --git a/hui-mouse.el b/hui-mouse.el
index b0d7e854a9..2932888746 100644
--- a/hui-mouse.el
+++ b/hui-mouse.el
@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:    04-Feb-89
-;; Last-Mod:     30-Apr-23 at 15:50:57 by Bob Weiner
+;; Last-Mod:     20-May-23 at 10:52:22 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -1399,8 +1399,8 @@ sets `hkey-value' to (identifier . 
identifier-definition-buffer-position)."
        (not (and (smart-lisp-mode-p) (smart-lisp-at-definition-p)))
        ;; Ignore Lisp loading expressions
        (not (smart-lisp-at-load-expression-p))
-       (setq hkey-value (hargs:find-tag-default)
-            hkey-value (cons hkey-value (smart-imenu-item-p hkey-value 
variable-flag)))
+       (setq hkey-value (smart-imenu-item-p hkey-value variable-flag))
+       (setq hkey-value (cons (hargs:find-tag-default) hkey-value))
        (cdr hkey-value)))
 
 ;; Derived from `imenu' function in the imenu library.
diff --git a/hui-window.el b/hui-window.el
index f1313913be..ffcac28be9 100644
--- a/hui-window.el
+++ b/hui-window.el
@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:    21-Sep-92
-;; Last-Mod:     19-May-23 at 06:53:58 by Bob Weiner
+;; Last-Mod:     20-May-23 at 10:37:04 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -182,7 +182,7 @@ and release to register a diagonal drag.")
              ;; Note that `hui:ebut-link-directly' uses any active
              ;; region as the label of the button to create.
              . ((or (hmouse-drag-item-to-display) (hui:ebut-link-directly))
-                . (hmouse-swap-buffers)))
+                . (hui:ibut-link-directly)))
             ((hmouse-drag-region-active)
              . ((hmouse-drag-not-allowed) . (hmouse-drag-not-allowed)))
             ((setq hkey-value (hmouse-drag-horizontally))
diff --git a/hui.el b/hui.el
index bcfa736e8c..9b5b4ee25d 100644
--- a/hui.el
+++ b/hui.el
@@ -897,6 +897,7 @@ For programmatic creation, use `ibut:program' instead."
        (setq but-buf (current-buffer))
        (hui:buf-writable-err but-buf "ibut-create")
 
+       (hattr:set 'hbut:current 'name lbl)
        (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
        (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
        (setq actype (hui:actype))



reply via email to

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