[elpa] externals/hyperbole d115b6d357 35/47: Don't remove hyperb:automount-prefixes and hyperb:path-being-loaded

[ELPA Syncer]

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

    Don't remove hyperb:automount-prefixes and hyperb:path-being-loaded
---
 hversion.el  | 35 ++++++++++++++++++++++++++++++++++-
 hyperbole.el |  8 ++++----
 2 files changed, 38 insertions(+), 5 deletions(-)

diff --git a/hversion.el b/hversion.el
index 982e11a213..f38cafbf40 100644
--- a/hversion.el
+++ b/hversion.el
@@ -4,7 +4,7 @@
 ;; Maintainer:   Bob Weiner, Mats Lidell
 ;;
 ;; Orig-Date:     1-Jan-94
-;; Last-Mod:     25-Jun-23 at 10:11:43 by Mats Lidell
+;; Last-Mod:     25-Jun-23 at 11:59:46 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -37,6 +37,12 @@
 Override this if the system-computed default is incorrect for
 your specific mouse.")
 
+(defvar hyperb:automount-prefixes
+  (if (and (boundp 'automount-dir-prefix) (stringp automount-dir-prefix))
+      automount-dir-prefix
+    "^/tmp_mnt/"
+    "Regexp to match any automounter prefix in a pathname."))
+
 ;;; ************************************************************************
 ;;; Public declarations
 ;;; ************************************************************************
@@ -46,6 +52,33 @@ your specific mouse.")
 ;;; Support functions
 ;;; ************************************************************************
 
+(defun hyperb:path-being-loaded ()
+  "Return the full pathname used by the innermost `load' or `require' call.
+Removes any matches for `hyperb:automount-prefixes' before returning
+the pathname."
+  (let* ((frame (hyperb:stack-frame '(load require)))
+        (function (nth 1 frame))
+        file nosuffix)
+    (cond ((eq function 'load)
+          (setq file (nth 2 frame)
+                nosuffix (nth 5 frame)))
+         ((eq function 'require)
+          (setq file (or (nth 3 frame) (symbol-name (nth 2 frame))))))
+    (when (stringp file)
+      (setq nosuffix (or nosuffix
+                        (string-match
+                         "\\.\\(elc?\\|elc?\\.gz\\|elc?\\.Z\\)$"
+                         file))
+           file (substitute-in-file-name file)
+           file (locate-file file load-path
+                             (when (null nosuffix) '(".elc" ".el" ".el.gz" 
".el.Z"))
+                             ;; accept any existing file
+                             nil)
+           file (if (and (stringp file)
+                         (string-match hyperb:automount-prefixes file))
+                    (substring file (1- (match-end 0)))
+                  file)))))
+
 (defun hyperb:window-sys-term (&optional frame)
   "Return first part of the term-type if running under a window system, else 
nil.
 Where a part in the term-type is delimited by a `-' or  an `_'."
diff --git a/hyperbole.el b/hyperbole.el
index a0feda76c4..fb1afed7b7 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:     25-Jun-23 at 10:12:04 by Mats Lidell
+;; Last-mod:     25-Jun-23 at 12:01:04 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
@@ -113,9 +113,9 @@
     (setq features (delq 'hload-path features)
          features (delq 'hversion features)))
 
-  ;; Defines (hyperb:window-system), and hyperb:dir,
-  ;; which are used later in this file.
-  ;; Also adds Hyperbole to the load-path if need be.
+  ;; Defines hyperb:path-being-loaded, hyperb:stack-frame,
+  ;; (hyperb:window-system) and hyperb:dir, which are used later in
+  ;; this file.  Also adds Hyperbole to the load-path if need be.
   ;;
   ;; This handles the case when the Hyperbole package directory is not yet in 
load-path.
   (unless (or (require 'hversion nil t)