;;; ergoemacs-translate.el --- Keyboard translation functions -*- lexical-binding: t -*-
;; Copyright © 2013-2018 Free Software Foundation, Inc.
;; Filename: ergoemacs-translate.el
;; Description:
;; Author: Matthew L. Fidler
;; Maintainer:
;; Created: Sat Sep 28 20:08:09 2013 (-0500)
;; Version:
;; Last-Updated:
;; By:
;; Update #: 0
;; URL:
;; Doc URL:
;; Keywords:
;; Compatibility:
;;
;; Features that might be required by this library:
;;
;; None
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change Log:
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 3, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see .
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
(eval-when-compile
(require 'cl)
(require 'ergoemacs-macros))
(defvar ergoemacs-define-key-after-p)
(defvar ergoemacs-keyboard-layout)
(defvar ergoemacs-keyboard-mirror)
(defvar ergoemacs-translation-hash)
(defvar ergoemacs-translate--hash)
(defvar ergoemacs-translate--event-hash)
(defvar ergoemacs-dir)
(defvar ergoemacs-theme)
(defvar ergoemacs-inkscape)
(defvar ergoemacs-command-loop--universal-functions)
(declare-function ergoemacs-layouts--list "ergoemacs-layouts")
(declare-function ergoemacs-theme--list "ergoemacs-theme-engine")
(declare-function ergoemacs-mode-reset "ergoemacs-mode")
(declare-function ergoemacs-layouts--custom-documentation "ergoemacs-layouts")
(declare-function ergoemacs-theme--custom-documentation "ergoemacs-theme-engine")
(declare-function ergoemacs-mode-line "ergoemacs-mode")
(declare-function ergoemacs-key-description--unicode-char "ergoemacs-key-description")
(declare-function ergoemacs-key-description-kbd "ergoemacs-key-description")
(declare-function ergoemacs-key-description--display-char-p "ergoemacs-key-description")
(declare-function ergoemacs-layouts--current "ergoemacs-layouts")
(declare-function ergoemacs-map-properties--label "ergoemacs-map-properties")
(declare-function ergoemacs-map-properties--label-map "ergoemacs-map-properties")
(declare-function ergoemacs-map-properties--put "ergoemacs-map-properties")
(declare-function ergoemacs-map-- "ergoemacs-map")
(declare-function ergoemacs-command-loop--modal-p "ergoemacs-command-loop")
(declare-function ergoemacs-translate--key-description "ergoemacs-translate")
(fset #'ergoemacs-translate--key-description (symbol-function #'key-description))
(defun ergoemacs-translate--get-hash (&optional layout-to layout-from)
"Gets the translation hash."
(let* ((to (ergoemacs :layout (or layout-to ergoemacs-keyboard-layout)))
(from (ergoemacs :layout (or layout-from "us")))
(hash-f (ergoemacs-gethash from ergoemacs-translate--hash (make-hash-table)))
(hash-f-t (ergoemacs-gethash to hash-f))
(i 0)
hash-t hash-t-f lay-t lay-f r-t r-f)
(if hash-f-t hash-f-t
(setq hash-f-t (make-hash-table)
hash-t (ergoemacs-gethash to ergoemacs-translate--hash (make-hash-table))
hash-t-f (make-hash-table)
lay-t (symbol-value to)
lay-f (symbol-value from))
(while (< i 120)
(unless (or (string= "" (nth i lay-t))
(string= "" (nth i lay-f)))
(setq r-t (aref (read-kbd-macro (nth i lay-t) t) 0)
r-f (aref (read-kbd-macro (nth i lay-f) t) 0))
(puthash r-t r-f hash-t-f)
(puthash r-f r-t hash-f-t))
(setq i (+ i 1)))
(puthash from hash-t-f hash-t)
(puthash to hash-f-t hash-f)
(puthash to hash-t ergoemacs-translate--hash)
(puthash from hash-f ergoemacs-translate--hash)
hash-f-t)))
(defun ergoemacs-translate--emacs-shift (key-seq &optional modifier prefix)
"Uses emacs style shift-translation: M-Q becomes M-q.
KEY-SEQ must be a vector. If there is no need to shift-translate
the key sequence return nil.
Optionally you can change how this function behaves.
Instead of translating the shifted key to the unshifted key, you
can remove another modifier. For example if you wanted to
convert C-M-a to C-a, you could use 'meta as the MODIFIER
argument to remove the M- modifier.
The PREFIX argument can add a key before the key where the
modifier occurred, such as in `ergoemacs-translate--meta-to-escape'.
"
(if (not (vectorp key-seq)) nil
(let ((rev-seq (reverse (append key-seq ())))
(which-mod (or modifier 'shift))
modifiers new-mod
found
(seq '()))
(dolist (event rev-seq)
(setq modifiers (ergoemacs-translate--event-modifiers event))
(if (not (memq which-mod modifiers)) (push event seq)
(setq new-mod (list (ergoemacs-translate--event-basic-type event)))
(dolist (mod modifiers)
(unless (eq which-mod mod)
(push mod new-mod)))
(push (ergoemacs-translate--event-convert-list new-mod) seq)
(when prefix
(push prefix seq))
(setq found t)))
(if found (vconcat seq) nil))))
(defun ergoemacs-translate--meta-to-escape (key-seq)
"Escapes a KEY-SEQ M-q becomes ESC q.
KEY-SEQ must be a vector. If there is no need to escape the key sequence return nil."
(ergoemacs-translate--emacs-shift key-seq 'meta 27))
(defun ergoemacs-translate--escape-to-meta (key-seq)
"Changes key sequences ESC q to M-q.
KEY-SEQ must be a vector or string. If there is no need to change the sequence, return nil."
(let ((key-seq (or (and (vectorp key-seq) key-seq)
(vconcat key-seq))))
(let ((rev-seq (reverse (append key-seq ())))
old-event
modifiers
found
seq)
(dolist (event rev-seq)
;; [27 134217736] -> nil
;; [27 8] -> [134217832]
;; [27 8 27] -> [134217832 27]
;; [27 27 8 27] -> [27 134217832 27]
;; [27 9] -> [134217737]
(cond
((and (eq 27 event) seq)
(setq old-event (pop seq)
modifiers (event-modifiers old-event))
(if (memq 'meta modifiers)
(progn
(push old-event seq)
(push event seq))
(setq found t)
(push (event-convert-list (append '(meta) modifiers (list (event-basic-type old-event)))) seq)))
(t
(push event seq))))
(and found (vconcat seq)))))
(defun ergoemacs-translate--swap-apps (key &optional what with)
"In KEY, swap apps key with menu key.
Optionally specify WHAT you want to replace WITH.
If no changes have been done, return nil."
(let ((seq (reverse (append key ())))
(what (or what 'apps))
(with (or with 'menu))
found-p
ret)
(dolist (e seq)
(cond
((eq e what)
(push with ret)
(setq found-p t))
(t (push e ret))))
(if found-p
(vconcat ret)
nil)))
(defun ergoemacs-translate--swap-menu (key)
"In KEY swap menu key with apps key."
(ergoemacs-translate--swap-apps key 'menu 'apps))
(defun ergoemacs-translate--to-vector (key)
"Translates KEY to vector format.
If no changes are performed, return nil."
(when (stringp key)
(let ((new-key (vconcat key))
ret)
(unless (equal key new-key)
(setq ret new-key))
ret)))
(defun ergoemacs-translate--to-string (key)
"Translates KEY to string format.
If no chanegs are performed, return nil."
(catch 'not-ascii
(mapconcat
(lambda(key)
(if (and (integerp key) (< key 256))
(make-string 1 key)
(throw 'not-ascii nil)))
(append key) "")))
(defvar ergoemacs-translate--apply-funs
'(ergoemacs-translate--escape-to-meta
ergoemacs-translate--meta-to-escape
ergoemacs-translate--swap-apps
ergoemacs-translate--swap-menu
ergoemacs-translate--to-string
ergoemacs-translate--to-vector)
"Functions to apply to key.
These functions take a key as an argument and translate it in
some way. If there is no appropriate translation, the function
should return nil.")
(defun ergoemacs-translate--apply-key (key function &rest args)
"Apply KEY to FUNCTION with ARGS.
In addition to the normal KEY variants are also applied. These
variants are created using `ergoemacs-translate--apply-funs'."
(let ((key key) test-key)
(apply function key args)
(dolist (fn ergoemacs-translate--apply-funs)
(when (setq test-key (funcall fn key))
(apply function test-key args)))))
(defun ergoemacs-translate--define-key (keymap key def)
"Similar to `define-key', with the following differences:
- Both the Meta and escape sequences are bound.
- Both and