master bf9364a 1/2: Add a command to go the gnu.org version of the info page

[Lars Ingebrigtsen]

branch: master
commit bf9364a56e618277fe72c90b3a741ade8bc0d205
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Add a command to go the gnu.org version of the info page
    
    * lisp/info.el (Info-url-for-node):
    (Info-goto-node-web): New function (bug#44895).
    
    Based on code from Drew Adams <drew.adams@oracle.com>.
---
 etc/NEWS                |  7 +++++++
 lisp/info.el            | 47 ++++++++++++++++++++++++++++++++++++++++++++---
 test/lisp/info-tests.el | 39 +++++++++++++++++++++++++++++++++++++++
 3 files changed, 90 insertions(+), 3 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 20e6b7d..1dfdf640 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -210,6 +210,13 @@ change the terminal used on a remote host.
 
 * Changes in Specialized Modes and Packages in Emacs 29.1
 
+** Info
+
+---
+*** New command 'Info-goto-node-web' and key binding 'W'.
+This will take you to the gnu.org web server's version of the current
+info node.  This command only works for the Emacs and Emacs Lisp manuals.
+
 ** vc
 
 ---
diff --git a/lisp/info.el b/lisp/info.el
index 41889d6..28f25d0 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -1792,7 +1792,46 @@ of NODENAME; if none is found it then tries a 
case-insensitive match
       (if trim (setq nodename (substring nodename 0 trim))))
     (if transient-mark-mode (deactivate-mark))
     (Info-find-node (if (equal filename "") nil filename)
-                   (if (equal nodename "") "Top" nodename) nil strict-case)))
+                    (if (equal nodename "") "Top" nodename) nil strict-case)))
+
+(defun Info-goto-node-web (node)
+  "Use `browse-url' to go to the gnu.org web server's version of NODE.
+By default, go to the current Info node."
+  (interactive (list (Info-read-node-name
+                      "Go to node (default current page): " Info-current-node))
+               Info-mode)
+  (browse-url-button-open-url
+   (Info-url-for-node (format "(%s)%s" (file-name-sans-extension
+                                        (file-name-nondirectory
+                                         Info-current-file))
+                              node))))
+
+(defun Info-url-for-node (node)
+  "Return a URL for NODE, a node in the GNU Emacs or Elisp manual.
+NODE should be a string on the form \"(manual)Node\".  Only emacs
+and elisp manuals are supported."
+  (unless (string-match "\\`(\\(.+\\))\\(.+\\)\\'" node)
+    (error "Invalid node name %s" node))
+  (let ((manual (match-string 1 node))
+        (node (match-string 2 node)))
+    (unless (member manual '("emacs" "elisp"))
+      (error "Only emacs/elisp manuals are supported"))
+    ;; Encode a bunch of characters the way that makeinfo does.
+    (setq node
+          (mapconcat (lambda (ch)
+                       (if (or (< ch 32)        ; ^@^A-^Z^[^\^]^^^-
+                               (<= 33 ch 47)    ; !"#$%&'()*+,-./
+                               (<= 58 ch 64)    ; :;<=>?@
+                               (<= 91 ch 96)    ; [\]_`
+                               (<= 123 ch 127)) ; {|}~ DEL
+                           (format "_00%x" ch)
+                         (char-to-string ch)))
+                     node
+                     ""))
+    (concat "https://www.gnu.org/software/emacs/manual/html_node/";
+            manual "/"
+            (url-hexify-string (string-replace " " "-" node))
+            ".html")))
 
 (defvar Info-read-node-completion-table)
 
@@ -1877,7 +1916,7 @@ See `completing-read' for a description of arguments and 
usage."
        code Info-read-node-completion-table string predicate))))
 
 ;; Arrange to highlight the proper letters in the completion list buffer.
-(defun Info-read-node-name (prompt)
+(defun Info-read-node-name (prompt &optional default)
   "Read an Info node name with completion, prompting with PROMPT.
 A node name can have the form \"NODENAME\", referring to a node
 in the current Info file, or \"(FILENAME)NODENAME\", referring to
@@ -1885,7 +1924,8 @@ a node in FILENAME.  \"(FILENAME)\" is a short format to 
go to
 the Top node in FILENAME."
   (let* ((completion-ignore-case t)
         (Info-read-node-completion-table (Info-build-node-completions))
-        (nodename (completing-read prompt #'Info-read-node-name-1 nil t)))
+         (nodename (completing-read prompt #'Info-read-node-name-1 nil t nil
+                                    'Info-minibuf-history default)))
     (if (equal nodename "")
        (Info-read-node-name prompt)
       nodename)))
@@ -4067,6 +4107,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
     (define-key map "T" 'Info-toc)
     (define-key map "u" 'Info-up)
     ;; `w' for consistency with `dired-copy-filename-as-kill'.
+    (define-key map "W" 'Info-goto-node-web)
     (define-key map "w" 'Info-copy-current-node-name)
     (define-key map "c" 'Info-copy-current-node-name)
     ;; `^' for consistency with `dired-up-directory'.
diff --git a/test/lisp/info-tests.el b/test/lisp/info-tests.el
new file mode 100644
index 0000000..3e2aa3e
--- /dev/null
+++ b/test/lisp/info-tests.el
@@ -0,0 +1,39 @@
+;;; info-tests.el --- Tests for info.el  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'info)
+(require 'ert)
+(require 'ert-x)
+
+(ert-deftest test-info-urls ()
+  (should (equal (Info-url-for-node "(emacs)Minibuffer")
+                 
"https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer.html";))
+  (should (equal (Info-url-for-node "(emacs)Minibuffer File")
+                 
"https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer-File.html";))
+  (should (equal (Info-url-for-node "(elisp)Backups and Auto-Saving")
+                 
"https://www.gnu.org/software/emacs/manual/html_node/elisp/Backups-and-Auto_002dSaving.html";))
+  (should-error (Info-url-for-node "(gnus)Minibuffer File")))
+
+;;; info-tests.el ends here