branch: externals/hyperbole
commit d115b6d3574a39d3361457b30826cce1ac05e0d1
Author: Robert Weiner <[email protected]>
Commit: Robert Weiner <[email protected]>
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 <[email protected]>, Mats Lidell <[email protected]>
;; 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)
