;;; Help with major mode
;; Extracted from https://github.com/cpitclaudel/biblio.el/blob/master/biblio-core.el#L265
;; Requires: seq, dash

(defsubst hwmm--as-list (x)
  "Make X a list, if it isn't."
  (if (consp x) x (list x)))

(defun hwmm--map-keymap (func map)
  "Call `map-keymap' on FUNC and MAP, and collect the results."
  (let ((out))
    (map-keymap (lambda (&rest args) (push (apply func args) out)) map)
    out))

(defun hwmm--flatten-map (keymap &optional prefix)
  "Flatten KEYMAP, prefixing its keys with PREFIX.
This should really be in Emacs core (in Elisp), instead of being
implemented in C (at least for sparse keymaps).  Don't run this on
non-sparse keymaps."
  (nreverse
   (cond
    ((keymapp keymap)
     (seq-map (lambda (key-value)
                "Add PREFIX to key in KEY-VALUE."
                (cons (append prefix (hwmm--as-list (car key-value)))
                      (cdr key-value)))
              (delq nil
                    (apply
                     #'seq-concatenate
                     'list (hwmm--map-keymap
                            (lambda (k v)
                              "Return a list of bindings in V, prefixed by K."
                              (hwmm--flatten-map v (hwmm--as-list k)))
                            keymap)))))
    ;; This breaks if keymap is a symbol whose function cell is a keymap
    ((symbolp keymap)
     (list (cons prefix keymap))))))

(defun hwmm--group-alist (alist)
  "Return a copy of ALIST whose keys are lists of keys, grouped by value.
That is, if two key map to `eq' values, they are grouped."
  (let ((map (make-hash-table :test 'eq))
        (new-alist nil))
    (pcase-dolist (`(,key . ,value) alist)
      (puthash value (cons key (gethash value map)) map))
    (pcase-dolist (`(,_ . ,value) alist)
      (-when-let* ((keys (gethash value map)))
        (push (cons (nreverse keys) value) new-alist)
        (puthash value nil map)))
    (nreverse new-alist)))

(defun hwmm--quote (str)
  "Quote STR and call `substitute-command-keys' on it."
  (if str (substitute-command-keys (concat "`" str "'")) ""))

(defun hwmm--quote-keys (keys)
  "Quote and concatenate keybindings in KEYS."
  (mapconcat (lambda (keyseq)
               (hwmm--quote (ignore-errors (help-key-description keyseq nil))))
             keys ", "))

(defun hwmm--brief-docs (command)
  "Return first line of documentation of COMMAND."
  (let ((docs (or (ignore-errors (documentation command t)) "")))
    (string-match "\\(.*\\)$" docs)
    (match-string-no-properties 1 docs)))

(defun hwmm--help-with-major-mode-1 (keyseqs-command)
  "Print help on KEYSEQS-COMMAND to standard output."
  ;; (hwmm-with-fontification 'font-lock-function-name-face
  (insert (format "%s (%S)\n"
                  (hwmm--quote-keys (car keyseqs-command))
                  (cdr keyseqs-command)))
  (insert (format "  %s\n\n" (hwmm--brief-docs (cdr keyseqs-command)))))

(defun hwmm--help-with-major-mode ()
  "Display help with current major mode."
  (let ((buf (format "*%S help*" major-mode)))
    (with-help-window buf
      (princ (format "Help with %s\n\n" (hwmm--quote (symbol-name major-mode))))
      (let ((bindings (nreverse
                       (hwmm--group-alist
                        (hwmm--flatten-map
                         (current-local-map))))))
        (with-current-buffer buf
          (seq-do #'hwmm--help-with-major-mode-1 bindings))))
    buf))