;;; +Info.el                                         -*- lexical-binding: t; -*-

;;Copyright (C) 2022 Case Duckworth

;;; Code:

(require 'info)

(defun +Info-copy-current-node-name (&optional arg)
  "Put the name of the current Info invocation intothe kill ring.
This is the same as `Info-copy-current-node-name', but with the
arg reversed."
  (interactive "P" Info-mode)
  (Info-copy-current-node-name (unless arg 0)))

(defun +Info-modeline-breadcrumbs ()
  (let ((nodes   (Info-toc-nodes Info-current-file))
        (node    Info-current-node)
        (crumbs  ())
        (depth   Info-breadcrumbs-depth-internal)
        (text    ""))
    ;; Get ancestors from the cached parent-children node info
    (while (and (not (equal "Top" node))  (> depth 0))
      (setq node  (nth 1 (assoc node nodes)))
      (when node (push node crumbs))
      (setq depth  (1- depth)))
    ;; Add bottom node.
    (setq crumbs  (nconc crumbs (list Info-current-node)))
    (when crumbs
      ;; Add top node (and continuation if needed).
      (setq crumbs  (cons "Top" (if (member (pop crumbs) '(nil "Top"))
                                    crumbs
                                  (cons nil crumbs))))
      (dolist (node  crumbs)
        (let ((crumbs-map  (make-sparse-keymap))
              (menu-map    (make-sparse-keymap "Breadcrumbs in Mode Line")))
          (define-key crumbs-map [mode-line mouse-3] menu-map)
          (when node
            (define-key menu-map [Info-prev]
                        `(menu-item "Previous Node" Info-prev
                                    :visible ,(Info-check-pointer "prev[ious]*") :help "Go to the previous node"))
            (define-key menu-map [Info-next]
                        `(menu-item "Next Node" Info-next
                                    :visible ,(Info-check-pointer "next") :help "Go to the next node"))
            (define-key menu-map [separator] '("--"))
            (define-key menu-map [Info-breadcrumbs-in-mode-line-mode]
                        `(menu-item "Toggle Breadcrumbs" Info-breadcrumbs-in-mode-line-mode
                                    :help "Toggle displaying breadcrumbs in the Info mode-line"
                                    :button (:toggle . Info-breadcrumbs-in-mode-line-mode)))
            (define-key menu-map [Info-set-breadcrumbs-depth]
                        `(menu-item "Set Breadcrumbs Depth" Info-set-breadcrumbs-depth
                                    :help "Set depth of breadcrumbs to show in the mode-line"))
            (setq node  (if (equal node Info-current-node)
                            (propertize
                             (replace-regexp-in-string "%" "%%" Info-current-node)
                             'face 'mode-line-buffer-id
                             'help-echo "mouse-1: Scroll back, mouse-2: Scroll forward, mouse-3: Menu"
                             'mouse-face 'mode-line-highlight
                             'local-map
                             (progn
                               (define-key crumbs-map [mode-line mouse-1] 'Info-mouse-scroll-down)
                               (define-key crumbs-map [mode-line mouse-2] 'Info-mouse-scroll-up)
                               crumbs-map))
                          (propertize
                           node
                           'local-map (progn (define-key crumbs-map [mode-line mouse-1]
                                                         `(lambda () (interactive) (Info-goto-node ,node)))
                                             (define-key crumbs-map [mode-line mouse-2]
                                                         `(lambda () (interactive) (Info-goto-node ,node)))
                                             crumbs-map)
                           'mouse-face 'mode-line-highlight
                           'help-echo "mouse-1, mouse-2: Go to this node; mouse-3: Menu")))))
        (let ((nodetext  (if (not (equal node "Top"))
                             node
                           (concat (format "(%s)" (if (stringp Info-current-file)
                                                      (file-name-nondirectory Info-current-file)
                                                    ;; Some legacy code can still use a symbol.
                                                    Info-current-file))
                                   node))))
          (setq text (concat text (if (equal node "Top") "" " > ") (if node nodetext "...")))))
      text)))

(provide '+Info)
;;; +Info.el ends here