;;; latex-help.el --- Lookup LaTeX symbols  -*- lexical-binding: t -*-

;;; Commentary:
;; This is inspired by an old package (originally from the 90s!!) called
;; ltx-help.el.  This package used to be called latex-help.el too, but it seems
;; to have had its name changed sometime around 2010.  This package aims for
;; similar functionality, but using more up to date and convention-conforming
;; Elisp.  For example, the original package still assumes that you may not have
;; `add-hook' or `buffer-substring-no-properties'.  Only very old versions of
;; Emacs are missing these, so almost everyone has them nowadays.

;;; Code:
(require 'info)
(require 'cl-lib)
(require 'shr)

(defcustom latex-help-info-manual "latex2e"
  "The name of the info manual to use when looking up latex commands."
  :group 'latex-help
  :type '(choice
	      (string :tag "English" "latex2e")
	      (string :tag "French" "latex2e-fr")
	      (string :tag "Spanish" "latex2e-es")))

(defcustom latex-help-buffer-name "*latex-help*"
  "The name of the info buffer to use when showing LaTeX documentation."
  :group 'latex-help
  :type 'string)

(defcustom latex-help-texdoc-buffer-name "*latex-help-texdoc*"
  "The name of the buffer to use when showing texdoc files."
  :group 'latex-help
  :type 'string)

(defcustom latex-help-texdoc-program "texdoc"
  "The program to use when looking things up with texdoc."
  :group 'latex-help
  :type '(string :tag "Executable name"))

(defcustom latex-help-pdf-view-program '(emacs "evince")
  "The program to use to view PDF documentation files."
  :group 'latex-help
  :type '(choice
          (string :tag "External program")
          (const :tag "Texdoc default" texdoc)
          (function :tag "Custom function")
          (list :tag "Emacs Doc-View mode"
                (const :tag "Emacs will be used as the default" emacs)
                (choice :tag "Backup"
                        (string :tag "Use external program as a backup")
                        (const :tag "Use texdoc default as a backup" texdoc)
                        (function :tag "Use a custom function as a backup")))))

(defcustom latex-help-html-view-program 'emacs
  "The program to use to view PDF documentation files."
  :group 'latex-help
  :type '(choice
          (string :tag "External program")
          (const :tag "Texdoc default" texdoc)
          (const :tag "Emacs internal HTML engine" emacs)
          (function :tag "Custom function")))

(defcustom latex-help-documentation-roots '("/usr/share/texmf-dist/doc/")
  "The directories to search to discover texdoc entries."
  :group 'latex-help
  :type '(repeat directory))

(defvar latex-help--class-cache nil
  "Cache of discovered LaTeX document classes.")

(defvar latex-help--environment-cache nil
  "Cache of discovered LaTeX environments.")

(defvar latex-help--package-cache nil
  "Cache of discovered LaTeX packages.")

(defvar latex-help--commands-cache nil
  "Cache of discovered of LaTeX commands.
These do NOT have a leading '\\'.")

(defvar latex-help--texdoc-cache nil
  "Cache of texdoc entries.")

(defvar latex-help--caches-initialized-p nil
  "Non-nil if the latex-help caches have been initialized.")

(defun latex-help--maybe-init-caches ()
  "Init the latex-help caches if they ware empty."
  (unless latex-help--caches-initialized-p
    (setq latex-help--commands-cache (latex-help--discover-commands)
          latex-help--package-cache (latex-help--discover-packages)
          latex-help--environment-cache (latex-help--discover-environments)
          latex-help--class-cache (latex-help--discover-classes)
          latex-help--texdoc-cache (latex-help--discover-texdoc-entries)
          latex-help--caches-initialized-p t)))

(defun latex-help--open-file-with (cmd file)
  "Open FILE with shell command CMD."
  (call-process-shell-command (format "%s %s" cmd
                                      (shell-quote-argument file))
                              nil 0))

(defun latex-help--open-file-with-texdoc (file)
  "Open FILE with texdoc."
  (call-process latex-help-texdoc-program nil 0 nil "--just-view" file))

(defun latex-help--texdoc-open-pdf-file (file)
  "Open the PDF file FILE."
  (cond
   ((and (listp latex-help-pdf-view-program)
         (eq (car latex-help-pdf-view-program) 'emacs))
    (let ((backup (cadr latex-help-pdf-view-program)))
      (cond
       ((display-graphic-p)
        (find-file-other-window file))
       ((eq backup 'texdoc)
        (latex-help--open-file-with-texdoc file))
       ((functionp backup)
        (funcall backup file))
       ((stringp backup)
        (latex-help--open-file-with backup file)))))
   ((eq latex-help-pdf-view-program 'texdoc)
    (latex-help--open-file-with-texdoc file))
   ((functionp latex-help-pdf-view-program)
    (funcall latex-help-pdf-view-program file))
   ((stringp latex-help-pdf-view-program)
    (latex-help--open-file-with latex-help-pdf-view-program file))))

(defun latex-help--pop-to-texdoc-buffer ()
  "Pop to (and possibly create) the texdoc buffer.
The buffer's name is from `latex-help-texdoc-buffer-name'."
  (pop-to-buffer (get-buffer-create latex-help-texdoc-buffer-name))
  (setq buffer-read-only t)
  (special-mode))

(defun latex-help--texdoc-open-html-file (file)
  "Open the HTML file FILE."
  (cond
   ((eq latex-help-html-view-program 'emacs)
    (latex-help--pop-to-texdoc-buffer)
    (let ((buffer-read-only nil))
      (erase-buffer)
      (insert-file-contents file nil)
      (shr-render-region (point-min) (point-max))
      (goto-char (point-min))))
   ((eq latex-help-html-view-program 'texdoc)
    (latex-help--open-file-with-texdoc file))
   ((functionp latex-help-html-view-program)
    (funcall latex-help-html-view-program file))
   ((stringp latex-help-html-view-program)
    (latex-help--open-file-with latex-help-html-view-program file))))

(defun latex-help--texdoc-maybe-text-file (file)
  "Try to open FILE as a text file.
Read FILE into a buffer.  If it is a text file, show the user that buffer, and
return t. Otherwise, kill the buffer and return nil."
  (with-current-buffer (generate-new-buffer "*latex-help-texdoc-temp*")
    (setq buffer-read-only t)
    (special-mode)
    (let ((buffer-read-only nil))
      (erase-buffer)
      (insert-file-contents file nil)
      (if (eq buffer-file-coding-system 'no-conversion)
          ;; the file was a binary file
          (progn
            (let ((kill-buffer-query-functions nil))
              (set-buffer-modified-p nil)
              (kill-buffer (current-buffer))
              (user-error "File \"%s\" is binary" file)))
        ;; we are good to go
        (when-let (old-buffer (get-buffer latex-help-texdoc-buffer-name))
          (kill-buffer old-buffer))
        (rename-buffer latex-help-texdoc-buffer-name)
        (pop-to-buffer (current-buffer))))))

(defun latex-help--texdoc-open-file (file)
  "Open the texdoc file FILE.
This will attempt to detect the file's type and open it with the correct
program."
  (let ((ext (or (file-name-extension file) "")))
    (cond
     ((string-equal-ignore-case ext "pdf")
      (latex-help--texdoc-open-pdf-file file))
     ((string-equal-ignore-case ext "html")
      (latex-help--texdoc-open-html-file file))
     (t (latex-help--texdoc-maybe-text-file file)))))

(defun latex-help--get-thing-at-point ()
  "Return a cons of the LaTeX thing at point and its type (as a symbol).
If nothing is found, return nil.
The following types are known:
  - command
  - package
  - environment
  - class

The following are some examples:
  - \\textbf{Hello World}                     -> \\='(\"textbf\" . command)
  - \\begin{math} (on \"math\")               -> \\='(\"math\" . environment)
  - \\begin{math} (on \"begin\")              -> \\='(\"begin\" . command)
  - \\usepackage{amsmath} (on \"amsmath\")    -> \\='(\"amsmath\" . package)
  - \\usepackage{amsmath} (on \"usepackage\") -> \\='(\"usepackage\" . command)"
  (save-excursion
    (let ((orig-point (point)))
      (when (eq (char-after) ?\\)
        (forward-char))
      (when (and (search-backward "\\" nil t)
                 (looking-at (rx "\\"
                                 (group (+ (not (any " " "\n" "("
                                                     "{" "[" "|"
                                                     "}" "]" ")")))))))
        (let ((cmd (match-string-no-properties 1)))
          (if (> (match-end 1) orig-point)
              (cons cmd 'command)
            (goto-char orig-point)
            (condition-case _
                (progn
                  (backward-up-list nil t t)
                  (when (looking-at (rx "{" (group (+ (not (any "}" "\n"))))))
                    (let ((thing (match-string-no-properties 1)))
                      (cond
                       ((equal cmd "usepackage")
                        (cons thing 'package))
                       ((or (equal cmd "begin")
                            (equal cmd "end"))
                        (cons thing 'environment))
                       ((equal cmd "documentclass")
                        (cons thing 'class))))))
              ;; just return nil
              ((or user-error scan-error)))))))))

(defun latex-help--is-marker-file (file root)
  "Return non-nil if FILE is a texdoc marker file under ROOT.
A marker file is a file that signifies that its parent is a texdoc entry."
  (let ((name (file-name-nondirectory file))
        (dirname (file-name-nondirectory
                  (directory-file-name (file-name-parent-directory file))))
        (case-fold-search t))
    (and
     (not (length= (file-name-split (file-relative-name file root)) 2))
     (or (string-match (rx bos "readme" (* "." (+ (any (?a . ?z))))) name)
         (string-match (rx bos "doc" eos) name)
         (string-match (rx bos "base" eos) name)
         ;; check if file is just its parent directories name with an .tex or
         ;; .pdf
         (string-match (format "^%s[-0-9]*\\.\\(?:tex\\|pdf\\)$"
                               (regexp-quote dirname))
                       name)))))

(defun latex-help--search-texdoc-root (root)
  "Search the texdoc root directory ROOT and discover package names."
  (cl-loop with found = nil
           with to-search = nil
           for dir = root then (pop to-search)
           while dir
           when (file-directory-p dir) do
           (let ((files (directory-files dir t)))
             (if (cl-member-if (lambda (file)
                                 (latex-help--is-marker-file file root))
                               files)
                 ;; dir is an entry
                 (push (cons (directory-file-name
                              (file-name-nondirectory dir))
                             (file-name-as-directory dir))
                       found)
               ;; search all subdirs
               (setq to-search
                     (nconc to-search
                            (seq-filter
                             (lambda (file)
                               (let ((name (file-name-nondirectory file)))
                                 (and (not (equal name "."))
                                      (not (equal name "..")))))
                             files)))))
           finally return found))

(defun latex-help--discover-texdoc-entries ()
  "Discover texdoc entries in each of `latex-help-documentation-roots'."
  (cl-loop for root in latex-help-documentation-roots
           append (latex-help--search-texdoc-root root)))

(defun latex-help--texdoc-files-for-entry (entry)
  "List the texdoc files for ENTRY.
ENTRY is of the form (name . dir).  This returns a list of conses of the display
name of the entry and the file it belongs to.  The first item the the returned
list is the default value when prompting with `completing-read'."
  (with-temp-buffer
    (when-let ((exit-code (call-process latex-help-texdoc-program nil t
                                        nil "-Ml" (car entry)))
               ((not (zerop exit-code))))
      ;; try to get the programs output without the normal Emacs process
      ;; sentinel message
      (goto-char (point-max))
      (forward-line -2)
      (end-of-line)
      (let ((msg (buffer-substring-no-properties (point-min)
                                                 (point))))
        (user-error "Texdoc exited with a non-zero code: %d%s"
                    exit-code (if (not (zerop (length msg)))
                                  (concat "\n\n" msg)
                                ""))))
    ;; the process succeeded, try to extract the files it found
    (goto-char (point-min))
    (let ((found))
      (while (re-search-forward (rx (and bol (= 2 (+ (not "\t")) "\t")
                                         (group (+ (not "\t")))
                                         "\t"
                                         (? (+ (not "\t")))
                                         "\t"
                                         (group (* any))))
                                nil t)
        (let* ((file (match-string 1))
               (relname (file-relative-name (match-string 1)
                                            (cdr entry)))
               (desc (match-string 2))
               (prompt (if (zerop (length desc))
                           relname
                         (format "%s (%s)" desc relname))))
          ;; check if the file is actually belongs to this entry
          (when (string-prefix-p (cdr entry) file)
            (push (cons prompt file) found))))
      (nreverse found))))

(defun latex-help--texdoc-prompt-for-entry-file (entry)
  "Prompt the user to open a texdoc file from ENTRY.
This will return nil if the user does not want to open the file."
  (let ((entries (latex-help--texdoc-files-for-entry entry)))
    (if (length= entries 1)
        (and (y-or-n-p (format "Open texdoc \"%s\"?" (caar entries)))
             (cdar entries))
      (let ((ans (completing-read "Texdoc File: " (mapcar 'car entries) nil t
                                  nil nil (caar entries))))
        (unless (zerop (length ans))
          (cdr (assoc ans entries)))))))

(defvar latex-help--texdoc-history nil
  "History for `latex-heklp--list-texdoc-files'.")

(defun latex-help--prompt-texdoc-entry ()
  "Ask the user for a texdoc entry.
This returns the actual entry from `latex-help--texdoc-cache'.  Therefore, the
result is a cons."
  (latex-help--maybe-init-caches)
  (let* ((tap (latex-help--get-thing-at-point))
         (has-default-p (and (member (cdr tap) '(package class))
                             (assoc (car tap) latex-help--texdoc-cache)))
         (ans (completing-read (format "Texdoc Entry%s: "
                                       (if has-default-p
                                           (format " (default %s)" (car tap))
                                         ""))
                               (mapcar 'car latex-help--texdoc-cache)
                               nil t nil 'latex-help--texdoc-history
                               (and has-default-p (car tap)))))
    (unless (zerop (length ans))
      (assoc ans latex-help--texdoc-cache))))

(defun latex-help--run-index-search (regexp)
  "Search the LaTeX info pages index for REGEXP.
This returns a list of cache entries suitable for use in
`latex-help--commands-cache'."
  (with-temp-buffer
    (Info-mode)
    (Info-find-node latex-help-info-manual "Index" nil t)
    (let ((found))
      (while (re-search-forward regexp nil t)
        (let ((match (match-string-no-properties 1))
              (node (match-string-no-properties 2)))
          (if (equal (caar found) match)
              (push (cons node (pos-bol)) (cdar found))
            (push (list match (cons node (pos-bol))) found))))
      found)))

(defun latex-help--discover-commands ()
  "Discover LaTeX commands.
This is done by parsing the index for `latex-help-info-manual'."
  (let ((found (latex-help--run-index-search
                (rx (and bol "* \\"
                         (group (or
                                 ","
                                 (+ (not (any " " "{" ",")))))
                         (*? any) ":" (+ " ")
                         (group (+? any)) ".")))))
    (push (list "(SPACE)" "\\(SPACE)") found)
    (when-let (entry (assoc "(...\\)" found))
      (setq found (assoc-delete-all "(...\\)" found))
      (push (cons "(" (cdr entry)) found)
      (push (cons ")" (cdr entry)) found))
    (when-let (entry (assoc "[...\\]" found))
      (setq found (assoc-delete-all "[...\\]" found))
      (push (cons "[" (cdr entry)) found)
      (push (cons "]" (cdr entry)) found))
    found))

(defun latex-help--discover-packages ()
  "Discover LaTeX packages.
This is done by parsing the index for `latex-help-info-manual'."
  (latex-help--run-index-search (rx (and bol "* package, "
                                         (group (+? any))
                                         (any " " ":")
                                         (+? any) (+ " ")
                                         (group (+? any))
                                         "."))))

(defun latex-help--discover-environments ()
  "Discover LaTeX environments.
This is done by parsing the index for `latex-help-info-manual'."
  (latex-help--run-index-search (rx (and bol "* environment, "
                                         (group (+? any))
                                         (any " " ":" "-")
                                         (+? any) (+ " ")
                                         (group (+? any))
                                         "."))))

(defun latex-help--discover-classes ()
  "Discover LaTeX document classes.
This is done by parsing the index for `latex-help-info-manual'."
  (latex-help--run-index-search (rx (and bol "* "
                                         (group (+ (not (any "," " "))))
                                         " class:" (+ " ")
                                         (group (+ (not ".")))))))

(defun latex-help--info-goto-entry (entry)
  "Open the info page for ENTRY, a cache entry."
  (let ((buffer (get-buffer-create latex-help-buffer-name)))
    (with-current-buffer buffer
      (unless (derived-mode-p 'Info-mode)
        (Info-mode))
      (Info-find-node latex-help-info-manual "Index" nil t)
      (goto-char (cdr entry))
      (Info-follow-nearest-node))
    (pop-to-buffer buffer)))

(defun latex-help--get-cache-for-type (type)
  "Lookup the cache for TYPE.
If the caches are not yet initialized, do that first."
  (latex-help--maybe-init-caches)
  (cl-case type
    (command latex-help--commands-cache)
    (package latex-help--package-cache)
    (environment latex-help--environment-cache)
    (class latex-help--class-cache)))

(defvar latex-help--info-history nil
  "History list for `latex-help--prompt-for'.")

(defun latex-help--maybe-prompt-entry (name type &optional default)
  "Lookup and prompt the user for the node of NAME.
The lookup is performed in the correct cache for TYPE.  If there is only one
node associated with NAME, return its entry.  Otherwise, ask the user which node
they want to use.

If DEFAULT is non-nil, use that instead of prompting.  If it does not exist,
return nil."
  (when-let (entries (cdr (assoc name (latex-help--get-cache-for-type type))))
    (cond
     (default
      (assoc default entries))
     ((length= entries 1)
      (car entries))
     (t
      (let ((resp (completing-read "Select Node: " (mapcar 'car entries)
                                   nil t nil)))
        (assoc resp entries))))))

(defun latex-help--prompt-for (type)
  "Prompt for a command, environment, etc. from TYPE.
This returns the name of the thing that was prompted."
  (let* ((cache (latex-help--get-cache-for-type type))
         (tap (latex-help--get-thing-at-point))
         (default (and (eq (cdr tap) type) (car tap))))
    (unless (assoc default cache)
      (setq default nil))
    (completing-read (format "LaTeX %s%s: "
                             (capitalize (symbol-name type))
                             (if default
                                 (format " (default %s)" default)
                               ""))
                     (latex-help--get-cache-for-type type)
                     nil t nil 'latex-help--info-history
                     default)))

(defun latex-help-command (name &optional node)
  "Lookup the LaTeX command NAME.
Unless NODE is non-nil, if NAME is in more than one node, prompt the user for
which to use.  If NODE is non-nil, use that instead."
  (interactive (list (latex-help--prompt-for 'command)))
  (when-let (entry (latex-help--maybe-prompt-entry name 'command node))
    (latex-help--info-goto-entry entry)))

(defun latex-help-environment (name &optional node)
  "Lookup the LaTeX environment NAME.
Unless NODE is non-nil, if NAME is in more than one node, prompt the user for
which to use.  If NODE is non-nil, use that instead."
  (interactive (list (latex-help--prompt-for 'environment)))
  (when-let (entry (latex-help--maybe-prompt-entry name 'environment node))
    (latex-help--info-goto-entry entry)))

(defun latex-help-package (name &optional node)
  "Lookup the LaTeX package NAME.
Unless NODE is non-nil, if NAME is in more than one node, prompt the user for
which to use.  If NODE is non-nil, use that instead."
  (interactive (list (latex-help--prompt-for 'package)))
  (when-let (entry (latex-help--maybe-prompt-entry name 'package node))
    (latex-help--info-goto-entry entry)))

(defun latex-help-class (name &optional node)
  "Lookup the LaTeX document class NAME.
Unless NODE is non-nil, if NAME is in more than one node, prompt the user for
which to use.  If NODE is non-nil, use that instead."
  (interactive (list (latex-help--prompt-for 'class)))
  (when-let (entry (latex-help--maybe-prompt-entry name 'class node))
    (latex-help--info-goto-entry entry)))

(defun latex-help-texdoc (name &optional dir)
  "Lookup NAME in the texdoc cache.
When used interactively, prompt for NAME.  If DIR is nil, it will be looked up
in the texdoc cache."
  (interactive (let ((entry (latex-help--prompt-texdoc-entry)))
                 (list (car entry) (cdr entry))))
  (latex-help--maybe-init-caches)
  (when-let ((entry (if dir
                        (cons name dir)
                      (assoc name latex-help--texdoc-cache)))
             (file (latex-help--texdoc-prompt-for-entry-file entry)))
    (latex-help--texdoc-open-file file)))

(defun latex-help--prompt-info-and-texdoc (info-entry texdoc-entry)
  "Prompt the user for both info and texdoc entries.
INFO-ENTRY is an entry from one of the info caches.  TEXDOC-ENTRY is an entry
from the texdoc cache."
  (let* ((texdoc-files (and texdoc-entry
                            (latex-help--texdoc-files-for-entry
                             texdoc-entry)))
         (prompts (nconc (mapcar (lambda (file)
                                   (concat "(Texdoc) " (car file)))
                                 texdoc-files)
                         (mapcar (lambda (node)
                                   (concat "(Info) " (car node)))
                                 (cdr info-entry)))))
    (when prompts
      (let ((selected (completing-read "LaTeX Help: " prompts nil t nil
                                       nil (when texdoc-files
                                             (car prompts)))))
        (when (string-match (rx bos "(" (group (+ (any (?a . ?z))
                                                  (any (?A . ?Z))))
                                ") " (group (* any)))
                            selected)
          (if (equal (match-string 1 selected) "Info")
              (cons (assoc (match-string 2 selected) (cdr info-entry)) 'info)
            (cons (cdr (assoc (match-string 2 selected) texdoc-files))
                  'texdoc)))))))

(defun latex-help-at-point ()
  "Try to lookup the LaTeX thing at point, whatever it may be.
This will try to look up the command, package, document class, or environment at
point.  If that thing at point is valid, it will open an info buffer to the
documentation for that thing."
  (interactive)
  (latex-help--maybe-init-caches)
  (if-let (thing (latex-help--get-thing-at-point))
      (let ((info-entry (assoc (car thing) (latex-help--get-cache-for-type
                                            (cdr thing))))
            (texdoc-entry (and (member (cdr thing) '(class package environment))
                               (assoc (car thing) latex-help--texdoc-cache))))
        (unless (or info-entry texdoc-entry)
          (user-error "Unknown %s: \"%s\""
                      (symbol-name (cdr thing))
                      (if (eq (cdr thing) 'command)
                          (concat "\\" (car thing))
                        (car thing))))
        (cl-destructuring-bind (thing . type)
            (latex-help--prompt-info-and-texdoc info-entry texdoc-entry)
          (cl-case type
            (texdoc
             (latex-help--texdoc-open-file thing))
            (info
             (latex-help--info-goto-entry thing)))))
    (user-error "Nothing at point to look up")))

(defvar latex-help--general-history nil
  "History for `latex-help'.")

(defun latex-help ()
  "Get help with LaTeX.
Prompt the user for an info topic or texdoc file, then open that thing."
  (interactive)
  (let ((prompts))
    (latex-help--maybe-init-caches)
    (cl-flet ((add-cache-for-type (type)
                (dolist (entry (latex-help--get-cache-for-type type))
                  (push (format "(Info) %s - %s"
                                (capitalize (symbol-name type))
                                (car entry))
                        prompts))))
      (add-cache-for-type 'command)
      (add-cache-for-type 'package)
      (add-cache-for-type 'class)
      (add-cache-for-type 'environment)
      (dolist (entry latex-help--texdoc-cache)
        (push (format "(Texdoc) %s" (car entry)) prompts))
      (when-let ((ans (completing-read "LaTeX Help: " prompts
                                       nil t nil 'latex-help--general-history))
                 ((not (zerop (length ans)))))
        (if (string-prefix-p "(Texdoc) " ans)
            (latex-help-texdoc (seq-subseq ans (length "(Texdoc) ")))
          (string-match (rx "(Info) " (group (+ (not " ")))
                            " - " (group (+ any)))
                        ans)
          (message "%s %s" (match-string 1 ans) (match-string 2 ans))
          (when-let ((thing (match-string 2 ans))
                     (type (intern (downcase (match-string 1 ans))))
                     (entry (latex-help--maybe-prompt-entry thing type)))
            (latex-help--info-goto-entry entry)))))))

(provide 'latex-help)
;;; latex-help.el ends here