branch: externals/hyperbole
commit 3503b2c22b63bcb2bb14849af9b7940926797098
Author: bw <r...@gnu.org>
Commit: bw <r...@gnu.org>
hpath:shorten - Shorten paths and make relative to source path
---
ChangeLog | 19 +++++++++++++++++++
hbut.el | 2 +-
hpath.el | 41 ++++++++++++++++++++++++++++-------------
hui.el | 5 +++--
test/hui-tests.el | 20 ++++++++++++++------
5 files changed, 65 insertions(+), 22 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 788ec03965..1875bbe152 100644
--- a/ChangeLog
+++ b/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 <r...@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/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))))
