;;; -*- lexical-binding: t; byte-compile-error-on-warn: t -*- (declare-function ergoemacs-translate-shifted "ergoemacs-translate.el") (declare-function ergoemacs-pretty-key "ergoemacs-translate.el") (declare-function ergoemacs-translation-install "ergoemacs-translate.el") (defvar ergoemacs-translate-hash) (defvar ergoemacs-shifted-assoc) (defvar ergoemacs-translations) (defvar ergoemacs-use-ergoemacs-key-descriptions) (defun ergoemacs-translate (_key) "Translates _KEY and returns a plist of the translations. :shift-translated S-a -> a M-S-a -> M-a C-S-a -> C-a Anything without shift is nil. All other translations are defined in `ergoemacs-translations'. There are also :XXX-key and :XXX-pretty for actual key-strokes and `ergoemacs-pretty-key' descriptions. " (let* ((ret (gethash _key ergoemacs-translate-hash)) (orig-key _key) case-fold-search only-key shift-translated (ergoemacs-use-ergoemacs-key-descriptions t) shifted-key unshifted-key) (if ret ret (unless (stringp _key) (setq _key (key-description _key) orig-key _key)) (cond ((string-match "\\(^<.+>$\\|SPC\\|DEL\\|ESC\\|RET\\|TAB\\)" _key) (setq only-key (replace-regexp-in-string "[CMS]-" "" _key t)) (if (string-match "S-" _key) (setq shifted-key (replace-match "" t nil _key)) (setq shifted-key (concat "S-" _key)))) (t (setq only-key (replace-regexp-in-string "^.*\\(.\\)$" "\\1" _key t) shifted-key (assoc only-key ergoemacs-shifted-assoc)) (when shifted-key (setq shifted-key (cdr shifted-key))))) (when (and (string-match "\\([A-Z]\\)$" _key) (not (string-match "\\<\\(SPC\\|DEL\\|ESC\\|RET\\|TAB\\)\\>" _key))) (setq _key (replace-match (concat "S-" (downcase (match-string 1 _key))) t t _key))) (when shifted-key (setq unshifted-key only-key) (unless (string-match "\\(^<.+>$\\|\\\\|\\\\|\\\\|\\\\|\\\\)" shifted-key) (when (string-match "[A-Z]" shifted-key) (setq shifted-key (concat "S-" (downcase shifted-key)))) (when (string-match "[A-Z]" unshifted-key) (setq unshifted-key (concat "S-" (downcase unshifted-key)))))) (when (string-match "S-" _key) (setq shift-translated (replace-regexp-in-string "S-" "" _key t))) (if shift-translated (progn (setq ret (plist-put ret ':shift-translated (ergoemacs-translate-shifted shift-translated))) (setq ret (plist-put ret ':shift-translated-key (read-kbd-macro (ergoemacs-translate-shifted shift-translated) t))) (setq ret (plist-put ret ':shift-translated-pretty (ergoemacs-pretty-key shift-translated)))) (setq ret (plist-put ret ':shift-translated nil)) (setq ret (plist-put ret ':shift-translated-key nil)) (setq ret (plist-put ret ':shift-translated-pretty nil))) (when shifted-key (setq ret (plist-put ret ':shifted (ergoemacs-translate-shifted shifted-key))) (setq ret (plist-put ret ':shifted-key (read-kbd-macro (ergoemacs-translate-shifted shifted-key) t))) (setq ret (plist-put ret ':shifted-pretty (ergoemacs-pretty-key shifted-key)))) (when unshifted-key (setq ret (plist-put ret ':unshifted (ergoemacs-translate-shifted unshifted-key))) (setq ret (plist-put ret ':unshifted-key (read-kbd-macro (ergoemacs-translate-shifted unshifted-key) t))) (setq ret (plist-put ret ':unshifted-pretty (ergoemacs-pretty-key unshifted-key)))) (setq ret (plist-put ret ':ctl (ergoemacs-translate-shifted (concat "C-" unshifted-key)))) (setq ret (plist-put ret ':ctl-key (read-kbd-macro (plist-get ret ':ctl) t))) (setq ret (plist-put ret ':ctl-pretty (ergoemacs-pretty-key (plist-get ret ':ctl)))) (setq ret (plist-put ret ':raw (ergoemacs-translate-shifted (replace-regexp-in-string "\\<[CSMS]-" "" _key)))) (setq ret (plist-put ret ':raw-key (read-kbd-macro (plist-get ret ':raw) t))) (setq ret (plist-put ret ':raw-pretty (ergoemacs-pretty-key (plist-get ret ':raw)))) (if (assoc (plist-get ret ':raw) ergoemacs-shifted-assoc) (progn (setq ret (plist-put ret ':raw-shift (ergoemacs-translate-shifted (replace-regexp-in-string "\\<[CSM]-" "" (cdr (assoc (plist-get ret ':raw) ergoemacs-shifted-assoc)))))) (setq ret (plist-put ret ':raw-shift-key (read-kbd-macro (plist-get ret ':raw-shift) t))) (setq ret (plist-put ret ':raw-shift-pretty (ergoemacs-pretty-key (plist-get ret ':raw-shift))))) (setq ret (plist-put ret ':raw-shift nil)) (setq ret (plist-put ret ':raw-shift-key nil)) (setq ret (plist-put ret ':raw-shift-pretty nil))) (setq ret (plist-put ret ':alt (ergoemacs-translate-shifted (concat "M-" unshifted-key)))) (setq ret (plist-put ret ':alt-key (read-kbd-macro (plist-get ret ':alt) t))) (setq ret (plist-put ret ':alt-pretty (ergoemacs-pretty-key (plist-get ret ':alt)))) (when unshifted-key (setq ret (plist-put ret ':alt-ctl (ergoemacs-translate-shifted (concat "M-C-" unshifted-key)))) (setq ret (plist-put ret ':alt-ctl-key (read-kbd-macro (plist-get ret ':alt-ctl) t))) (setq ret (plist-put ret ':alt-ctl-pretty (ergoemacs-pretty-key (plist-get ret ':alt-ctl))))) (when shifted-key (setq ret (plist-put ret ':ctl-shift (ergoemacs-translate-shifted (concat "C-" shifted-key)))) (setq ret (plist-put ret ':ctl-shift-key (read-kbd-macro (plist-get ret ':ctl-shift) t))) (setq ret (plist-put ret ':ctl-shift-pretty (ergoemacs-pretty-key (plist-get ret ':ctl-shift)))) (setq ret (plist-put ret ':alt-shift (ergoemacs-translate-shifted (concat "M-" shifted-key)))) (setq ret (plist-put ret ':alt-shift-key (read-kbd-macro (plist-get ret ':alt-shift) t))) (setq ret (plist-put ret ':alt-shift-pretty (ergoemacs-pretty-key (plist-get ret ':alt-shift)))) (setq ret (plist-put ret ':alt-ctl-shift (ergoemacs-translate-shifted (concat "M-C-" shifted-key)))) (setq ret (plist-put ret ':alt-ctl-shift-key (read-kbd-macro (plist-get ret ':alt-ctl-shift) t))) (setq ret (plist-put ret ':alt-ctl-shift-pretty (ergoemacs-pretty-key (plist-get ret ':alt-ctl-shift))))) (maphash (lambda(_key plist) (setq ret (ergoemacs-translation-install plist orig-key ret))) ergoemacs-translations) (puthash orig-key ret ergoemacs-translate-hash) (puthash _key ret ergoemacs-translate-hash) ret)))