[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/org 372788a189 2/2: ol-info: Define :insert-description
From: |
ELPA Syncer |
Subject: |
[elpa] externals/org 372788a189 2/2: ol-info: Define :insert-description function |
Date: |
Fri, 26 Aug 2022 09:57:49 -0400 (EDT) |
branch: externals/org
commit 372788a18933b9ed38b747e5f5429ea39d71106a
Author: Max Nikulin <manikulin@gmail.com>
Commit: Ihor Radchenko <yantar92@gmail.com>
ol-info: Define :insert-description function
* lisp/ol-info.el (org-info--link-file-node): New helper to parse info
link info file (manual) name and node.
(org-info-follow-link, org-info-export): Use `org-info--link-file-node'.
(org-info-description-as-command): New function to create description
for info links that may executed to view the manual.
(org-link-parameters): Specify `org-info-description-as-command' as
`:insert-description' for info links.
(org-info-other-documents): Add URL of directory index.
* testing/lisp/test-org-info.el (test-org-info/export): Add cases for
texinfo export with link description.
(test-org-info/link-file-node, test-org-info/description-as-command):
New tests for new functions `org-info--link-file-node' and
`org-info-description-as-command'.
Use recently added :insert-description feature of `org-link'.
Alternative separators between file name and node ":", "::", "#:"
are preserved. Added interpretation of empty path or omitted
file name as info dir index.
---
lisp/ol-info.el | 82 +++++++++++++++++++++++++++++++----------
testing/lisp/test-org-info.el | 85 ++++++++++++++++++++++++++++++++++++++++++-
2 files changed, 146 insertions(+), 21 deletions(-)
diff --git a/lisp/ol-info.el b/lisp/ol-info.el
index dc5f6d5bad..7be63b3e14 100644
--- a/lisp/ol-info.el
+++ b/lisp/ol-info.el
@@ -30,6 +30,7 @@
;;; Code:
+(require 'subr-x) ; `string-trim', `string-remove-prefix'
(require 'ol)
;; Declare external functions and variables
@@ -43,7 +44,8 @@
(org-link-set-parameters "info"
:follow #'org-info-open
:export #'org-info-export
- :store #'org-info-store-link)
+ :store #'org-info-store-link
+ :insert-description #'org-info-description-as-command)
;; Implementation
(defun org-info-store-link ()
@@ -63,24 +65,65 @@
"Follow an Info file and node link specified by PATH."
(org-info-follow-link path))
+(defun org-info--link-file-node (path)
+ "Extract file name and node from info link PATH.
+
+Return cons consisting of file name and node name or \"Top\" if node
+part is not specified. Components may be separated by \":\" or by \"#\".
+File may be a virtual one, see `Info-virtual-files'."
+ (if (not path)
+ '("dir" . "Top")
+ (string-match "\\`\\([^#:]*\\)\\(?:[#:]:?\\(.*\\)\\)?\\'" path)
+ (let* ((node (match-string 2 path))
+ ;; Do not reorder, `string-trim' modifies match.
+ (file (string-trim (match-string 1 path))))
+ (cons
+ (if (org-string-nw-p file) file "dir")
+ (if (org-string-nw-p node) (string-trim node) "Top")))))
+
+(defun org-info-description-as-command (link desc)
+ "Info link description that can be pasted as command.
+
+For the following LINK
+
+ \"info:elisp#Non-ASCII in Strings\"
+
+the result is
+
+ info \"(elisp) Non-ASCII in Strings\"
+
+that may be executed as shell command or evaluated by
+\\[eval-expression] (wrapped with parenthesis) to read the manual
+in Emacs.
+
+Calling convention is similar to `org-link-make-description-function'.
+DESC has higher priority and returned when it is not nil or empty string.
+If LINK is not an info link then DESC is returned."
+ (let* ((prefix "info:")
+ (need-file-node (and (not (org-string-nw-p desc))
+ (string-prefix-p prefix link))))
+ (pcase (and need-file-node
+ (org-info--link-file-node (string-remove-prefix prefix link)))
+ ;; Unlike (info "dir"), "info dir" shell command opens "(coreutils)dir
invocation".
+ (`("dir" . "Top") "info \"(dir)\"")
+ (`(,file . "Top") (format "info %s" file))
+ (`(,file . ,node) (format "info \"(%s) %s\"" file node))
+ (_ desc))))
(defun org-info-follow-link (name)
"Follow an Info file and node link specified by NAME."
- (if (or (string-match "\\(.*\\)\\(?:#\\|::\\)\\(.*\\)" name)
- (string-match "\\(.*\\)" name))
- (let ((filename (match-string 1 name))
- (nodename-or-index (or (match-string 2 name) "Top")))
- (require 'info)
- ;; If nodename-or-index is invalid node name, then look it up
- ;; in the index.
- (condition-case nil
- (Info-find-node filename nodename-or-index)
- (user-error (Info-find-node filename "Top")
- (condition-case nil
- (Info-index nodename-or-index)
- (user-error "Could not find '%s' node or index entry"
- nodename-or-index)))))
- (user-error "Could not open: %s" name)))
+ (pcase-let ((`(,filename . ,nodename-or-index)
+ (org-info--link-file-node name)))
+ (require 'info)
+ ;; If nodename-or-index is invalid node name, then look it up
+ ;; in the index.
+ (condition-case nil
+ (Info-find-node filename nodename-or-index)
+ (user-error (Info-find-node filename "Top")
+ (condition-case nil
+ (Info-index nodename-or-index)
+ (user-error "Could not find '%s' node or index entry"
+ nodename-or-index))))))
(defconst org-info-emacs-documents
'("ada-mode" "auth" "autotype" "bovine" "calc" "ccmode" "cl" "dbus" "dired-x"
@@ -95,7 +138,8 @@
Taken from <https://www.gnu.org/software/emacs/manual/html_mono/.>")
(defconst org-info-other-documents
- '(("libc" . "https://www.gnu.org/software/libc/manual/html_mono/libc.html")
+ '(("dir" . "https://www.gnu.org/manual/manual.html") ; index
+ ("libc" . "https://www.gnu.org/software/libc/manual/html_mono/libc.html")
("make" . "https://www.gnu.org/software/make/manual/make.html"))
"Alist of documents generated from Texinfo source.
When converting info links to HTML, links to any one of these manuals are
@@ -129,9 +173,7 @@ See `org-info-emacs-documents' and
`org-info-other-documents' for details."
(defun org-info-export (path desc format)
"Export an info link.
See `org-link-parameters' for details about PATH, DESC and FORMAT."
- (let* ((parts (split-string path "#\\|::"))
- (manual (car parts))
- (node (or (nth 1 parts) "Top")))
+ (pcase-let ((`(,manual . ,node) (org-info--link-file-node path)))
(pcase format
(`html
(format "<a href=\"%s#%s\">%s</a>"
diff --git a/testing/lisp/test-org-info.el b/testing/lisp/test-org-info.el
index 94923169cf..1ca2aca2ef 100644
--- a/testing/lisp/test-org-info.el
+++ b/testing/lisp/test-org-info.el
@@ -28,6 +28,11 @@
(should
(equal (org-info-export "filename" nil 'html)
"<a href=\"filename.html#Top\">filename</a>"))
+ ;; Directory index. Top anchor actually should not be added,
+ ;; but it should be rather rare case to add special code path.
+ (should
+ (equal (org-info-export "dir" nil 'html)
+ "<a href=\"https://www.gnu.org/manual/manual.html#Top\">dir</a>"))
;; When exporting to HTML, ensure node names are expanded according
;; to (info "(texinfo) HTML Xref Node Name Expansion").
(should
@@ -56,9 +61,87 @@
"@ref{Top,,,filename,}"))
(should
(equal (org-info-export "filename#node" nil 'texinfo)
- "@ref{node,,,filename,}")))
+ "@ref{node,,,filename,}"))
+ ;; "Top" is preserved, "::" as node separator.
+ (should
+ (equal "@ref{Top,,,emacs,}"
+ (org-info-export "emacs::Top" nil 'texinfo)))
+
+ ;; Description.
+ (should
+ (equal "@ref{Top,Emacs,,emacs,}"
+ (org-info-export "emacs" "Emacs" 'texinfo)))
+ (should
+ (equal "@ref{Destructuring with pcase Patterns,pcase-let,,emacs,}"
+ (org-info-export "emacs#Destructuring with pcase Patterns"
+ "pcase-let" 'texinfo))))
+(ert-deftest test-org-info/link-file-node ()
+ "Test parse info links by `org-info--link-file-node'."
+ (should (equal '("success" . "Hash Separator")
+ (org-info--link-file-node "success#Hash Separator")))
+ ;; Other separators.
+ (should (equal '("success" . "Single Colon Separator")
+ (org-info--link-file-node "success:Single Colon Separator")))
+ (should (equal '("success" . "Double Colon Separator")
+ (org-info--link-file-node "success::Double Colon Separator")))
+ (should (equal '("success" . "Hash Colon Separator")
+ (org-info--link-file-node "success#:Hash Colon Separator")))
+ ;; Partial specification.
+ (should (equal '("nodeless" . "Top")
+ (org-info--link-file-node "nodeless")))
+ (should (equal '("dir" . "Top")
+ (org-info--link-file-node "")))
+ (should (equal '("dir" . "Top")
+ (org-info--link-file-node nil)))
+ ;; Feel free to change behavior of underspecified links,
+ ;; the case is added to check that it does not signal some error.
+ (should (equal '("dir" . "broken")
+ (org-info--link-file-node "#broken")))
+ ;; Trailing separator.
+ (should (equal '("trailing-hash" . "Top")
+ (org-info--link-file-node "trailing-hash#")))
+ (should (equal '("trailing-single-colon" . "Top")
+ (org-info--link-file-node "trailing-single-colon:")))
+ (should (equal '("trailing-double-colon" . "Top")
+ (org-info--link-file-node "trailing-double-colon::")))
+ (should (equal '("trailing-hash-colon" . "Top")
+ (org-info--link-file-node "trailing-hash-colon#:")))
+ ;; Trim spaces.
+ (should (equal '("trim" . "Spaces")
+ (org-info--link-file-node " trim # Spaces \t"))))
+(ert-deftest test-org-info/description-as-command ()
+ "Test `org-info-description-as-command'."
+ (let ((cases
+ '(("info file" "info:file")
+ ("info strip-top-hash" "info:strip-top-hash#Top")
+ ("info strip-top-single-colon" "info:strip-top-single-colon:Top")
+ ("info strip-top-double-colon" "info:strip-top-double-colon::Top")
+ ("info \"(pass) Hash\"" "info:pass#Hash")
+ ("info \"(pass) Double Colon\"" "info:pass:: Double Colon")
+ ("info \"(info) Advanced\"" "info:info:Advanced")
+ ("info \"(dir)\"" "info:")
+ ;; It actually works as "(dir) Top", test that no errors is
signalled.
+ ("info \"(dir) Invalid\"" "info::Invalid")
+ (nil "http://orgmode.org/index.html#Not-info-link"))))
+ (dolist (expectation-input cases)
+ (let ((expectation (car expectation-input))
+ (input (cadr expectation-input)))
+ (should (equal
+ expectation
+ (org-info-description-as-command input nil))))))
+ (let ((cases
+ '(("Override link" "info:ignored#Link" "Override link")
+ ("Fallback description" "http://not.info/link" "Fallback
description")
+ ("Link is nil" nil "Link is nil"))))
+ (dolist (expectation-input-desc cases)
+ (let ((expectation (car expectation-input-desc))
+ (input (cadr expectation-input-desc))
+ (desc (nth 2 expectation-input-desc)))
+ (should (equal
+ expectation
+ (org-info-description-as-command input desc)))))))
(provide 'test-org-info)
;;; test-org-info.el ends here