;;; ol-info.el --- Links to Info Nodes               -*- lexical-binding: t; -*-

;; Copyright (C) 2004-2022 Free Software Foundation, Inc.

;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; URL: https://orgmode.org
;;
;; 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:

;; This file implements links to Info nodes from within Org mode.
;; Org mode loads this module by default - if this is not what you want,
;; configure the variable `org-modules'.

;;; Code:

(require 'ol)

;; Declare external functions and variables

(declare-function Info-find-node "info"
                  (filename nodename &optional no-going-back strict-case))
(defvar Info-current-file)
(defvar Info-current-node)

;; Install the link type
(org-link-set-parameters "info"
			 :follow #'org-info-open
			 :export #'org-info-export
			 :store #'org-info-store-link)

;; Implementation
(defun org-info-store-link ()
  "Store a link to an Info file and node."
  (when (eq major-mode 'Info-mode)
    (let ((link (concat "info:"
			(file-name-nondirectory Info-current-file)
			"#" Info-current-node))
	  (desc (concat (file-name-nondirectory Info-current-file)
			"#" Info-current-node)))
      (org-link-store-props :type "info" :file Info-current-file
			    :node Info-current-node
			    :link link :description desc)
      link)))

(defun org-info-open (path _)
  "Follow an Info file and node link specified by PATH."
  (org-info-follow-link path))

(defun org-info-link-file-node (link)
  "Extract file name and node from info LINK.

Return list containing file name and node name or \"Top\".
Components may be separated by \"::\" or by \"#\"."
  (and
   link
   (or
    (string-match "\\`\\([^:]*:\\)?\\(.*\\)\\(?:#\\|::\\)\\(.*\\)?\\'" link)
    (string-match "\\`\\([^:]*:\\)?\\(.*\\)\\'" link))
   (let ((scheme (match-string 1 link))
         (file (match-string 2 link))
         (node (match-string 3 link)))
     (and
      (or (not scheme) (string-equal "info:" scheme))
      (org-string-nw-p file)
      (list file (or (org-string-nw-p node) "Top"))))))

(defun org-info-description-as-command (link desc)
  "Info link description that can be pasted as command.

For the folloing LINK

    \"info:elisp::Non-ASCII in Strings\"

the result is

    info \"(elisp) Non-ASCII in Strings\"

that may be executed as a 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.
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)))
        (cond
         ((and node (not (string-equal "Top" node)))
          (format "info \"(%s) %s\"" file node))
         (file (format "info %s" file))
         (t desc)))))


(defun org-info-follow-link (name)
  "Follow an Info file and node link specified by NAME."
  (let* ((file-node (org-info-link-file-node name))
         (filename (car file-node))
         (nodename-or-index (cadr file-node)))
    (if (not filename)
        (user-error "Could not open: %s" 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"
    "ebrowse" "ede" "ediff" "edt" "efaq-w32" "efaq" "eieio" "eintr" "elisp"
    "emacs-gnutls" "emacs-mime" "emacs" "epa" "erc" "ert" "eshell" "eudc" "eww"
    "flymake" "forms" "gnus" "htmlfontify" "idlwave" "ido" "info" "mairix-el"
    "message" "mh-e" "newsticker" "nxml-mode" "octave-mode" "org" "pcl-cvs"
    "pgg" "rcirc" "reftex" "remember" "sasl" "sc" "semantic" "ses" "sieve"
    "smtpmail" "speedbar" "srecode" "todo-mode" "tramp" "url" "vip" "viper"
    "widget" "wisent" "woman")
  "List of Emacs documents available.
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")
    ("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
converted to use these URL.")

(defun org-info-map-html-url (filename)
  "Return URL or HTML file associated to Info FILENAME.
If FILENAME refers to an official GNU document, return a URL pointing to
the official page for that document, e.g., use \"gnu.org\" for all Emacs
related documents.  Otherwise, append \".html\" extension to FILENAME.
See `org-info-emacs-documents' and `org-info-other-documents' for details."
  (cond ((member filename org-info-emacs-documents)
	 (format "https://www.gnu.org/software/emacs/manual/html_mono/%s.html"
		 filename))
	((cdr (assoc filename org-info-other-documents)))
	(t (concat filename ".html"))))

(defun org-info--expand-node-name (node)
  "Expand Info NODE to HTML cross reference."
  ;; See (info "(texinfo) HTML Xref Node Name Expansion") for the
  ;; expansion rule.
  (let ((node (replace-regexp-in-string
	       "\\([ \t\n\r]+\\)\\|\\([^a-zA-Z0-9]\\)"
	       (lambda (m)
		 (if (match-end 1) "-" (format "_%04x" (string-to-char m))))
	       (org-trim node))))
    (cond ((string= node "") "")
	  ((string-match-p "\\`[0-9]" node) (concat "g_t" node))
	  (t node))))

(defun org-info-export (path desc format)
  "Export an info link.
See `org-link-parameters' for details about PATH, DESC and FORMAT."
  (let* ((parts (org-info-link-file-node path))
	 (manual (car parts))
	 (node (nth 1 parts)))
    (pcase format
      (`html
       (format "<a href=\"%s#%s\">%s</a>"
	       (org-info-map-html-url manual)
	       (org-info--expand-node-name node)
	       (or desc path)))
      (`texinfo
       (let ((title (or desc "")))
	 (format "@ref{%s,%s,,%s,}" node title manual)))
      (_ nil))))

(provide 'ol-info)

;;; ol-info.el ends here