[elpa] externals/hyperbole f7edef655f 15/18: Merge pull request #611 from rswgnu/rsw

[ELPA Syncer]

branch: externals/hyperbole
commit f7edef655f5690870d05cff3e2c077af6bb95452
Merge: 4b1c74bdb5 206f54676d
Author: Robert Weiner <rsw@gnu.org>
Commit: GitHub <noreply@github.com>

    Merge pull request #611 from rswgnu/rsw
    
    hpath:shorten - Shorten paths and make relative to source path
---
 ChangeLog         | 25 +++++++++++++++++++++++++
 hactypes.el       |  4 ++--
 hbut.el           |  2 +-
 hpath.el          | 41 ++++++++++++++++++++++++++++-------------
 hui.el            |  5 +++--
 test/hui-tests.el | 20 ++++++++++++++------
 6 files changed, 73 insertions(+), 24 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 788ec03965..108878b68a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,30 @@
+2024-11-18  Bob Weiner  <rsw@gnu.org>
+
+* hactypes.el (require): Remove require of 'man' and do it only in
+    man-show where needed.  This may allow CI/CD build of docker Emacs
+    master branch that lacks 'man' package.
+
+2024-11-18  bw  <bw@norlinux>
+
+* hui-tests.el (hui--ibut-link-directly-to-org-header-first-column):
+    Remove dir from fileb when comparing to in-buffer filename and
+    do the same for other tests in this file.
+
 2024-11-17  Bob Weiner  <rsw@gnu.org>
 
+* hpath.el (hpath:call): Allow for # sections with # chars embedded.
+
+* hpath.el (hpath:shorten): First make path relative to any optional 
RELATIVE-TO
+    path (default = 'default-directory') and expand both paths.  This makes
+    inserting a link from the other window display the minimal path to produce
+    the link relative to the source path.
+
+* hui.el (hui:link-possible-types): Ensure outline modes trigger only when
+    'buffer-file-name' is non-nil since is used in the return value.  Simplify
+    'link-to-string-match' and other link types.
+
+* hpath.el (hpath:variables): Add 'hywiki-directory' for use in path 
substitutions.
+
 * hywiki.el (hywiki-word-at, hywiki-maybe-dehighlight-page-name): Fix to 
exclude
     any char after the HyWikiWord, if any.
 
diff --git a/hactypes.el b/hactypes.el
index e5cd6e263b..9c8bf7b1a7 100644
--- a/hactypes.el
+++ b/hactypes.el
@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:    23-Sep-91 at 20:34:36
-;; Last-Mod:     30-Jun-24 at 17:12:44 by Bob Weiner
+;; Last-Mod:     18-Nov-24 at 23:27:33 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -18,7 +18,7 @@
 ;;; Other required Elisp libraries
 ;;; ************************************************************************
 
-(eval-and-compile (mapc #'require '(bookmark hvar hsettings comint hbut hpath 
hargs hmail man hsys-org)))
+(eval-and-compile (mapc #'require '(bookmark hvar hsettings comint hbut hpath 
hargs hmail hsys-org)))
 
 ;;; ************************************************************************
 ;;; Public declarations
diff --git a/hbut.el b/hbut.el
index cb319bec06..4cd3790bec 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:     13-Oct-24 at 20:53:36 by Bob Weiner
+;; Last-Mod:     18-Nov-24 at 20:17:13 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
diff --git a/hpath.el b/hpath.el
index 253143cc53..30a297b2d4 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:     24-Aug-24 at 01:31:41 by Bob Weiner
+;; Last-Mod:     18-Nov-24 at 20:16:58 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -554,7 +554,7 @@ Used only if the function `image-mode' is defined."
 ;; link is later resolved.
 ;;
 (defcustom hpath:variables
-  '(hyperb:dir load-path exec-path Info-directory-list sm-directory)
+  '(hyperb:dir hywiki-directory load-path exec-path Info-directory-list 
sm-directory)
   "*List of Emacs Lisp variable symbols to substitute within matching link 
paths.
 Each variable value, if bound, must be either a pathname or a list of 
pathnames.
 When embedded within a path, the format is ${variable}."
@@ -940,14 +940,16 @@ if (hpath:remote-available-p) returns nil."
 
 (defun hpath:at-p (&optional type non-exist)
   "Return delimited path or non-delimited remote path at point, if any.
-Path is expanded and normalized.  World-Wide Web urls are ignored
-and therefore dealt with by other code.  Delimiters may be:
-double quotes, open and close single quote, whitespace, or
-Texinfo file references.  If optional TYPE is the symbol \\='file or
-\\='directory, then only that path type is accepted as a match.
-Only locally reachable paths are checked for existence.  With
-optional NON-EXIST, nonexistent local paths are allowed.
-Absolute pathnames must begin with a `/' or `~'."
+Path is expanded and normalized.  See `hpath:is-p' for how the path
+is normalized.
+
+World-Wide Web urls are ignored and therefore dealt with by other
+code.  Delimiters may be: double quotes, open and close single
+quote, whitespace, or Texinfo file references.  If optional TYPE
+is the symbol \\='file or \\='directory, then only that path type
+is accepted as a match.  Only locally reachable paths are checked
+for existence.  With optional NON-EXIST, nonexistent local paths
+are allowed.  Absolute pathnames must begin with a `/' or `~'."
   (let ((path (hpath:delimited-possible-path non-exist))
        subpath)
     (when path
@@ -1063,7 +1065,7 @@ Make any existing path within a file buffer absolute 
before returning."
                        ;; match to in-file #anchor references
                        (string-match "\\`#[^+\'\"<>#]+\\'" path))
                   (setq path (concat mode-prefix buffer-file-name path)))
-                 ((string-match "\\`\\([^#]+\\)\\(#[^#+]*\\)\\'" path)
+                 ((string-match "\\`\\([^#]+\\)\\(#[^#+]*.*\\)\\'" path)
                   ;; file and #anchor reference
                   (setq suffix (match-string 2 path)
                         path (match-string 1 path))
@@ -2024,12 +2026,25 @@ prior to calling this function."
          (error ""))
       var-group)))
 
-(defun hpath:shorten (path)
-  "Shorten and return a PATH.
+(defun hpath:shorten (path &optional relative-to)
+  "Shorten and return a PATH optionally RELATIVE-TO other path.
+If RELATIVE-TO is omitted or nil, set it to `default-directory'.
 Replace Emacs Lisp variables and environment variables (format of
 ${var}) with their values in PATH.  The first matching value for
 variables like `${PATH}' is used.  Then abbreviate any remaining
 path."
+  (setq path (expand-file-name (hpath:substitute-value path)))
+  (unless relative-to
+    (setq relative-to default-directory))
+  (when (stringp relative-to)
+    (setq relative-to (expand-file-name
+                      (hpath:substitute-value relative-to))
+         path
+         (cond ((string-equal path relative-to)
+                "")
+               ((string-equal (file-name-directory path) relative-to)
+                (file-name-nondirectory path))
+               (t (hpath:relative-to path relative-to)))))
   (hpath:abbreviate-file-name (hpath:substitute-var path)))
 
 (defun hpath:substitute-value (path)
diff --git a/hui.el b/hui.el
index 3d064a6760..0d060b0928 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-Nov-24 at 15:44:56 by Bob Weiner
+;; Last-Mod:     18-Nov-24 at 20:05:31 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -1929,7 +1929,8 @@ Buffer without File      link-to-buffer-tmp"
                                          ;;
                                          ;; If current line starts with an 
outline-regexp prefix and
                                          ;; has a non-empty heading, use a 
link-to-string-match.
-                                         ((and (derived-mode-p 'outline-mode 
'org-mode 'kotl-mode)
+                                         ((and buffer-file-name
+                                               (derived-mode-p 'outline-mode 
'org-mode 'kotl-mode)
                                                (stringp outline-regexp)
                                                (save-excursion
                                                  (beginning-of-line)
diff --git a/test/hui-tests.el b/test/hui-tests.el
index 27de42def6..966547a11f 100644
--- a/test/hui-tests.el
+++ b/test/hui-tests.el
@@ -784,7 +784,9 @@ With point on label suggest that ibut for rename."
           (find-file filea)
           (hui:ibut-link-directly (get-buffer-window)
            (get-buffer-window (get-file-buffer fileb)))
-          (should (string= (buffer-string) (concat "\"" fileb ":L1:C10\""))))
+          (should (string= (buffer-string) (concat "\""
+                                      (file-name-nondirectory fileb)
+                                      ":L1:C10\""))))
       (hy-delete-file-and-buffer filea)
       (hy-delete-file-and-buffer fileb))))
 
@@ -827,7 +829,9 @@ With point on label suggest that ibut for rename."
           (find-file filea)
           (with-simulated-input "label RET"
             (hui:ibut-link-directly (get-buffer-window) (get-buffer-window 
(get-file-buffer fileb)) 4))
-          (should (string= (buffer-string) (concat "<[label]> - " "\"" fileb 
":L1:C10\""))))
+          (should (string= (buffer-string) (concat "<[label]> - " "\""
+                                      (file-name-nondirectory fileb)
+                                      ":L1:C10\""))))
       (hy-delete-file-and-buffer filea)
       (hy-delete-file-and-buffer fileb))))
 
@@ -844,7 +848,7 @@ With point on label suggest that ibut for rename."
           (find-file filea)
           (hui:ibut-link-directly (get-buffer-window)
                                   (get-buffer-window (get-file-buffer fileb)))
-          (should (string= (buffer-string) (concat "\"" fileb "#header\"")))
+          (should (string= (buffer-string) (concat "\"" 
(file-name-nondirectory fileb) "#header\"")))
           (goto-char (point-min))
           (search-forward "#")
           (action-key)
@@ -866,7 +870,7 @@ With point on label suggest that ibut for rename."
           (find-file filea)
           (hui:ibut-link-directly (get-buffer-window)
                                   (get-buffer-window (get-file-buffer fileb)))
-          (should (string= (buffer-string) (concat "\"" fileb 
"#header:L1:C1\"")))
+          (should (string= (buffer-string) (concat "\"" 
(file-name-nondirectory fileb) "#header:L1:C1\"")))
           (goto-char (point-min))
           (search-forward "#")
           (action-key)
@@ -890,7 +894,9 @@ With point on label suggest that ibut for rename."
           (find-file filea)
           (hui:ibut-link-directly (get-buffer-window)
                                   (get-buffer-window (get-file-buffer fileb)))
-          (should (string= (buffer-string) (concat "\"" fileb ":L2\"")))
+          (should (string= (buffer-string) (concat "\""
+                                      (file-name-nondirectory fileb)
+                                      ":L2\"")))
           (goto-char (point-min))
           (search-forward ":")
           (action-key)
@@ -976,7 +982,9 @@ With point on label suggest that ibut for rename."
             (hui:gbut-link-directly t)
             (with-current-buffer (find-buffer-visiting global-but-file)
               (should (string= (buffer-string)
-                               (concat "First\n<[button]> - \"" file 
":L1\""))))))
+                               (concat "First\n<[button]> - \""
+                                      (file-name-nondirectory file)
+                                      ":L1\""))))))
       (hy-delete-file-and-buffer global-but-file)
       (hy-delete-file-and-buffer file))))