[PATCH v2] ol-info: Define :insert-description function

[Max Nikulin <manikulin@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 640 bytes --]

On 06/08/2022 14:00, Ihor Radchenko wrote:
> Max Nikulin writes:
> 
>> +If LINK is not an info link then DESC is returned."
>> +  (or (org-string-nw-p desc)
>> +      (let* ((file-node (org-info-link-file-node link))
>> +             (file (car file-node))
>> +             (node (cadr file-node)))
> 
> pcase-let would be shorter here.

I have rewritten the patch to use `pcase' and to fix allowed separators 
between file name and node.

I have realized that unlike other type specific functions, 
:insert-description receives link including "scheme:" prefix. However 
attempt to achieve consistency at this point may cause more problems.

[-- Attachment #2: v2-0001-ol-info-Define-insert-description-function.patch --]
[-- Type: text/x-patch, Size: 11156 bytes --]

From 7aeaa36ee1b30aa1c9711fe76e151ec956199f27 Mon Sep 17 00:00:00 2001
From: Max Nikulin <manikulin@gmail.com>
Date: Sat, 30 Jul 2022 19:13:01 +0700
Subject: [PATCH v2] 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 as dir index,
Org manual is assumed if file is not specified for given node.
---
 lisp/ol-info.el               | 85 ++++++++++++++++++++++++++---------
 testing/lisp/test-org-info.el | 82 ++++++++++++++++++++++++++++++++-
 2 files changed, 146 insertions(+), 21 deletions(-)

diff --git a/lisp/ol-info.el b/lisp/ol-info.el
index dc5f6d5ba..0584e6f8c 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,68 @@
   "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 \"#\"."
+  (if (not path)
+      '("dir" . "Top")
+    (string-match "\\`\\([^#:]*\\)\\(?:[#:]:?\\(.*\\)\\)?\\'" path)
+    (let* ((node (match-string 2 path))
+           ;; `string-trim' modifies match
+           (file (string-trim (match-string 1 path)))
+           (has-file (org-string-nw-p file))
+           (has-node (org-string-nw-p node)))
+      (cons
+       ;; Fallback to "org" is an arbirtrary choice
+       ;; and added because "(dir)filename" does not work as "filename".
+       (if has-file file (if has-node "org" "dir"))
+       (if has-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 +141,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 +176,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 94923169c..3b8f85a2b 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,84 @@
 	  "@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)))
+  (should (equal '("org" . "Introduction")
+                 (org-info--link-file-node "#Introduction")))
+  ;; 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:")
+           ("info \"(org) Tables\"" "info::Tables")
+           (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