From 59b154e089788f49158b465c5b177c99889f2e06 Mon Sep 17 00:00:00 2001 From: Max Nikulin Date: Sat, 30 Jul 2022 19:13:01 +0700 Subject: [PATCH v3] 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 dc5f6d5ba..7be63b3e1 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 ") (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 "%s" diff --git a/testing/lisp/test-org-info.el b/testing/lisp/test-org-info.el index 94923169c..1ca2aca2e 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) "filename")) + ;; 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) + "dir")) ;; 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 -- 2.25.1