hpath:shorten - Shorten paths and make relative to source path

Author: rswgnu

ChangeLog

@@ -1,5 +1,24 @@
+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  <[email protected]>
 
+* 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.
 

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
 ;;

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)

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)

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))))