bug#44895: Add Info-copy-permalink

[Stefan Kangas <stefan@marxist.se>]

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

Drew Adams <drew.adams@oracle.com> writes:

> If you use Info+ then `G' (`Info-goto-node-web')
> takes you to the Web version of the current node.
>
> It uses function `Info-url-for-node' (also from
> Info+) to get the URL for that.

I think this looks useful for Emacs itself.  A rough attempt at doing
so attached.

Thoughts?

[-- Attachment #2: info-goto-web.diff --]
[-- Type: application/octet-stream, Size: 5918 bytes --]

diff --git a/lisp/info.el b/lisp/info.el
index c3684deb96..a3715942aa 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -1781,7 +1781,92 @@ Info-goto-node
       (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)))
+
+;;;###autoload
+(defun Info-goto-node-web (node &optional flip-new-win)
+  "Use `browse-url' to go to Info node NODE using a Web browser.
+With a prefix arg, reverse the effect of option
+`browse-url-new-window-flag'.
+
+NODE is the name of a node in the GNU Emacs or Elisp manual.
+Alternatively, NODE can have the form (MANUAL)NODE, where MANUAL is
+\"emacs\" or \"elisp\" and NODE is the name of the node in that
+manual.  Empty NODE in (MANUAL) defaults to the `Top' node."
+  (interactive (list (Info-read-node-name "Go to node: " Info-current-node) current-prefix-arg))
+  (require 'browse-url)
+  (unless Info-current-file (error "This command must be invoked from Info"))
+  (browse-url (Info-url-for-node node) (list (if flip-new-win
+                                                 (not browse-url-new-window-flag)
+                                               browse-url-new-window-flag))))
+
+;; See https://www.gnu.org/software/texinfo/manual/texinfo/html_node/
+;;             HTML-Xref-Node-Name-Expansion.html
+;;
+;; 1. The standard ASCII letters (a-z and A-Z) are not modified. All
+;;    other characters may be changed as specified below.
+;;
+;; 2. The standard ASCII numbers (0-9) are not modified except when a
+;;    number is the first character of the node name. In that case, see
+;;    below.
+;;
+;; 3. Multiple consecutive space, tab and newline characters are
+;;    transformed into just one space. (It’s not possible to have
+;;    newlines in node names with the current implementation, but we
+;;    specify it anyway, just in case.)
+;;
+;; 4. Leading and trailing spaces are removed.
+;;
+;; 5. After the above has been applied, each remaining space character is
+;;    converted into a ‘-’ character.
+;;
+;; 6. Other ASCII 7-bit characters are transformed into ‘_00xx’, where xx
+;;    is the ASCII character code in (lowercase) hexadecimal. This includes
+;;    ‘_’, which is mapped to ‘_005f’.
+;;
+;; 7. If the node name does not begin with a letter, the literal string
+;;    ‘g_t’ is prefixed to the result. (Due to the rules above, that
+;;    string can never occur otherwise; it is an arbitrary choice,
+;;    standing for “GNU Texinfo”.) This is necessary because XHTML
+;;    requires that identifiers begin with a letter.
+;;
+;;;###autoload
+(defun Info-url-for-node (node)
+  "Return a URL for NODE, a node in the GNU Emacs or Elisp manual.
+Alternatively, NODE can have the form (MANUAL)NODE, where MANUAL is
+\"emacs\" or \"elisp\" and NODE is the name of the node in that
+manual.  Empty NODE in (MANUAL) defaults to the `Top' node."
+  (interactive (list (Info-read-node-name "Node: " Info-current-node)))
+  (unless Info-current-file (error "This command must be invoked from Info"))
+  (let (file url)
+    (string-match "\\s *\\((\\s *\\([^\t)]*\\)\\s *)\\s *\\|\\)\\(.*\\)" node)
+    (setq file  (if (= (match-beginning 1) (match-end 1)) "" (match-string 2 node))
+          node  (match-string 3 node))
+    (when (equal node "") (setq node  "index")) ; `Top' node.
+    (let ((trim  (string-match "\\s +\\'" file)))
+      (when trim (setq file (substring file 0 trim))))
+    (let ((trim  (string-match "\\s +\\'" node)))
+      (when trim (setq node (substring node 0 trim))))
+    (when (equal file "") (setq file  Info-current-file))
+    (setq file  (file-name-sans-extension (file-name-nondirectory file)))
+    (unless (member file '("emacs" "elisp"))
+      (error "Manual cannot be `%s'; it can only be `emacs' or `elisp'" file))
+    (setq node  (mapconcat (lambda (ch)
+                             (if (or (< ch 32) ; ^@^A-^Z^[^\^]^^^-
+                                     (and (<= 33 ch)   (<= ch 47)) ; !"#$%&'()*+,-./
+                                     (and (<= 58 ch)   (<= ch 64)) ; :;<=>?@
+                                     (and (<= 91 ch)   (<= ch 96)) ; [\]_`
+                                     (and (<= 123 ch)  (<= ch 127))) ; {|}~ DEL
+                                 (format "_00%x" ch)
+                               (char-to-string ch)))
+                           node
+                           ""))
+    (setq node  (replace-regexp-in-string "[ \t]+" "-" node t t))
+    (unless (string-match-p "[[:alpha:]]" node) (setq node  (concat "g_t" node)))
+    (setq url  (concat "https://www.gnu.org/software/emacs/manual/html_node/"
+                       file "/" node ".html"))
+    (message "URL: %s" url)
+    url))
 
 (defvar Info-read-node-completion-table)
 
@@ -1865,7 +1950,7 @@ Info-read-node-name-1
        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
@@ -1873,7 +1958,8 @@ Info-read-node-name
 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)))