Skip to content

Keymap documentation generator

Daniel Mendler edited this page Apr 21, 2023 · 8 revisions
(defun embark-actions-org ()
  (interactive)
  ;; Ensure that the documentation of all actions is loaded
  (require 'embark-org)
  (require 'embark-consult)
  (require 'calc)
  (with-current-buffer (get-buffer-create "embark-actions.org")
    (erase-buffer)
    (insert "Remember that you can use any Emacs command as an Embark action, but for convenience some commands are given easy, usually single-letter, keybindings in the Embark keymaps. This page lists the keybindings for actions that come with embark and embark-consult by default. (If you use both embark and consult you'll want embark-consult; if you don't use consult ignore all commands with consult in the name.)\n\n")
    (insert "*NOTE*: This page was generated by the [[Keymap-documentation-generator][Keymap documentation generator]].\n\n")
    (dolist (map (seq-sort-by
                  (lambda (x) (pcase (car x)
                                ('t 'general)
                                ('encode 'region)
                                ('sort 'region)
                                ('vc-file 'file)
                                ('consult-search 'general)
                                (cat
                                 (if (string-prefix-p "org-" (symbol-name cat))
                                     ;; Move org-* categories to the end
                                     (concat "z-" (symbol-name cat))
                                   cat))))
                  #'string<
                  (append
                   (map-remove (lambda (cat map)
                                 (memq cat '(minor-mode environment-variables)))
                               embark-keymap-alist)
                   '((encode . embark-encode-map)
                     (sort . embark-sort-map)
                     (vc-file . embark-vc-file-map)
                     (consult-search . embark-consult-search-map)))))
      (insert (format "* %s\n\n"
                      (string-replace "-" " "
                                      (capitalize (symbol-name (if (eq (car map) t) 'general (car map)))))))
      (dolist (m (ensure-list (cdr map)))
        (let ((bindings))
          (insert (format "  =%s=: %s\n\n" m (documentation-property m 'variable-documentation)))
          ;; Collect bindings
          (map-keymap (lambda (key def)
                        (push (cons key def) bindings))
                      (keymap-canonicalize (symbol-value m)))
          ;; Move default binding to the beginning
          (setq bindings (nreverse bindings)
                bindings (append (seq-filter (lambda (x) (eq (car x) 13)) bindings)
                                 (seq-remove (lambda (x) (eq (car x) 13)) bindings)))
          ;; Filter general bindings
          (unless (eq m 'embark-general-map)
            (setq bindings (seq-remove (lambda (x) (equal (cdr x) (lookup-key embark-general-map (vector (car x))))) bindings)))
          (dolist (bind bindings)
            (insert (format "  - ~%s~ =%S=: %s\n"
                            (single-key-description (car bind))
                            (cdr bind)
                            (car (split-string (or (embark--function-doc (cdr bind)) "") "\n")))))
          (insert "\n"))))
    (org-mode)
    (pop-to-buffer (current-buffer))))
Clone this wiki locally