branch: externals/ergoemacs-mode
commit 97a21072a794199b54ad9000f7ebde49befc7894
Author: Matthew Fidler <514778+mattfid...@users.noreply.github.com>
Commit: Matthew Fidler <514778+mattfid...@users.noreply.github.com>
Add back the command loop. Part of it seems broken
---
ergoemacs-command-loop.el | 1646 ++++++++++++++++++++++++++++++++++++++++++++-
ergoemacs-macros.el | 34 +
ergoemacs-mode.el | 6 +
ergoemacs-themes.el | 106 +++
ergoemacs-translate.el | 207 +++++-
5 files changed, 1958 insertions(+), 41 deletions(-)
diff --git a/ergoemacs-command-loop.el b/ergoemacs-command-loop.el
index a8bbb22..af73e3e 100644
--- a/ergoemacs-command-loop.el
+++ b/ergoemacs-command-loop.el
@@ -35,6 +35,9 @@
(require 'ergoemacs-macros))
+(declare-function ergoemacs-translate--emacs-shift "ergoemacs-translate")
+(declare-function ergoemacs-warn "ergoemacs-lib")
+
(declare-function guide-key/close-guide-buffer "guide-key")
(declare-function guide-key/popup-function "guide-key")
@@ -43,6 +46,9 @@
(declare-function ergoemacs-mode-line "ergoemacs-mode")
+(declare-function ergoemacs-layout--regexp "ergoemacs-layouts")
+(declare-function ergoemacs-layouts--list "ergoemacs-layouts")
+
(declare-function ergoemacs-map-properties--movement-p
"ergoemacs-map-properties")
(declare-function ergoemacs-map-properties--put "ergoemacs-map-properties")
@@ -64,6 +70,7 @@
(declare-function ergoemacs-translation-struct-p "ergoemacs-translate")
(declare-function ergoemacs-translation-struct-text "ergoemacs-translate")
(declare-function ergoemacs-translation-struct-translation
"ergoemacs-translate")
+(declare-function ergoemacs-translation-struct-unchorded "ergoemacs-translate")
(declare-function ergoemacs-key-description--modifier
"ergoemacs-key-description")
@@ -83,10 +90,15 @@
(defvar ergoemacs-default-cursor-color)
(defvar ergoemacs-echo-function)
(defvar ergoemacs-map--quit-map)
+(defvar ergoemacs-modal-emacs-state-modes)
+(defvar ergoemacs-modal-ignored-buffers)
+(defvar ergoemacs-modal-ignored-keymap)
(defvar ergoemacs-mode-started-p)
(defvar guide-key/guide-key-sequence)
(defvar keyfreq-mode)
(defvar keyfreq-table)
+(defvar ergoemacs-translate--emacs-shift)
+(defvar ergoemacs-command-loop-start)
(defvar universal-argument-num-events) ;; Not in Emacs 24.5
@@ -96,6 +108,12 @@
(defvar ergoemacs-command-loop--mark-active nil
"Determines if mark was active before ergoemacs command loop.")
+(define-obsolete-variable-alias 'ergoemacs-universal-fns
'ergoemacs-command-loop--universal-functions "Ergoemacs-v5.16")
+
+
+(defvar ergoemacs-command-loop--universal-functions '(universal-argument
ergoemacs-universal-argument ergoemacs-command-loop--universal-argument)
+ "List of `ergoemacs-mode' recognized functions.")
+
(defvar ergoemacs-command-loop--next-key-hash
(let ((hash (make-hash-table)))
@@ -115,6 +133,14 @@
(defvar ergoemacs-command-loop--help-last-key nil)
+(define-obsolete-variable-alias 'ergoemacs-read-key-delay
'ergoemacs-command-loop--decode-event-delay "Ergoemacs-v5.16")
+
+(defvar ergoemacs-command-loop--decode-event-delay 0.01
+ "Timeout for `ergoemacs-command-loop--decode-event'.
+This is to distinguish events in a terminal, like xterm.
+
+It needs to be less than `ergoemacs-command-loop-blink-rate'.")
+
(defvar ergoemacs-command-loop--history nil
"History of command loop locations.")
@@ -155,15 +181,163 @@ ignore the post-command hooks.")
(defvar ergoemacs-command-loop--echo-keystrokes-complete nil
"Echoed keystrokes, keep echoing active.")
-(defvar ergoemacs-command-loop-swap-translation)
+(defvar ergoemacs-command-loop--modal-stack '()
+ "The Modal Stack.")
+
+(defcustom ergoemacs-command-loop-swap-translation
+ '(((:normal :normal) :unchorded-ctl)
+ ((:normal :unchorded-ctl) :ctl-to-alt)
+ ((:normal :unchorded-ctl) :normal)
+ ((:ctl-to-alt :ctl-to-alt) :unchorded-ctl)
+ ((:ctl-to-alt :unchorded-ctl) :ctl-to-alt)
+ ((:unchorded-ctl :unchorded-ctl) :ctl-to-alt)
+ ((:unchorded-ctl :ctl-to-alt) :unchorded-ctl))
+ "How the translation will be swapped."
+ :type '(repeat
+ (list
+ (list
+ (sexp :tag "First Type")
+ (sexp :tag "Current Type"))
+ (sexp :tag "Translated Type")))
+ :group 'ergoemacs-command-loop)
+
+(defcustom ergoemacs-command-loop-blink-character (ergoemacs :unicode-or-alt
"•" "·" "-")
+ "Blink character."
+ :type '(choice
+ (string :tag "Cursor")
+ (const :tag "No cursor" nil))
+ :group 'ergoemacs-command-loop)
+
+(defcustom ergoemacs-command-loop-blink-rate 0.4
+ "Rate that the ergoemacs-command loop cursor blinks."
+ :type 'number
+ :group 'ergoemacs-command-loop)
+
+(defcustom ergoemacs-command-loop-type nil
+ "Type of `ergoemacs-mode' command loop."
+ :type '(choice
+ (const :tag "Replace emacs command loop (full)" :full)
+ ;; (const :tag "Test mode; Don't actually run command " :test)
+ (const :tag "No command loop support" nil))
+ :group 'ergoemacs-comamnd-loop)
+
+(defcustom ergoemacs-command-loop-hide-shift-translations t
+ "Hide shift translations in the command loop help."
+ :type 'boolean
+ :group 'ergoemacs-command-loop)
+
+
+(defcustom ergoemacs-command-loop-echo-keystrokes 1
+ "The amount of time before `ergoemacs-mode' displays keystrokes."
+ :type 'number
+ :group 'ergoemacs-command-loop)
+
+(defcustom ergoemacs-command-loop-timeout 2
+ "The number of seconds before hook has froze."
+ :type 'number
+ :group 'ergoemacs-command-loop)
+
+(defcustom ergoemacs-echo-function :on-translation
+ "Shows the function evaluated with a key."
+ :type '(choice
+ (const :tag "Always echo" t)
+ (const :tag "For multi-key commands" :multi-key)
+ (const :tag "Echo on translations" :on-translation)
+ (const :tag "Don't Echo" nil))
+ :group 'ergoemacs-command-loop)
+
+
+
(defvar ergoemacs-command-loop-time-before-blink)
-(defvar ergoemacs-command-loop-blink-character)
-(defvar ergoemacs-command-loop-blink-rate)
+(defvar ergoemacs-command-loop-hide-shift-translations)
(defvar ergoemacs-mode)
(defvar ergoemacs-command-loop-type)
(defvar ergoemacs-keymap)
+(defvar ergoemacs-handle-ctl-c-or-ctl-x 'only-C-c-and-C-x)
+(defvar ergoemacs-ctl-c-or-ctl-x-delay)
+(defun ergoemacs-command-loop--modal-show ()
+ "Show modal translation.
+Returns the mode-line text."
+ (let (tmp color text)
+ (ergoemacs-save-buffer-state
+ (cond
+ ((setq tmp (ergoemacs :modal-p))
+ (setq color (ergoemacs-translation-struct-modal-color tmp))
+ (if color
+ (set-cursor-color color)
+ (when ergoemacs-default-cursor-color
+ (set-cursor-color ergoemacs-default-cursor-color)))
+ (setq text (ergoemacs-translation-struct-text tmp))
+ (when (functionp text)
+ (setq text (funcall text)))
+ (if text
+ (ergoemacs-mode-line ;; Indicate Alt+ in mode-line
+ text)
+ (ergoemacs-mode-line))
+ (or text "Unnamed"))
+ (t
+ (when ergoemacs-default-cursor-color
+ (set-cursor-color ergoemacs-default-cursor-color))
+ (ergoemacs-mode-line)
+ nil)))))
+
+(defun ergoemacs-command-loop--match-buffer-name-p (reg)
+ "Determine if the REG is found in `buffer-name'."
+ (and (stringp (buffer-name))
+ (string-match reg (buffer-name))))
+
+(defun ergoemacs-command-loop--modal-p ()
+ "Determine if the command should be modal.
+If so return the translation."
+ (if (not ergoemacs-command-loop--modal-stack) nil
+ (let* ((translation (nth 0 ergoemacs-command-loop--modal-stack))
+ (always)
+ ret)
+ (when (ergoemacs-translation-struct-p translation)
+ (setq always (ergoemacs-translation-struct-modal-always translation))
+ (cond
+ ((and (minibufferp)
+ (not always)))
+ ((and (not always)
+ (memq major-mode ergoemacs-modal-emacs-state-modes)))
+ ((and (not always)
+ (catch 'match-modal
+ (dolist (reg ergoemacs-modal-ignored-buffers)
+ (when (ergoemacs-command-loop--match-buffer-name-p reg)
+ (throw 'match-modal t)))
+ nil)))
+ (t
+ (setq ret translation))))
+ ret)))
+
+(defun ergoemacs-command-loop--modal-pop ()
+ "Turn off the last ergoemacs modal in the modal-stack."
+ (when ergoemacs-command-loop--modal-stack
+ (ergoemacs-command-loop--modal (ergoemacs-translation-struct-key (nth 0
ergoemacs-command-loop--modal-stack)))))
+
+(defun ergoemacs-command-loop--modal (type)
+ "Toggle ergoemacs command modes.
+
+The TYPE is the type of command translation/modal keymaps that are installed."
+ (cond
+ ((or (not ergoemacs-command-loop--modal-stack) ;; First time to turn on
+ (not (eq (ergoemacs-translation-struct-key (nth 0
ergoemacs-command-loop--modal-stack)) type)) ;; New modal
+ )
+ (push (ergoemacs-translate--get type) ergoemacs-command-loop--modal-stack)
+ (unless ergoemacs-default-cursor-color
+ (setq ergoemacs-default-cursor-color
+ (or (frame-parameter nil 'cursor-color) "black")))
+ (ergoemacs-command-loop--message "%s command mode installed"
(ergoemacs-command-loop--modal-show)))
+
+ (t ;; Turn off.
+ (setq ergoemacs-command-loop--modal-stack (cdr
ergoemacs-command-loop--modal-stack))
+ (if (ergoemacs :modal-p)
+ (ergoemacs-command-loop--message "%s command mode resumed."
(ergoemacs-command-loop--modal-show))
+ (ergoemacs-command-loop--modal-show)
+ (ergoemacs-command-loop--message "Resume regular ergoemacs-mode")))))
+
(defun ergoemacs-command-loop--redefine-quit-key (&optional key)
"Redefines the quit-key in Emacs to KEY or Ctrl+g.
@@ -196,6 +370,65 @@ with this function."
(throw 'found-quit t)))
nil))))
+(add-hook 'ergoemacs-mode-startup-hook
#'ergoemacs-command-loop--setup-quit-key)
+(add-hook 'ergoemacs-mode-shutdown-hook
#'ergoemacs-command-loop--redefine-quit-key)
+
+(defun ergoemacs-command-loop--universal-argument (&rest _ignore)
+ "`ergoemacs-mode' universal argument.
+This is called through `ergoemacs-command-loop'"
+ (interactive)
+ (cond
+ ((not (ergoemacs-command-loop-p))
+ ;; Command loop hasn't started.
+ (setq current-prefix-arg '(4))
+ (setq ergoemacs-command-loop-start t)
+ (ergoemacs-command-loop nil (ergoemacs-command-loop--modal-p) nil t))
+ ((not current-prefix-arg)
+ (setq current-prefix-arg '(4)
+ ergoemacs-command-loop--universal t
+ ergoemacs-command-loop--exit :ignore-post-command-hook))
+ ((listp current-prefix-arg)
+ ;; Change current prefix argument
+ (setq current-prefix-arg (list (* (nth 0 current-prefix-arg) 4))
+ ergoemacs-command-loop--universal t
+ ergoemacs-command-loop--exit :ignore-post-command-hook))
+ (t
+ (setq ergoemacs-command-loop--universal t
+ ergoemacs-command-loop--exit :ignore-post-command-hook))))
+
+(defalias 'ergoemacs-read-key--universal-argument
'ergoemacs-command-loop--universal-argument)
+
+(defalias 'ergoemacs-universal-argument
'ergoemacs-command-loop--universal-argument)
+
+(defun ergoemacs-command-loop--digit-argument (&optional type)
+ "Ergoemacs digit argument.
+
+This is called through `ergoemacs-command-loop'.
+
+TYPE is the keyboard translation type, defined by `ergoemacs-translate'.
+Ergoemacs-mode sets up: :ctl-to-alt :unchorded :normal."
+ (interactive)
+ (let* ((char (if (integerp last-command-event)
+ last-command-event
+ (get last-command-event 'ascii-character)))
+ (digit (- (logand char ?\177) ?0)))
+ (setq current-prefix-arg digit))
+ (ergoemacs-command-loop nil type nil t))
+
+(defalias 'ergoemacs-digit-argument 'ergoemacs-command-loop--digit-argument)
+
+(defun ergoemacs-command-loop--negative-argument (&optional type)
+ "Ergoemacs negative argument.
+
+This is called through `ergoemacs-command-loop'.
+
+TYPE is the keyboard translation type, defined by `ergoemacs-translate'
+Ergoemacs-mode sets up: :ctl-to-alt :unchorded :normal."
+ (setq current-prefix-arg '-)
+ (ergoemacs-command-loop nil type nil t))
+
+(defalias 'ergoemacs-negative-argument
'ergoemacs-command-loop--negative-argument)
+
(dolist (arg '((next-key-is-alt (meta))
(next-key-is-meta (meta))
(next-key-is-ctl (control))
@@ -205,7 +438,7 @@ with this function."
(next-key-is-control-meta (control meta))
(next-key-is-meta-control (control meta))
(next-key-is-quoted nil)))
- (eval (macroexpand-all
+ (eval (macroexpand-all ;FIXME: Why macroexpand-all?
`(progn
(defun ,(intern (concat "ergoemacs-command-loop--" (symbol-name
(nth 0 arg)))) ()
,(format "Ergoemacs function to allow %s to be the emacs
modifiers" (nth 1 arg))
@@ -220,7 +453,8 @@ with this function."
(message "Dummy Function for %s" (ergoemacs :modifier-desc ,(nth
1 arg))))
(defalias ',(intern (concat "ergoemacs-read-key-force-"
(symbol-name (nth 0 arg)))) ',(intern (concat "ergoemacs-command-loop--force-"
(symbol-name (nth 0 arg)))))
(puthash ',(intern (concat "ergoemacs-command-loop--force-"
(symbol-name (nth 0 arg)))) '(,(nth 1 arg) :force)
ergoemacs-command-loop--next-key-hash)
- (puthash ',(intern (concat "ergoemacs-read-key-force-"
(symbol-name (nth 0 arg)))) '(,(nth 1 arg) :force)
ergoemacs-command-loop--next-key-hash)))))
+ (puthash ',(intern (concat "ergoemacs-read-key-force-"
(symbol-name (nth 0 arg)))) '(,(nth 1 arg) :force)
ergoemacs-command-loop--next-key-hash)
+ t))))
(defvar ergoemacs-last-command-event nil
"`ergoemacs-mode' command loop last read command.")
@@ -321,12 +555,12 @@ UNIVERSAL"
(and (not universal) "")
(or (and (string= ergoemacs-command-loop--read-key-prompt
"") "") " ")
(and ergoemacs-command-loop-blink-character
- (or (and blink-on
ergoemacs-command-loop-blink-character)
+ (or (and blink-on (ergoemacs :unicode-or-alt
ergoemacs-command-loop-blink-character "-"))
" "))
" ")
(or
(and (not universal) "")
- "▸")))
+ (ergoemacs :unicode-or-alt "▸" ">"))))
(format
"%s%s%s %s "
(cond
@@ -335,13 +569,25 @@ UNIVERSAL"
(t current-prefix-arg))
(or (and (not universal) "")
(and ergoemacs-command-loop-blink-character
- (or (and blink-on ergoemacs-command-loop-blink-character)
+ (or (and blink-on (ergoemacs :unicode-or-alt
ergoemacs-command-loop-blink-character "-"))
" "))
" ")
(or (and (listp current-prefix-arg)
(format "%s" current-prefix-arg))
"")
- "▸")))
+ (ergoemacs :unicode-or-alt "▸" ">"))))
+
+(defun ergoemacs-command-loop--ensure-sane-variables ()
+ "Make sure that certain variables won't lock up Emacs.
+
+Currently this ensures:
+
+`ergoemacs-command-loop--decode-event-delay' is less than
`ergoemacs-command-loop-blink-rate'."
+ (when (>= ergoemacs-command-loop--decode-event-delay
ergoemacs-command-loop-blink-rate)
+ (ergoemacs-warn "ergoemacs-command-loop--decode-event-delay >=
ergoemacs-command-loop-blink-rate; Reset to ergoemacs-command-loop-blink-rate /
1000")
+ (setq ergoemacs-command-loop--decode-event-delay (/
ergoemacs-command-loop-blink-rate 1000))))
+
+(add-hook 'ergoemacs-mode-startup-hook
#'ergoemacs-command-loop--ensure-sane-variables)
(defun ergoemacs-command-loop--combine (current-key next-event)
"Combine CURRENT-KEY and NEXT-EVENT into a vector."
@@ -409,13 +655,19 @@ This is not done when the event is [ergoemacs-ignore]"
((not (stringp prompt)))
((not (string= ""
ergoemacs-command-loop--read-key-prompt)) prompt)
((or (string= prompt " ")
- (string-match-p prompt (concat " *"
ergoemacs-command-loop-blink-character " *")))
+ (string-match-p prompt (concat " *" (ergoemacs
:unicode-or-alt ergoemacs-command-loop-blink-character "-") " *")))
nil)
(ergoemacs-command-loop--universal prompt)
(ergoemacs-command-loop--echo-keystrokes-complete prompt)
((not (numberp ergoemacs-command-loop-echo-keystrokes))
prompt)
((= 0 ergoemacs-command-loop-echo-keystrokes) prompt)
((< last-event-time
ergoemacs-command-loop-echo-keystrokes) nil)
+ ;; ((and (not
ergoemacs-command-loop--echo-keystrokes-complete)
+ ;; (numberp ergoemacs-command-loop-echo-keystrokes)
+ ;; (or (= 0 ergoemacs-command-loop-echo-keystrokes)
+ ;; (< last-event-time
ergoemacs-command-loop-echo-keystrokes))) nil)
+ ;; ((and (< last-event-time
ergoemacs-command-loop-time-before-blink) (string= prompt "")) nil)
+ ;; ((and (< last-event-time
ergoemacs-command-loop-time-before-blink) ) nil)
(t
(setq ergoemacs-command-loop--echo-keystrokes-complete t)
prompt)))
@@ -455,6 +707,120 @@ This is not done when the event is [ergoemacs-ignore]"
last-event-frame (selected-frame))))
event)))
+(defvar ergoemacs-command-loop--decode-event-timeout-p nil
+ "Determines if `ergoemacs-command-loop--decode-event' timed out.")
+
+(defun ergoemacs-command-loop--decode-event (event keymap &optional
current-key)
+ "Change EVENT based on KEYMAP.
+
+Used to help with translation keymaps like `input-decode-map'.
+
+CURRENT-KEY is the current key being read. This is used
+inconjunction with `input-method-function' to translate keys if
+`set-input-method' is using a different keyboard layout."
+ (let* ((new-event event)
+ (old-ergoemacs-input unread-command-events)
+ new-ergoemacs-input
+ (current-test-key (or (and (listp event)
+ (vector
(ergoemacs-translate--event-convert-list
+ (append
(ergoemacs-translate--event-modifiers event)
+ (list
(ergoemacs-translate--event-basic-type event))))))
+ (vector event)))
+ (test-ret (lookup-key keymap current-test-key))
+ (timeout-key (key-binding (vconcat current-test-key
[ergoemacs-timeout])))
+ next-key)
+ (while (and current-test-key
+ (ergoemacs-keymapp test-ret))
+ ;; The translation needs more keys...
+ (if timeout-key
+ (setq next-key (with-timeout (ergoemacs-ctl-c-or-ctl-x-delay
+ (progn
+ (setq
ergoemacs-command-loop--decode-event-timeout-p t)
+ nil))
+ (ergoemacs-command-loop--history nil
ergoemacs-command-loop--decode-event-delay current-key)))
+ (setq next-key (ergoemacs-command-loop--history nil
ergoemacs-command-loop--decode-event-delay current-key)))
+ (when next-key ;; Since a key was read, save it to be read later.
+ (push last-command-event new-ergoemacs-input))
+ (if next-key
+ (setq current-test-key (ergoemacs :combine current-test-key next-key)
+ timeout-key (key-binding (vconcat current-test-key
[ergoemacs-timeout]))
+ test-ret (lookup-key keymap current-test-key))
+ (setq current-test-key nil)))
+ ;; Change strings to emacs keys.
+ (when (stringp test-ret)
+ ;; Should it be read-kbd-macro?
+ (setq test-ret (vconcat test-ret)))
+ (when (functionp test-ret)
+ (when (memq test-ret '(xterm-mouse-translate
xterm-mouse-translate-extended))
+ (message "xterm-mouse-translate: %s->%s" current-test-key (funcall
test-ret nil)))
+ (setq last-input-event event
+ test-ret (if (or (eq keymap input-decode-map)
+ (eq keymap key-translation-map)
+ (eq keymap local-function-key-map))
+ (funcall test-ret nil) ;; Pretend emacs called this
from command loop.
+ (funcall test-ret)))
+ (when (not (equal unread-command-events old-ergoemacs-input))
+ (push (pop unread-command-events) new-ergoemacs-input)))
+ (if (and (vectorp test-ret)
+ (= (length test-ret) 1))
+ (progn
+ (setq new-event (elt test-ret 0)))
+ ;; Not a new event, restore anything that was popped off the
+ ;; unread command events.
+ (when old-ergoemacs-input
+ (setq unread-command-events old-ergoemacs-input))
+ ;; Add anything read to the
+ ;; unread-command-events
+ (when new-ergoemacs-input
+ (setq unread-command-events (append new-ergoemacs-input
unread-command-events))))
+ new-event))
+
+(defun ergoemacs-command-loop--read-event (prompt &optional current-key)
+ "Read a single event.
+
+PROMPT is the prompt used when reading an event.
+
+CURRENT-KEY is the current key sequence that has alerady been
+read.
+
+This respects `input-decode-map', `local-function-key-map' and
+`key-translation-map'.
+
+It also inputs real read events into the history with
+`ergoemacs-command-loop--history'
+
+It will timeout after `ergoemacs-command-loop-blink-rate' and
+return nil."
+ (let ((input (ergoemacs-command-loop--history prompt
ergoemacs-command-loop-blink-rate current-key))
+ last-input
+ basic mods
+ binding gui)
+ ;; Fix issues with `input-decode-map'
+ (when input
+ ;; Fix input as if you defined C-i -> <C-i> on `input-decode-map'
+ ;;
http://emacs.stackexchange.com/questions/10271/how-to-bind-c-for-real-seriously-for-real-this-time/15174
+ (if (and (display-graphic-p)
+ (setq basic (event-basic-type input))
+ (memq basic (list 'i 'm '\[ ?i ?m ?\[))
+ (setq mods (event-modifiers input))
+ (memq 'control mods)
+ (setq gui (ergoemacs-translate--event-convert-list (append
(list 'ergoemacs-gui) mods (list basic))))
+ (setq binding (key-binding (ergoemacs :combine current-key
input) t)))
+ (setq input gui)
+ (setq input (ergoemacs-command-loop--decode-event input
input-decode-map current-key)
+ binding (key-binding (ergoemacs :combine current-key input) t)))
+ ;; These should only be replaced if they are not bound.
+ (unless binding
+ (setq last-input input
+ input (ergoemacs-command-loop--decode-event input
local-function-key-map current-key))
+ (unless (eq last-input input)
+ (setq binding (key-binding (ergoemacs :combine current-key input)
t))))
+ (setq last-input input
+ input (ergoemacs-command-loop--decode-event input
key-translation-map current-key))
+ (unless (eq last-input input)
+ (setq binding (key-binding (ergoemacs :combine current-key input) t))))
+ input))
+
(defun ergoemacs-command-loop--key-msg (blink-on universal text current-key
unchorded trans keys)
"Key message.
@@ -482,7 +848,7 @@ KEYS is the keys information"
(or (and (string= ergoemacs-command-loop--read-key-prompt "") "") " ")
(or (and universal "")
(and ergoemacs-command-loop-blink-character
- (or (and blink-on ergoemacs-command-loop-blink-character)
+ (or (and blink-on (ergoemacs :unicode-or-alt
ergoemacs-command-loop-blink-character "-"))
" "))
" ")
trans
@@ -495,6 +861,308 @@ KEYS is the keys information"
(defvar ergoemacs-command--timeout-timer nil)
(defvar ergoemacs-command--timeout-keys nil)
+(defun ergoemacs-command--timer-timeout ()
+ "Send the [ergoemacs-timeout] event (after timeout)."
+ (let ((keys (this-single-command-keys)))
+ (when ergoemacs-command--timeout-timer
+ (cancel-timer ergoemacs-command--timeout-timer)
+ (setq ergoemacs-command--timeout-timer nil)
+ (when (equal keys ergoemacs-command--timeout-keys)
+ (push 'ergoemacs-timeout unread-command-events))
+ (setq ergoemacs-command--timeout-keys nil))))
+
+(defvar ergoemacs-this-command-keys-shift-translated nil
+ "ergoemacs override of shift translation in command loop.")
+
+(defun ergoemacs-command--echo-prefix ()
+ "Echos prefix keys in the ergoemacs-mode way."
+ (let ((keys (this-single-command-keys)))
+ (when (and ergoemacs-command--timeout-timer
+ (not (equal keys ergoemacs-command--timeout-keys)))
+ (cancel-timer ergoemacs-command--timeout-timer)
+ (setq ergoemacs-command--timeout-keys nil
+ ergoemacs-command--timeout-timer nil))
+ (unless (or (equal [] keys)
+ (ergoemacs-command-loop-p))
+ (when (ergoemacs-keymapp (key-binding keys))
+ (when (key-binding (vconcat keys [ergoemacs-timeout]))
+ (cond
+ ((eq ergoemacs-handle-ctl-c-or-ctl-x 'only-copy-cut)
+ (push 'ergoemacs-timeout unread-command-events))
+ ((not (region-active-p))) ;; active
+ ((and (or ergoemacs-this-command-keys-shift-translated
this-command-keys-shift-translated)
+ (eq ergoemacs-handle-ctl-c-or-ctl-x 'both)))
+ ((and (not ergoemacs-ctl-c-or-ctl-x-delay) ;; Immediate
+ (eq ergoemacs-handle-ctl-c-or-ctl-x 'both))
+ (push 'ergoemacs-timeout unread-command-events))
+ (t
+ (setq ergoemacs-command--timeout-keys keys
+ ergoemacs-command--timeout-timer
+ (run-at-time t ergoemacs-ctl-c-or-ctl-x-delay
#'ergoemacs-command--timer-timeout)))))
+ (unless unread-command-events
+ (ergoemacs-command-loop--message
+ "%s" (ergoemacs-command-loop--key-msg
+ (setq ergoemacs-command--blink-on (not
ergoemacs-command--blink-on))
+ nil nil
+ (this-single-command-keys)
+ nil nil nil)))))))
+
+(defun ergoemacs-command--echo-timer ()
+ "Echo the keystrokes in the `ergoemacs-mode' way."
+ (when (and (not ergoemacs-command-loop-type)
+ (not erogemacs-command--echo-timer))
+ (unless ergoemacs-orig-echo-keystrokes
+ (setq ergoemacs-orig-echo-keystrokes echo-keystrokes))
+ (setq echo-keystrokes 0)
+ (setq erogemacs-command--echo-timer
+ (run-at-time t ergoemacs-command-loop-blink-rate
#'ergoemacs-command--echo-prefix))))
+
+(defun ergoemacs-command--echo-timer-off ()
+ "Turn off the timer."
+ (setq echo-keystrokes ergoemacs-orig-echo-keystrokes)
+ (when erogemacs-command--echo-timer
+ (cancel-timer erogemacs-command--echo-timer)))
+
+(add-hook 'ergoemacs-post-command-hook #'ergoemacs-command--echo-timer)
+(add-hook 'ergoemacs-shutdown-hook #'ergoemacs-command--echo-timer-off)
+
+(defun ergoemacs-command-loop--read-key (&optional current-key type universal)
+ "Read a key for the `ergoemacs-mode' command loop.
+
+This uses `ergoemacs-command-loop--read-event'.
+
+CURRENT-KEY is the current key that is being read, the next key
+read will be appended to this key.
+
+TYPE is the type of translation being applied. By default,
+the :normal traslation is used.
+
+UNIVERSAL flag telss if this is a univeral argument that is being
+read."
+ (let* ((universal universal)
+ (type (or type :normal))
+ (translation (ergoemacs-translate--get type))
+ (local-keymap (ergoemacs-translate--keymap translation))
+ (text (ergoemacs-translation-struct-text translation))
+ (unchorded (ergoemacs-translation-struct-unchorded translation))
+ (trans (ergoemacs-translation-struct-translation translation))
+ (modal (ergoemacs :modal-p))
+ (keys nil)
+ (blink-on nil)
+ input
+ raw-input
+ mod-keys tmp
+ reset-key-p
+ double)
+ ;; Setup modal translation
+ (when (and (eq type :normal) modal)
+ (setq type (ergoemacs-translation-struct-key modal)
+ local-keymap (ergoemacs-translation-struct-keymap-modal modal)
+ text (ergoemacs-translation-struct-text modal)
+ unchorded (ergoemacs-translation-struct-unchorded modal)
+ trans (ergoemacs-translation-struct-translation modal)
+ tmp translation
+ translation modal
+ modal tmp
+ tmp nil))
+
+ ;; (ergoemacs-command-loop--read-key (read-kbd-macro "C-x" t)
:unchorded-ctl)
+ (when (functionp text)
+ (setq text (funcall text)))
+
+ (when trans
+ ;; Don't echo the uncommon hyper/super/alt translations (alt is
+ ;; not the alt key...)
+ (dolist (tr trans)
+ (unless (or (memq 'hyper (nth 0 tr)) (memq 'super (nth 0 tr)) (memq
'alt (nth 0 tr))
+ (and ergoemacs-command-loop-hide-shift-translations (memq
'shift (nth 0 tr))))
+ (if (member (list (nth 1 tr) (nth 0 tr)) trans)
+ (when (not (member (list (nth 1 tr) (nth 0 tr)) double))
+ (push tr double))
+ (push tr tmp))))
+ (setq trans tmp))
+
+ (setq trans (or (and (or trans double)
+ (concat "\nTranslations: "
+ (or (and double
+ (mapconcat
+ (lambda(elt)
+ ;; (and (setq tmp (elt current-key
0))
+ ;; (or (and (consp tmp)
(symbolp (setq tmp (car tmp)))))
+ ;; (stringp tmp)
+ ;; (string-match-p
"\\<mouse\\>" tmp))
+ (format "%s%s%s"
+ (ergoemacs :modifier-desc
(nth 0 elt))
+ (ergoemacs
:unicode-or-alt "↔" "<->")
+ (ergoemacs :modifier-desc
(nth 1 elt))))
+ double ", "))
+ "")
+ (or (and double trans ", ") "")
+ (mapconcat
+ (lambda(elt)
+ (format "%s%s%s"
+ (ergoemacs :modifier-desc (nth 0
elt))
+ (ergoemacs :unicode-or-alt "→"
"->")
+ (ergoemacs :modifier-desc (nth 1
elt))))
+ trans ", "))) ""))
+ (maphash
+ (lambda(key item)
+ (let ((local-key (where-is-internal key local-keymap t))
+ tmp)
+ (when local-key
+ (setq tmp (format "%s%s%s"
+ (ergoemacs-key-description local-key)
+ (if (eq (nth 1 item) :force)
+ (ergoemacs :unicode-or-alt "⇒" "=>")
+ (ergoemacs :unicode-or-alt "→" "->"))
+ (ergoemacs :modifier-desc (nth 0 item))))
+ (push (elt local-key 0) mod-keys)
+ (setq keys (or (and (not keys) tmp)
+ (and keys (concat keys ", " tmp)))))))
+ ergoemacs-command-loop--next-key-hash)
+
+ (setq keys (or (and keys (concat "\nKeys: " keys)) ""))
+ (setq unchorded (or (and unchorded (concat " " (ergoemacs :modifier-desc
unchorded))) ""))
+
+ (while (not input)
+ (while (not input)
+ (setq blink-on (not blink-on)
+ input (ergoemacs-command-loop--read-event
+ (ergoemacs-command-loop--key-msg blink-on universal text
current-key unchorded trans keys)
+ current-key)))
+ (cond
+ ((and (setq trans (or (and (memq input mod-keys)
+ (ergoemacs-gethash (lookup-key local-keymap
(vector input)) ergoemacs-command-loop--next-key-hash))
+ (setq reset-key-p (ergoemacs-gethash (lookup-key
local-function-key-map (ergoemacs :combine current-key input))
ergoemacs-command-loop--next-key-hash))))
+ (or (eq :force (nth 1 trans)) ;; Override any keys
+ (not (key-binding (vconcat current-key
(ergoemacs-translate--event-mods input trans)) t)) ;; Don't use if bound.
+ ))
+ (setq trans (nth 0 trans)
+ unchorded (concat " " (ergoemacs :modifier-desc trans))
+ input nil)
+ ;; Changed behavior.
+ (while (not input)
+ (setq blink-on (not blink-on)
+ input (ergoemacs-command-loop--read-event
+ (ergoemacs-command-loop--key-msg blink-on universal text
current-key unchorded trans keys)
+ current-key)))
+ (setq raw-input input
+ input (ergoemacs-translate--event-mods input trans)
+ last-command-event input
+ last-input-event input
+ ergoemacs-last-command-event last-command-event))
+ (t
+ ;; Translate the key appropriately.
+ (when (and modal (lookup-key ergoemacs-modal-ignored-keymap (vector
input)))
+ ;; Swap back, or ignore the modal translation.
+ (setq type (ergoemacs-translation-struct-key modal)
+ local-keymap (ergoemacs-translation-struct-keymap-modal modal)
+ text (ergoemacs-translation-struct-text modal)
+ unchorded (ergoemacs-translation-struct-unchorded modal)
+ trans (ergoemacs-translation-struct-translation modal)
+ tmp translation
+ translation modal
+ modal tmp
+ tmp nil))
+ (setq raw-input input
+ input (ergoemacs-translate--event-mods input type)
+ last-command-event input
+ last-input-event input
+ ergoemacs-last-command-event last-command-event)))
+ (cond
+ ((and input (not universal)
+ (not (key-binding (ergoemacs :combine current-key raw-input)))
+ (and local-keymap
+ (memq (lookup-key local-keymap (vector raw-input))
+ ergoemacs-command-loop--universal-functions)))
+ (setq universal t
+ raw-input nil
+ input nil
+ ergoemacs-command-loop--echo-keystrokes-complete t))
+ ((and raw-input universal) ;; Handle universal arguments.
+ (setq ergoemacs-command-loop--echo-keystrokes-complete t)
+ (cond
+ ((eq raw-input 45) ;; Negative argument
+ (cond
+ ((integerp current-prefix-arg)
+ (setq current-prefix-arg (- current-prefix-arg)))
+ ((eq current-prefix-arg '-)
+ (setq current-prefix-arg nil))
+ (t
+ (setq current-prefix-arg '-)))
+ (setq raw-input nil
+ input nil))
+ ((memq raw-input (number-sequence 48 57)) ;; Number
+ (setq raw-input (- raw-input 48)) ;; Actual Number.
+ (cond
+ ((and (integerp current-prefix-arg) (< 0 current-prefix-arg))
+ (setq current-prefix-arg (+ raw-input (* current-prefix-arg 10))))
+ ((and (integerp current-prefix-arg) (> 0 current-prefix-arg))
+ (setq current-prefix-arg (+ (- raw-input) (* current-prefix-arg
10))))
+ ((and (eq current-prefix-arg '-) (> raw-input 0))
+ (setq current-prefix-arg (- raw-input)))
+ (t
+ (setq current-prefix-arg raw-input)))
+ (setq input nil
+ raw-input nil))
+ ((and local-keymap
+ (memq (lookup-key local-keymap (vector raw-input))
+ ergoemacs-command-loop--universal-functions)) ;; Toggle
to key-sequence.
+ (setq raw-input nil
+ universal nil))
+ ((or (memq (key-binding (ergoemacs :combine current-key input) t)
ergoemacs-command-loop--universal-functions)
+ (not (key-binding (ergoemacs :combine current-key raw-input) t))
+ (and local-keymap (memq (lookup-key local-keymap (vector
raw-input)) ergoemacs-command-loop--universal-functions)))
+ ;; Universal argument called.
+ (cond
+ ((not current-prefix-arg)
+ (setq current-prefix-arg '(4)
+ raw-input nil
+ input nil))
+ ((listp current-prefix-arg)
+ (setq current-prefix-arg (list (* (nth 0 current-prefix-arg) 4))
+ raw-input nil
+ input nil))
+ (t
+ (setq universal nil
+ input nil
+ raw-input nil))))
+ ((and local-keymap
+ (memq (lookup-key local-keymap (vector raw-input))
+ ergoemacs-command-loop--undo-functions))
+ ;; Allow backspace to edit universal arguments.
+ (cond
+ ((not current-prefix-arg)) ;; Exit universal argument
+ ((and (integerp current-prefix-arg)
+ (= 0 (truncate current-prefix-arg 10))
+ (< 0 current-prefix-arg))
+ (setq current-prefix-arg nil
+ input nil
+ raw-input nil))
+ ((and (integerp current-prefix-arg)
+ (= 0 (truncate current-prefix-arg 10))
+ (> 0 current-prefix-arg))
+ (setq current-prefix-arg '-
+ input nil
+ raw-input nil))
+ ((integerp current-prefix-arg)
+ (setq current-prefix-arg (truncate current-prefix-arg 10)
+ input nil
+ raw-input nil))
+ ((listp current-prefix-arg)
+ (setq current-prefix-arg
+ (list (expt 4 (- (round (log (nth 0 current-prefix-arg) 4))
1))))
+ (when (equal current-prefix-arg '(1))
+ (setq current-prefix-arg nil))
+ (setq input nil
+ raw-input nil))
+ ((eq current-prefix-arg '-)
+ (setq current-prefix-arg nil
+ input nil
+ raw-input nil))))))))
+ ;; Return list of raw key, and translated current key
+ (list (vector raw-input) (ergoemacs :combine (if reset-key-p nil
current-key) input))))
+
(defun ergoemacs-command-loop--listify-key-sequence (key &optional type)
"Return a key sequence from KEY.
@@ -517,11 +1185,132 @@ This sequence is compatible with
`listify-key-sequence'."
input))
input))
+(defun ergoemacs-command-loop-p ()
+ "Determine if `ergoemacs-mode' is running its command loop.
+This is done by looking at the current `backtrace' and making
+sure that `ergoemacs-command-loop--internal' hasn't been called."
+ (eq (symbol-function 'this-command-keys)
#'ergoemacs-command-loop--this-command-keys))
+
+(defvar ergoemacs-command-loop-start nil)
+(defun ergoemacs-command-loop (&optional key type initial-key-type universal
initial-history)
+ "Process `ergoemacs-command-loop'.
+
+KEY is the key being read, or sequence being read.
+
+TYPE is the translation being used.
+
+INITIAL-KEY-TYPE ist he key type that is used fot the initial
+translation.
+
+UNIVERSAL is if the function will be calling a universal
+argument.
+
+INITIAL-HISTORY is the initial history list.
+
+The true work is done in `ergoemacs-command-loop--internal'."
+ (interactive)
+ (cond
+ ((and (or ergoemacs-command-loop-start key) (not
(ergoemacs-command-loop-p)))
+ ;; (ergoemacs-command-loop--message "Start ergoemacs-mode command loop." )
+ (ergoemacs-command-loop--internal key type initial-key-type universal
initial-history))
+ (t
+ (setq ergoemacs-command-loop--exit :ignore-post-command-hook
+ prefix-arg current-prefix-arg
+ ergoemacs-command-loop--single-command-keys (or (and key
(read-kbd-macro key t))
+
ergoemacs-command-loop--single-command-keys)
+ unread-command-events (or (and key
(ergoemacs-command-loop--listify-key-sequence key initial-key-type))
+ unread-command-events)
+ ergoemacs-command-loop--universal (if (and
ergoemacs-command-loop--universal (not universal)) nil
+ universal)
+ ergoemacs-command-loop--current-type (or type
ergoemacs-command-loop--current-type)
+ ergoemacs-command-loop--history (or initial-history
ergoemacs-command-loop--history)))))
+
+(defvar ergoemacs-command-loop--running-pre-command-hook-p nil
+ "Variable to tell if ergoemacs-command loop is running the
`pre-command-hook'.")
+
+(defvar ergoemacs-command-loop--excluded-variables
+ '(defining-kbd-macro executing-kbd-macro)
+ "List of variables stopping the command loop.
+
+While these variables are non-nil, the `ergoemacs-command-loop'
+will stop and not be started agin.")
+
+(defvar ergoemacs-command-loop--excluded-major-modes
+ '(calc-mode calc-trail-mode calc-edit-mode)
+ "List of major modes where the command loop is incompatible.")
+
+
(defvar ergoemacs-command-loop--minibuffer-unsupported-p nil)
+(defun ergoemacs-command-loop--minibuffer-supported-p (&optional command)
+ "Determine if the current minibuffer supports the full command loop.
+When COMMAND is non-nil, set
+`ergoemacs-command-loop--minibuffer-unsupported-p' to the
+appropriate value based on the COMMAND."
+ (if (not command)
+ (or (not (minibufferp))
+ (not ergoemacs-command-loop--minibuffer-unsupported-p))
+ (when (or (and command (symbolp command) (string-match-p
"^\\(calc\\|math\\)" (symbol-name command)))
+ (and (stringp command) (string-match-p "^[^:]*:\\(calc\\|math\\)"
command)))
+ (ergoemacs-save-buffer-state
+ (set (make-local-variable
'ergoemacs-command-loop--minibuffer-unsupported-p) t)))
+ (ergoemacs-command-loop--minibuffer-supported-p)))
+
+(defun ergoemacs-command-loop-full-p (&optional type)
+ "Determines if the full command loop should be run.
+
+
+TYPE is the type of command loop to check for. By default this
+is the :full command loop."
+ (and
+ (or (eq ergoemacs-command-loop-type (or type :full)) (ergoemacs :modal-p))
+ (ergoemacs-command-loop--minibuffer-supported-p)
+ (catch 'excluded-variables
+ (dolist (var ergoemacs-command-loop--excluded-variables)
+ (when (and var (ergoemacs-sv var))
+ (throw 'excluded-variables nil)))
+ t)
+ (not (memq major-mode ergoemacs-command-loop--excluded-major-modes))))
+
+(defun ergoemacs-command-loop--start-with-pre-command-hook ()
+ "Start ergoemacs command loop.
+
+This is done by replacing `this-command' with
+`ergoemacs-command-loop-start' and then running `this-command'
+from within the ergoemacs-mode command loop."
+ (when (and (not ergoemacs-command-loop--running-pre-command-hook-p)
+ (ergoemacs-command-loop-full-p)
+ (not unread-command-events)
+ (not (ergoemacs-command-loop-p)))
+ (setq ergoemacs-command-loop-start this-command
+ ergoemacs-command-loop--single-command-keys
(this-single-command-keys)
+ this-command 'ergoemacs-command-loop-start)))
+
+(add-hook 'ergoemacs-pre-command-hook
#'ergoemacs-command-loop--start-with-pre-command-hook)
+
+
+(defvar ergoemacs-command-loop--internal-end-command-p nil)
(defvar ergoemacs-last-command-was-ergoemacs-ignore-p nil
"Last command was `ergoemacs-ignore'.")
+(defun ergoemacs-command-loop--start-with-post-command-hook ()
+ "Start ergoemacs command loop.
+
+This is done by pushing the key [ergoemacs-ignore] on the
+`unread-command-events' stack. This then forces `ergoemacs-mode'
+to start with
+`ergoemacs-command-loop--start-with-pre-command-hook'."
+ (when (and (not ergoemacs-command-loop--internal-end-command-p)
+ (ergoemacs-command-loop-full-p))
+ (if ergoemacs-last-command-was-ergoemacs-ignore-p
+ (unless (eq ergoemacs-last-command-was-ergoemacs-ignore-p :idle)
+ (run-with-idle-timer 0.05 nil (lambda()
+ (setq
ergoemacs-last-command-was-ergoemacs-ignore-p :idle)
+ (ergoemacs-command-loop-start))))
+ (push 'ergoemacs-ignore unread-command-events))))
+
+(add-hook 'ergoemacs-post-command-hook
#'ergoemacs-command-loop--start-with-post-command-hook)
+
(defvar ergoemacs-command-loop--point-motion-last-point nil
"Record the last point.")
@@ -557,6 +1346,79 @@ Fix this issue."
(ignore-errors (switch-to-buffer (window-buffer) t t))
(goto-char (window-point))))
+(defun ergoemacs-command-loop--update-primary-selection ()
+ "Update primary clipboard in X based systems."
+ (when (and mouse-drag-copy-region
+ (eventp last-command-event)
+ (consp last-command-event)
+ (memq (event-basic-type (car last-command-event))
+ '(mouse-1))
+ (region-active-p))
+ (ergoemacs :set-selection 'PRIMARY (buffer-substring-no-properties
(region-beginning) (region-end)))))
+
+(defun ergoemacs-command-loop--internal-end-command ()
+ "Simulates the end of a command."
+ ;; Simulate the end of an emacs command, since we are not
+ ;; exiting the loop.
+ (setq ergoemacs-command-loop--internal-end-command-p t)
+ (unwind-protect
+ (run-hooks 'post-command-hook)
+ (setq ergoemacs-command-loop--internal-end-command-p nil))
+
+ ;; Deactivate mark.
+ (when deactivate-mark
+ (deactivate-mark)
+ (setq deactivate-mark nil))
+
+ ;; Create undo-boundary like emacs does.
+
+ ;; The undo boundary is created every 20 characters.
+ (when (eq this-command 'self-insert-command)
+ ;; Adapted from `org-self-insert-command'
+ (if (not (eq last-command 'self-insert-command))
+ (setq ergoemacs-command-loop--self-insert-command-count 1)
+ (if (>= ergoemacs-command-loop--self-insert-command-count 20)
+ (setq ergoemacs-command-loop--self-insert-command-count 1)
+ (and (> ergoemacs-command-loop--self-insert-command-count 0)
+ buffer-undo-list (listp buffer-undo-list)
+ (not (cadr buffer-undo-list)) ; remove nil entry
+ (setcdr buffer-undo-list (cddr buffer-undo-list)))
+ (setq ergoemacs-command-loop--self-insert-command-count
+ (1+ ergoemacs-command-loop--self-insert-command-count))))
+ ;; See:
http://stackoverflow.com/questions/6590889/how-emacs-determines-a-unit-of-work-to-undo
+
+ ;; FIXME:
+ ;; Certain "hairy" insertions (as determined by
+ ;; internal_self_insert) cause an an undo boundary to be added
+ ;; immediately, and the character count to be reset. Reading the
+ ;; code, it looks as though these are: (1) in overwrite-mode, if you
+ ;; overwrote a character with one that has a different width,
+ ;; e.g. typing over a tab; (2) if the character you inserted caused
+ ;; an abbreviation to be expanded; (3) if the character you typed
+ ;; caused auto-fill-mode to insert indentation.
+ )
+
+ ;; After executing, the emacs loop should copy `this-command' into
+ ;; `last-command'.
+ ;; It should also change `last-prefix-arg'
+ (setq last-command this-command
+ real-last-command this-command ;; Hopefully doesn't throw an error.
+ last-prefix-arg prefix-arg
+ current-prefix-arg prefix-arg
+ prefix-arg nil
+ this-command nil
+ deactivate-mark nil
+ ergoemacs-command-loop--echo-keystrokes-complete nil)
+
+ (undo-boundary)
+ ;; This (sort of) fixes `this-command-keys'
+ ;; But it doesn't fix it for keyboard macros.
+ (clear-this-command-keys t)
+ (setq ergoemacs-command-loop--decode-event-timeout-p nil)
+ (ergoemacs-command-loop--sync-point)
+ (ergoemacs-command-loop--point-motion-hooks)
+ (ergoemacs-command-loop--update-primary-selection))
+
(defun ergoemacs-command-loop--mouse-command-drop-first (args &optional
fn-arg-p)
"Internal function for processing mouse commands.
@@ -609,6 +1471,68 @@ FN-ARG-P can be nil, :drop-rest or :rest"
(push a ret)))
(reverse ret))))))
+(defun ergoemacs-command-loop--modify-mouse-command (command)
+ "Modify mouse COMMAND to work with ergoemacs command loop."
+ (let* ((iform (interactive-form command))
+ (form (and iform (consp iform) (= 2 (length iform)) (stringp (nth 1
iform)) (nth 1 iform)))
+ (args (help-function-arglist command t))
+ (fn-args (ergoemacs-command-loop--mouse-command-drop-first args t))
+ (strip-args (ergoemacs-command-loop--mouse-command-drop-first args))
+ (rest-p (ergoemacs-command-loop--mouse-command-drop-first args :rest))
+ (drop-rest (ergoemacs-command-loop--mouse-command-drop-first args
:drop-rest))
+ (select-window-p (and (stringp form) (string-match-p "^[*^]*[@]"
form)))
+ (event-p (and (stringp form) (string-match-p "^[*@^]*e" form)))
+ (new-form (and form
+ (or (and (not event-p) form)
+ (and event-p (replace-regexp-in-string
"^\\([*@^]*\\)e\n*\\(.*\\)" "\\1\\2" form))))))
+ (when (and new-form (string= new-form ""))
+ (setq new-form nil))
+ (cond
+ ((not event-p)
+ command)
+ (rest-p
+ `(lambda ,fn-args
+ ,(if new-form
+ `(interactive ,new-form)
+ `(interactive))
+ ,(when select-window-p
+ '(select-window (posn-window (event-start last-command-event))))
+ (ergoemacs-command-loop--execute-modify-command-list ',command)
+ (if ,rest-p
+ (apply ',command last-command-event ,@strip-args)
+ (,command last-command-event ,@drop-rest))))
+
+ ((not rest-p)
+ `(lambda ,fn-args
+ ,(if new-form
+ `(interactive ,new-form)
+ `(interactive))
+ ,(when select-window-p
+ '(select-window (posn-window (event-start last-command-event))))
+ (ergoemacs-command-loop--execute-modify-command-list ',command)
+ (,command last-command-event ,@strip-args))))))
+
+(defun ergoemacs-command-loop--call-mouse-command (command &optional
record-flag keys)
+ "Call a possible mouse COMMAND.
+
+The COMMAND is modified to take out any event information and
+replace it with `last-event-command' information. This
+modifciation isd one by
+`ergoemacs-command-loop--modify-mouse-command'.
+
+Mouse commands are also wrapped in `ignore-errors'. This takes
+care of `window-live-p' errors that occur when running the
+Emacs detects keys when outside of Emacs.
+
+The RECORD-FLAG and KEYS arguments are passed to
+`ergoemacs-command-loop--grow-interactive' for the mouse command."
+ (cond
+ ((ergoemacs-keymapp command)
+ (popup-menu command nil current-prefix-arg))
+ (t
+ (ignore-errors
+ (call-interactively (ergoemacs-command-loop--modify-mouse-command
command) record-flag keys)))))
+
(defvar ergoemacs-command-loop-describe-key-functions
'(describe-key describe-function)
"Functions like `describe-key'.
@@ -616,6 +1540,124 @@ These functions will:
- Replace `key-description' with `ergoemacs-key-description'.
- Replace `read-key-sequence' with
`ergoemacs-command-loop--read-key-sequence'.")
+(defcustom ergoemacs-comand-loop-grow-max-sizes-p t
+ "Grow the max sizes if needed.
+This grows `max-specpdl-size' and `max-lisp-eval-depth' if
+`ergoemacs-command-loop--call-interactively' throws an error
+about `max-specpdl-size' or `max-lisp-eval-depth'.
+
+The overall maximum that these are set to are controlled by
+`ergoemacs-max-specpdl-size' and
+`ergoemacs-max-lisp-eval-depth.'"
+ :type 'boolean
+ :group 'ergoemacs-mode)
+
+(defvar ergoemacs-command-loop--grow-command nil)
+(defvar ergoemacs-command-loop--grow-record nil)
+(defvar ergoemacs-command-loop--grow-keys nil)
+(defvar ergoemacs-command-loop--grow-special nil)
+
+
+(defcustom ergoemacs-max-specpdl-size (* 8 max-specpdl-size)
+ "Maximum `max-specpdl-size' that `ergoemacs-mode' increases to..."
+ :type 'boolean
+ :group 'ergoemacs-mode)
+
+(defcustom ergoemacs-max-lisp-eval-depth (* 8 max-lisp-eval-depth)
+ "Maximum `max-lisp-eval-depth' that `ergoemacs-mode' increases to..."
+ :type 'boolean
+ :group 'ergoemacs-mode)
+
+(defcustom ergoemacs-command-loop-dont-grow-commands
+ '(org-agenda)
+ "List of commands where the command loop will not adjust sizes."
+ :type '(repeat (sexp :tag "Command"))
+ :group 'ergoemacs-mode)
+
+(defun ergoemacs-command-loop--grow-interactive (command &optional record-flag
keys)
+ "Call the COMMAND interactively.
+The RECORD-FLAG and KEYS are sent to `ergoemacs--real-call-interactively'.
+
+This will grow `max-lisp-eval-depth' and `max-specpdl-size' if
+needed (and resotre them to the original values)."
+ (setq ergoemacs-command-loop--grow-command nil
+ ergoemacs-command-loop--grow-record nil
+ ergoemacs-command-loop--grow-keys nil
+ ergoemacs-command-loop--grow-special nil)
+ (if (memq command ergoemacs-command-loop-dont-grow-commands)
+ (call-interactively command record-flag keys)
+ (let ((grow-max-lisp-p t)
+ (orig-max-specpdl-size max-specpdl-size)
+ (orig-max-lisp-eval-depth max-lisp-eval-depth))
+ (while grow-max-lisp-p
+ (condition-case err
+ (cond
+ (ergoemacs-command-loop--grow-command
+ (command-execute ergoemacs-command-loop--grow-command
+ ergoemacs-command-loop--grow-record
+ ergoemacs-command-loop--grow-keys
+ ergoemacs-command-loop--grow-special)
+ (setq grow-max-lisp-p nil))
+ (t
+ (call-interactively command record-flag keys)
+ (setq grow-max-lisp-p nil)))
+ (error
+ (if (and (consp err)
+ (eq (car err) 'error)
+ (stringp (nth 1 err))
+ (string-match "max-specpdl-size\\|max-lisp-eval-depth"
+ (nth 1 err))
+ ergoemacs-comand-loop-grow-max-sizes-p
+ (<= max-specpdl-size ergoemacs-max-specpdl-size)
+ (<= max-lisp-eval-depth ergoemacs-max-lisp-eval-depth))
+ (progn
+ (setq max-specpdl-size (* 2 max-specpdl-size)
+ max-lisp-eval-depth (* 2 max-lisp-eval-depth))
+ (ergoemacs-warn "Increased max-specpdl-size to %s and
max-lisp-eval-depth to %s for %s"
+ max-specpdl-size max-lisp-eval-depth command))
+ (setq grow-max-lisp-p nil
+ max-specpdl-size orig-max-specpdl-size
+ max-lisp-eval-depth orig-max-lisp-eval-depth)
+ (if (and err (consp err))
+ (signal (car err) (cdr err))
+ (signal err "Unknown error"))))))
+ (setq max-specpdl-size orig-max-specpdl-size
+ max-lisp-eval-depth orig-max-lisp-eval-depth))))
+
+
+(defun ergoemacs-command-loop--call-interactively (command &optional
record-flag keys)
+ "Call the COMMAND interactively. Also handle mouse events (if possible.)
+The RECORD-FLAG and KEYS are sent to
`ergoemacs-command-loop--grow-interactive'."
+ (ergoemacs-command-loop--sync-point)
+ (setq ergoemacs-last-command-was-ergoemacs-ignore-p nil
+ this-command-keys-shift-translated (or
ergoemacs-this-command-keys-shift-translated
this-command-keys-shift-translated))
+ (cond
+ ((and (eventp last-command-event)
+ (consp last-command-event)
+ (memq (event-basic-type (car last-command-event))
+ '(mouse-1 mouse-2 mouse-3 mouse-4 mouse-5 mouse-6 mouse-7
mouse-8 mouse-9)))
+ (ergoemacs-command-loop--call-mouse-command command record-flag keys))
+ ((and (symbolp command) (not (fboundp command)))
+ (ergoemacs-command-loop--message "Command `%s' is not found" command))
+ ((and (symbolp command) (not (commandp command)))
+ (ergoemacs-command-loop--message "Command `%s' cannot be called from a
key" command))
+ ((and (consp ergoemacs-command-loop-describe-key-functions)
+ (memq command ergoemacs-command-loop-describe-key-functions))
+ (ergoemacs-specials
+ (ergoemacs-command-loop--grow-interactive command record-flag keys)))
+ (t
+ (ergoemacs-command-loop--grow-interactive command record-flag keys)))
+ (setq ergoemacs-this-command-keys-shift-translated nil))
+
+
+(defun ergoemacs-command-loop-start ()
+ "Start `ergoemacs-command-loop'."
+ (interactive)
+ ;; Should work...
+ (unless ergoemacs-command-loop-start
+ (setq ergoemacs-command-loop-start t))
+ (ergoemacs-command-loop))
+
(defvar ergoemacs-command-loop--spinner nil)
(defvar ergoemacs-command-loop--spinner-i nil)
(defvar ergoemacs-command-loop--spinner-list nil)
@@ -676,7 +1718,7 @@ instead of `format'."
(when (eq ergoemacs-message-level
ergoemacs-command-loop--spinner-display)
(let* ((string (or (and (listp string)
(eq (car string) 'quote)
- (eval string))
+ (cadr string))
string))
(rest (or (and (listp string)
(concat " " (apply #'format (apply
#'ergoemacs-key-description--unicode-char string) args)))
@@ -686,10 +1728,12 @@ instead of `format'."
(when (not ergoemacs-command-loop--spinner-list)
(setq ergoemacs-command-loop--spinner-list (nth 1 (assoc
ergoemacs-command-loop-spinner ergoemacs-command-loop-spinners))
ergoemacs-command-loop--spinner-i 0))
- (ergoemacs-command-loop--message "%s%s" (nth (mod (setq
ergoemacs-command-loop--spinner-i (+ 1 ergoemacs-command-loop--spinner-i))
- (length
ergoemacs-command-loop--spinner-list))
-
ergoemacs-command-loop--spinner-list)
- rest))))))
+ (ergoemacs-command-loop--message
+ "%s%s" (nth (mod (setq ergoemacs-command-loop--spinner-i
+ (+ 1 ergoemacs-command-loop--spinner-i))
+ (length ergoemacs-command-loop--spinner-list))
+ ergoemacs-command-loop--spinner-list)
+ rest))))))
(defun ergoemacs-command-loop--spinner-end ()
"Cancel the `ergoemacs-command-loop--spinner' timer."
@@ -714,6 +1758,28 @@ They don't exactly behave like their Emacs equivalents."
(or (and ergoemacs-mode ergoemacs-command-loop--single-command-keys)
(funcall ergoemacs-command-loop--this-command-keys)))
+(defvar ergoemacs-command-loop--timer nil
+ "Timer to startup `ergoemacs-mode' command loop.")
+(defun ergoemacs-command-loop--timer ()
+ "Start `ergoemacs-command-loop--internal' if not currently running."
+ (unless (and (ergoemacs-command-loop-full-p)
+ (ergoemacs-command-loop-p))
+ (ergoemacs-command-loop--internal)))
+
+(defun ergoemacs-command-loop--install-timer ()
+ "Install the `ergoemacs-command-loop--timer'."
+ (setq ergoemacs-command-loop--timer
+ (run-with-idle-timer 0.05 nil #'ergoemacs-command-loop--timer)))
+
+(defun ergoemacs-command-loop--remove-timer ()
+ "Remove `ergoemacs-command-loop--timer'."
+ (when ergoemacs-command-loop--timer
+ (cancel-timer ergoemacs-command-loop--timer)
+ (setq ergoemacs-command-loop--timer nil)))
+
+(add-hook 'ergoemacs-mode-startup-hook #'ergoemacs-command-loop--install-timer)
+(add-hook 'ergoemacs-mode-shutdown-hook #'ergoemacs-command-loop--remove-timer)
+
(defun ergoemacs-command-loop--ignore (&rest _ignore)
"Do nothing and return nil.
@@ -727,6 +1793,227 @@ run, by changing `this-command' to `last-command'"
;; FIXME: Somehow change the output of `this-single-command-raw-keys'
nil)
+(defun ergoemacs-command-loop--read-key-sequence (prompt &rest _ignore)
+ "Read key sequence in ergoemacs-mode with PROMPT.
+
+Ignore all the other options."
+ (let ((old ergoemacs-command-loop-type)
+ (old-prompt ergoemacs-command-loop--read-key-prompt)
+ ret)
+ (setq ergoemacs-command-loop-type :read-key-sequence
+ ergoemacs-command-loop--read-key-prompt prompt)
+ (unwind-protect
+ (setq ret (ergoemacs-command-loop--internal))
+ (setq ergoemacs-command-loop-type old
+ ergoemacs-command-loop--read-key-prompt old-prompt))
+ ret))
+
+(defun ergoemacs-command-loop--internal (&optional key type initial-key-type
universal initial-history)
+ "Read keyboard input and execute command.
+The KEY is the keyboard input where the reading begins. If nil,
+read the whole keymap.
+
+TYPE is the keyboard translation type, defined by `ergoemacs-translate'
+Ergoemacs-mode sets up: :ctl-to-alt :unchorded :normal.
+
+INITIAL-KEY-TYPE represents the translation type for the initial KEY.
+
+UNIVERSAL allows ergoemacs-read-key to start with universal
+argument prompt.
+
+INITIAL-HISTORY is the initial history list to use.
+
+While in the loop, every command resets the keys typed every time
+a command is completed (by `clear-this-command-keys')
+
+Also in the loop, `universal-argument-num-events' is set to
+0. (Allows commands like `isearch' to work correctly in older
+Emacs versions)."
+ (interactive)
+ (when ergoemacs-mode
+ (ergoemacs-command-loop--execute-rm-keyfreq 'ergoemacs-command-loop)
+ ;; Call the startup command
+ (when (commandp ergoemacs-command-loop-start)
+ (ergoemacs-command-loop--call-interactively ergoemacs-command-loop-start)
+ (ergoemacs-command-loop--internal-end-command))
+ ;; Replace functions temporarily
+ (cl-letf (((symbol-function 'this-command-keys)
#'ergoemacs-command-loop--this-command-keys)
+ ((symbol-function 'this-single-command-keys)
#'ergoemacs-command-loop--this-command-keys)
+ ((symbol-function 'this-command-keys-vector)
#'ergoemacs-command-loop--this-command-keys)
+ ((symbol-function 'this-single-command-raw-keys)
#'ergoemacs-command-loop--this-command-keys)
+ ;; ((symbol-function 'read-key-sequence)
#'ergoemacs-command-loop--read-key-sequence)
+ )
+ (let* ((type (or type :normal))
+ (from-start-p ergoemacs-command-loop-start)
+ (continue-read t)
+ (first-type type)
+ raw-key current-key last-current-key
+ (translation (ergoemacs-translate--get type))
+ (local-keymap (ergoemacs-translate--keymap translation))
+ modal-p
+ tmp command)
+ (unwind-protect
+ (progn
+ ;; Set these to nil when entering the command loop;
+ ;;
+ ;; For some reason `inhibit-point-motion-hooks' on emacs
+ ;; 25.1 is t when the command loop is entered.
+ ;;
+ ;; To allow the point motion hooks to work as
+ ;; advertised, set these on starting the command loop.
+ (setq inhibit-point-motion-hooks nil
+ disable-point-adjustment nil
+ global-disable-point-adjustment nil)
+ ;; Setup initial unread command events, first type and history
+ (setq tmp (ergoemacs-command-loop--listify-key-sequence key
initial-key-type)
+ unread-command-events (or (and unread-command-events tmp
(append tmp unread-command-events)) tmp)
+ ergoemacs-command-loop--first-type first-type
+ ergoemacs-command-loop--history initial-history
+ ergoemacs-command-loop-start nil)
+ (while continue-read
+ (setq ergoemacs-last-command-was-ergoemacs-ignore-p nil)
+ (unless (eq ergoemacs-command-loop-type :read-key-sequence)
+ (setq inhibit-quit t))
+ (while continue-read
+ (setq ergoemacs-last-command-was-ergoemacs-ignore-p nil)
+ ;; Read key
+ (setq ergoemacs-command-loop--single-command-keys current-key
+ ergoemacs-command-loop--current-type type
+ ergoemacs-command-loop--universal universal
+ raw-key (ergoemacs-command-loop--read-key
+ current-key
+ (or (and unread-command-events :normal) type)
+ (and (not unread-command-events) universal))
+ ergoemacs-command-loop--single-command-keys nil
+ universal-argument-num-events 0
+ last-current-key current-key
+ current-key (nth 1 raw-key)
+ raw-key (nth 0 raw-key)
+ continue-read nil)
+ (when (setq modal-p (ergoemacs :modal-p))
+ (setq local-keymap
(ergoemacs-translation-struct-keymap-modal modal-p)))
+ (cond
+ ;; Handle quit commands
+ ((and last-current-key
+ (or (lookup-key ergoemacs-map--quit-map raw-key)
+ (and (equal raw-key [27])
+ (lookup-key ergoemacs-map--quit-map
[escape]))))
+ (ergoemacs-command-loop--message
+ "Key sequence %s aborted by %s"
+ (ergoemacs-key-description last-current-key)
+ (ergoemacs-key-description raw-key))
+ (setq quit-flag t
+ ergoemacs-this-command-keys-shift-translated nil))
+ ;; Handle local commands.
+ ((and (or modal-p
+ (not (equal current-key raw-key)))
+ (setq command (lookup-key local-keymap raw-key))
+ (not (ergoemacs-keymapp command)) ;; Ignore locally
+ ;; Already handled by
`ergoemacs-command-loop--read-key'
+ (not (ergoemacs-gethash command
ergoemacs-command-loop--next-key-hash))
+ ;; If a command has :ergoemacs-local property of
:force, don't
+ ;; worry about looking up a key, just run the
function.
+ (or modal-p
+ (and (symbolp command) (eq (get command
:ergoemacs-local) :force))
+ (not (key-binding current-key t))))
+ (pop ergoemacs-command-loop--history) ;; Don't recored
local events
+ (setq ergoemacs-command-loop--single-command-keys
last-current-key
+ universal-argument-num-events 0
+ ergoemacs-command-loop--current-type type
+ ergoemacs-command-loop--universal universal
+ ergoemacs-command-loop--exit nil)
+
+ (unless (eq ergoemacs-command-loop-type :test)
+ (setq tmp this-command
+ this-command command)
+ (ergoemacs-command-loop--call-interactively this-command)
+ (setq command this-command
+ this-command tmp))
+ ;; If the command changed anything, fix it here.
+ (unless (equal type ergoemacs-command-loop--current-type)
+ (setq type ergoemacs-command-loop--current-type
+ translation (ergoemacs-translate--get type)
+ local-keymap (ergoemacs-translate--keymap
translation)))
+
+ (setq current-key
ergoemacs-command-loop--single-command-keys
+ universal ergoemacs-command-loop--universal
+ ergoemacs-command-loop--single-command-keys nil
+ continue-read (not ergoemacs-command-loop--exit)))
+ ;; Handle any keys that are bound in some translatable way.
+ ((setq command (ergoemacs-command-loop--key-lookup
current-key))
+ ;; Setup external indicators of how the loop currently
behaves.
+ (setq ergoemacs-command-loop--single-command-keys
current-key
+ universal-argument-num-events 0
+ ergoemacs-command-loop--current-type type
+ ergoemacs-command-loop--universal nil
+ ergoemacs-command-loop--exit t)
+ (if (setq continue-read (and (not (and (consp (aref
current-key 0))
+ (memq
(event-basic-type (car (aref current-key 0)))
+ '(mouse-1
mouse-2 mouse-3 mouse-4 mouse-5 mouse-6 mouse-7 mouse-8 mouse-9))))
+ (ergoemacs-keymapp command)))
+ (setq universal nil)
+ (unless (memq ergoemacs-command-loop-type '(:test
:read-key-sequence))
+ (with-local-quit
+ (ergoemacs-command-loop--execute command)))
+
+ (when quit-flag
+ (ergoemacs-command-loop--message "Quit!"))
+
+ ;; Change any information (if needed)
+ (unless (equal type ergoemacs-command-loop--current-type)
+ (setq type ergoemacs-command-loop--current-type
+ translation (ergoemacs-translate--get type)
+ local-keymap (ergoemacs-translate--keymap
translation)))
+
+ (when (eq ergoemacs-command-loop-type :read-key-sequence)
+ (setq ergoemacs-command-loop--exit t
+ continue-read nil
+ command current-key))
+
+ (setq current-key
ergoemacs-command-loop--single-command-keys
+ universal ergoemacs-command-loop--universal
+ ergoemacs-command-loop--single-command-keys nil
+ continue-read (not ergoemacs-command-loop--exit)
+ current-prefix-arg (if
ergoemacs-command-loop--universal current-prefix-arg prefix-arg))
+
+ (when (and (not continue-read)
+ (eq ergoemacs-command-loop--exit
:ignore-post-command-hook))
+ (setq continue-read t)))
+
+ (when (or (not ergoemacs-command-loop--exit)
+ (and (not continue-read) (setq continue-read
unread-command-events)))
+ (ergoemacs-command-loop--internal-end-command)))
+ (quit-flag
+ (ergoemacs-command-loop--message "Quit!")
+ (setq quit-flag nil
+ type :normal
+ first-type :normal
+ raw-key nil
+ current-key nil
+ translation (ergoemacs-translate--get type)
+ local-keymap (ergoemacs-translate--keymap
translation)
+ ergoemacs-command-loop--first-type first-type
+ ergoemacs-command-loop--history nil))
+ ((consp (aref current-key 0))) ;; don't complain about mouse
keys
+ (t ;; Command not found exit.
+ (ergoemacs-command-loop--message "Key %s doesn't do
anything." (ergoemacs-key-description current-key)))))
+ (unless quit-flag
+ (ergoemacs-command-loop--internal-end-command))
+ (setq quit-flag nil
+ type :normal
+ continue-read (or unread-command-events (and
from-start-p (ergoemacs-command-loop-full-p)))
+ first-type :normal
+ raw-key nil
+ current-key nil
+ translation (ergoemacs-translate--get type)
+ local-keymap (ergoemacs-translate--keymap translation)
+ ergoemacs-command-loop--first-type first-type
+ ergoemacs-command-loop--history nil)
+ (when (or (not ergoemacs-mode) (eq :read-key-sequence
ergoemacs-command-loop-type))
+ (setq continue-read nil)))
+ (setq inhibit-quit nil)))
+ command))))
+
(defcustom ergoemacs-message-in-mode-line t
"Display ergoemacs information in mode-line."
:type 'boolean
@@ -791,6 +2078,333 @@ to the `format' like: (format str args)."
(let ((message-log-max ergoemacs-command-loop--message-log-max))
(apply #'message (append (list str) args))))))
+(defvar ergoemacs-command-loop--temp-message-timer-secs 0.5
+ "Timer to ensure minibuffer isn't active.")
+
+(defvar ergoemacs-command-loop--temp-message-timer nil
+ "Timer to ensure minibuffer isn't active.")
+
+(defvar ergoemacs-command-loop--temp-message-timer-str nil
+ "Message string.")
+
+(defun ergoemacs-command-loop--temp-message-timer-echo ()
+ "Echos `ergoemacs-command-loop--temp-message-timer-str' if minibuffer isn't
active."
+ (if (or (minibufferp) isearch-mode)
+ (setq ergoemacs-command-loop--temp-message-timer
+ (run-with-idle-timer ergoemacs-command-loop--temp-message-timer-secs
+ nil
#'ergoemacs-command-loop--temp-message-timer-echo))
+ (cancel-timer ergoemacs-command-loop--temp-message-timer)
+ (let (message-log-max)
+ (with-temp-message ergoemacs-command-loop--temp-message-timer-str
+ (sit-for (or (and (numberp ergoemacs-command-loop-message-sit-for)
ergoemacs-command-loop-message-sit-for) 2))))))
+
+(defun ergoemacs-command-loop--temp-message (str &rest args)
+ "Message facility for `ergoemacs-mode' command loop.
+
+STR is the format string
+ARGS is the format arguments
+These are passed to `format' as (format str args)."
+ (setq ergoemacs-command-loop--last-event-time (float-time))
+ (cond
+ ((string= str ""))
+ ((or (minibufferp) isearch-mode)
+ (apply #'ergoemacs-command-loop--mode-line-message
+ (append (list str) args)))
+ (t
+ (setq ergoemacs-command-loop--temp-message-timer-str (apply #'format
(append (list str) args))
+ ergoemacs-command-loop--temp-message-timer
+ (run-with-idle-timer ergoemacs-command-loop--temp-message-timer-secs
+ nil
#'ergoemacs-command-loop--temp-message-timer-echo)))))
+
+;; (2) Key sequence translated to command
+(defun ergoemacs-command-loop--message-binding (key &optional lookup
translated-key)
+ "Optionally messages information about the translation.
+
+KEY is the original key.
+
+LOOKUP is what will be run.
+
+TRANSLATED-KEY is what the assumed key is actually bound."
+ (cond
+ ((and lookup (ergoemacs-keymapp lookup)))
+ ((consp (elt key 0))) ;; Don't message mouse translations
+ ((and (or (eq ergoemacs-echo-function :multi-key)
+ (not (and translated-key (eq ergoemacs-echo-function
:on-translation)))
+ (not (eq ergoemacs-echo-function t)))
+ (vectorp key) (or (= (length key) 1) ;; Don't message single keys
+ (and (eq 27 (elt key 0)) (= (length key) 2)))))
+ ((and lookup
+ (or (eq ergoemacs-echo-function t)
+ (and translated-key (eq ergoemacs-echo-function :on-translation))
+ (eq ergoemacs-echo-function :multi-key)))
+ (ergoemacs-command-loop--temp-message "%s%s%s%s"
+ (ergoemacs-key-description key)
+ (ergoemacs :unicode-or-alt "→" "->")
+ lookup
+ (or (and translated-key
+ (format " (from %s)"
(ergoemacs-key-description translated-key)))
+ "")))
+ ((not lookup)
+ (ergoemacs-command-loop--temp-message "%s is undefined!"
+ (ergoemacs-key-description key)))
+ ((and ergoemacs-echo-function
+ (not (or (= (length key) 1) ;; Clear command completing message
+ (and (eq 27 (elt key 0)) (= (length key) 2)))))
+ (ergoemacs-command-loop--message ""))))
+
+(defun ergoemacs-command-loop--key-lookup (key)
+ "Find the KEY's function based on current bindings.
+
+If `ergoemacs-mode' has translated this, make Emacs think you
+pressed the translated key by changing
+`ergoemacs-command-loop--single-command-keys'."
+ (if (and (vectorp key)
+ (consp (aref key 0))
+ (memq (event-basic-type (car (aref key 0)))
+ '(mouse-1 mouse-2 mouse-3 mouse-4 mouse-5 mouse-6 mouse-7
mouse-8 mouse-9)))
+ (let* ((event (aref key 0))
+ (posn (car (cdr last-command-event)))
+ (area (and posn (ergoemacs-posnp posn) (posn-area posn)))
+ (obj (and posn (ergoemacs-posnp posn) (posn-object posn)))
+ (original-command (key-binding key t))
+ command tmp)
+ ;; From `read-key-sequence':
+ ;; /* Clicks in non-text areas get prefixed by the symbol
+ ;; in their CHAR-ADDRESS field. For example, a click on
+ ;; the mode line is prefixed by the symbol `mode-line'.
+ ;; Furthermore, key sequences beginning with mouse clicks
+ ;; are read using the keymaps of the buffer clicked on, not
+ ;; the current buffer. So we may have to switch the buffer
+ ;; here.
+ ;; When we turn one event into two events, we must make sure
+ ;; that neither of the two looks like the original--so that,
+ ;; if we replay the events, they won't be expanded again.
+ ;; If not for this, such reexpansion could happen either here
+ ;; or when user programs play with this-command-keys. */
+
+ ;;
+ ;; /* Arrange to go back to the original buffer once we're
+ ;; done reading the key sequence. Note that we can't
+ ;; use save_excursion_{save,ore} here, because they
+ ;; save point as well as the current buffer; we don't
+ ;; want to save point, because redisplay may change it,
+ ;; to accommodate a Fset_window_start or something. We
+ ;; don't want to do this at the top of the function,
+ ;; because we may get input from a subprocess which
+ ;; wants to change the selected window and stuff (say,
+ ;; emacsclient). */
+ (when area
+ (setq command (key-binding (vconcat (list area event)) t))
+ (when (and obj (consp obj)
+ (setq tmp (ignore-errors (get-text-property (cdr obj)
'local-map (car obj))))
+ (setq tmp (or (and (symbolp tmp) (ergoemacs-sv tmp)) tmp))
+ (ergoemacs-keymapp tmp)
+ (setq tmp (lookup-key tmp (vconcat (list area event)))))
+ (setq command tmp)))
+ (unless command
+ (setq command original-command))
+ ;; (ergoemacs-command-loop--call-mouse-command command record-flag keys)
+
+ command)
+ ;; Make sure to lookup the keys in the selected buffer
+ (ergoemacs-command-loop--sync-point)
+ (let ((trials (ergoemacs-translate--trials key))
+ tmp tmp2 ret)
+ (setq this-command-keys-shift-translated nil)
+ (catch 'found-command
+ (dolist (cur-key trials)
+ (when cur-key
+ (let* ((orig-key cur-key)
+ (bind (key-binding orig-key t))
+ (meta-key (ergoemacs-translate--meta-to-escape cur-key))
+ (esc-key (ergoemacs-translate--escape-to-meta cur-key))
+ (new-key (or meta-key esc-key))
+ (new-binding (and new-key (key-binding new-key)))
+ (global (and new-key
+ (list (lookup-key ergoemacs-keymap orig-key t)
+ (lookup-key ergoemacs-keymap new-key t)))))
+ ;; Prefer non-global keys.
+ (when (eq bind 'undefined)
+ (setq bind nil))
+ (when (eq new-binding 'undefined)
+ (setq new-binding nil))
+ (cond
+ ((not new-key)
+ (setq new-key orig-key))
+ ((not (memq bind global))
+ (setq new-key orig-key))
+ ((and new-binding (not (memq new-binding global)))
+ (setq bind new-binding)))
+ (unless bind
+ (cond
+ ((or (ergoemacs-keymapp (setq tmp (lookup-key input-decode-map
orig-key)))
+ (and (not (integerp tmp)) (commandp tmp)))
+ (setq bind tmp))
+ ((or (ergoemacs-keymapp (setq tmp (lookup-key
local-function-key-map orig-key)))
+ (and (not (integerp tmp)) (commandp tmp)))
+ (setq bind tmp))
+ ((or (ergoemacs-keymapp (setq tmp (lookup-key
key-translation-map orig-key)))
+ (and (not (integerp tmp)) (commandp tmp)))
+ (setq bind tmp))))
+ (when (and orig-key
+ (setq ret bind
+ ret (if (and (eq ret 'ergoemacs-map-undefined)
+ (equal orig-key (nth 0 trials))
+ (nth 1 trials)) nil ret)))
+ (cond
+ ((equal orig-key (nth 0 trials))
+ (setq ergoemacs-command-loop--single-command-keys new-key)
+ ;; (message "History %s" (length
ergoemacs-command-loop--history))
+ (when (and (not (eq ergoemacs-handle-ctl-c-or-ctl-x
'only-C-c-and-C-x))
+ (ergoemacs-keymapp ret)
+ (setq tmp (lookup-key ret [ergoemacs-timeout])))
+ (cond
+ ((eq ergoemacs-handle-ctl-c-or-ctl-x 'only-copy-cut)
+ (setq ret tmp))
+ ((< 1 (length ergoemacs-command-loop--history)))
+ ((not (region-active-p))) ;; its a key sequence.
+
+ ((and (or ergoemacs-this-command-keys-shift-translated
this-command-keys-shift-translated)
+ (eq ergoemacs-handle-ctl-c-or-ctl-x 'both)))
+
+ ;; Immediate
+ ((and (not ergoemacs-ctl-c-or-ctl-x-delay)
+ (eq ergoemacs-handle-ctl-c-or-ctl-x 'both))
+ (setq ret tmp))
+
+ (t ;; with delay
+ (if ergoemacs-command-loop--decode-event-timeout-p
+ (setq tmp2 nil
+ ergoemacs-command-loop--decode-event-timeout-p
nil))
+ (setq tmp2 (with-timeout (ergoemacs-ctl-c-or-ctl-x-delay
nil)
+ (ergoemacs-command-loop--read-event nil key)))
+ (if (not tmp2)
+ (setq ret tmp) ;; timeout, use copy/cut
+ ;; Actual key
+ (setq ret (ergoemacs-command-loop--key-lookup (vconcat
key (vector tmp2))))))))
+ (ergoemacs-command-loop--message-binding new-key ret))
+ ((equal orig-key (nth 1 trials)) ;; `ergoemacs-mode' shift
translation
+ (setq this-command-keys-shift-translated t
+ ergoemacs-command-loop--single-command-keys (nth 0
trials))
+
+ ;; Shift+Control+c
+ (when (and (ergoemacs-keymapp ret)
+ (setq tmp (lookup-key ret [ergoemacs-timeout]))
+ (eq ergoemacs-handle-ctl-c-or-ctl-x 'both))
+ (setq ret tmp))
+ (ergoemacs-command-loop--message-binding new-key ret key))
+ (t
+ (ergoemacs-command-loop--message-binding new-key ret key)
+ (setq ergoemacs-command-loop--single-command-keys new-key)))
+ (throw 'found-command ret))))))
+ ret)))
+
+(defun ergoemacs-command-loop--execute-handle-shift-selection (function)
+ "Allow `ergoemacs-mode' command loop to handle shift selection.
+
+This will apply `handle-shift-selection' when FUNCTION is
+considered a shift-selection compatible function.
+
+This allows shift-selection of non-letter keys.
+For instance in QWERTY M-> is shift translated to M-."
+ (when (ergoemacs :movement-p function)
+ (handle-shift-selection)))
+
+(defun ergoemacs-command-loop--execute-rm-keyfreq (command)
+ "Remove COMMAND from `keyfreq-mode' counts."
+ (when (featurep 'keyfreq)
+ (when keyfreq-mode
+ (let (count)
+ (setq count (ergoemacs-gethash (cons major-mode command)
keyfreq-table))
+ (cond
+ ((not count))
+ ((= count 1)
+ (remhash (cons major-mode command) keyfreq-table))
+ (count
+ (puthash (cons major-mode command) (- count 1)
+ keyfreq-table)))
+ ;; Add local-fn to counter.
+ (setq count (ergoemacs-gethash (cons major-mode command)
keyfreq-table))
+ (puthash (cons major-mode command) (if count (+ count 1) 1)
+ keyfreq-table)))))
+
+;; (3) execute command
+(defun ergoemacs-command-loop--execute (command &optional keys)
+ "Execute COMMAND pretending that KEYS were pressed."
+ (unwind-protect
+ (let ((keys (or keys ergoemacs-command-loop--single-command-keys)))
+ ;; (ergoemacs-command-loop--spinner)
+ (cond
+ ((or (stringp command) (vectorp command))
+ ;; If the command is a keyboard macro (string/vector) then execute
+ ;; it by adding it to `unread-command-events'
+ (let ((tmp (prefix-numeric-value current-prefix-arg)))
+ (cond
+ ((<= tmp 0) ;; Unsure what to do here.
+ (ergoemacs-command-loop--message "The %s keyboard macro was not
run %s times" (ergoemacs-key-description (vconcat command)) tmp))
+ (t
+ (dotimes (_i tmp unread-command-events)
+ (setq unread-command-events
+ (append (listify-key-sequence command)
+ unread-command-events))))))
+ (setq ergoemacs-command-loop--single-command-keys nil))
+ (t
+ ;; This should be a regular command.
+
+ ;; Remove counting of `this-command' in `keyfreq-mode'
+ ;; Shouldn't be needed any more...
+ ;; (ergoemacs-command-loop--execute-rm-keyfreq this-command)
+
+ ;; This command execute should modify the following variables:
+ ;; - `last-repeatable-command'
+ ;; - `this-command'
+ ;; - `this-original-command'
+
+ ;; In addition, other minor modes may store the command, so these
+ ;; should be modified as well.
+
+ ;; These are stored in
`ergoemacs-command-loop--execute-modify-command-list'
+
+ (ergoemacs-command-loop--execute-modify-command-list command)
+
+ ;; Handle Shift Selection
+ (ergoemacs-command-loop--execute-handle-shift-selection this-command)
+ (when keys
+ (setq ergoemacs-command-loop--single-command-keys keys)
+
+ ;; Modify the output for these functions when `keys' is not nil.
+
+ ;; Assume this is a nonmenu event if it isn't a mouse event
+ (unless (consp last-command-event)
+ (setq last-nonmenu-event last-command-event)))
+ (unwind-protect
+ (progn
+ (setq ergoemacs-command-loop--running-pre-command-hook-p t)
+ (run-hooks 'pre-command-hook))
+ (setq ergoemacs-command-loop--running-pre-command-hook-p nil))
+ (unwind-protect
+ (ergoemacs-command-loop--call-interactively this-command t)
+ (setq ergoemacs-command-loop--single-command-keys nil)))))
+ ;; (ergoemacs-command-loop--spinner-end)
+ ))
+(defun ergoemacs-command-loop--shift-timeout ()
+ "This is the shift-timeout function for a key."
+ (interactive)
+ (let ((shift-trans (ergoemacs-translate--emacs-shift
(this-single-command-keys))))
+ (if (eq ergoemacs-handle-ctl-c-or-ctl-x 'only-copy-cut)
+ (setq unread-command-events (append (ergoemacs-translate--emacs-shift
shift-trans) '(ergoemacs-timeout)))
+ (setq ergoemacs-this-command-keys-shift-translated t)
+ (ergoemacs-command-loop--internal shift-trans))))
+
+(defun ergoemacs-command-loop--shift-translate ()
+ "Shift translation."
+ (interactive)
+ (let ((shift-trans (ergoemacs-translate--emacs-shift
(this-single-command-keys) 'ergoemacs-shift)))
+ (message "%s->%s" (key-description (this-single-command-keys))
+ (key-description shift-trans))
+ (setq ergoemacs-this-command-keys-shift-translated t
+ this-command-keys-shift-translated t)
+ (ergoemacs-command-loop--call-interactively (key-binding shift-trans))))
(provide 'ergoemacs-command-loop)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ergoemacs-command-loop.el ends here
diff --git a/ergoemacs-macros.el b/ergoemacs-macros.el
index 5cec912..69c8cea 100644
--- a/ergoemacs-macros.el
+++ b/ergoemacs-macros.el
@@ -316,6 +316,40 @@ When arg1 can be a property. The following properties are
supported:
((fboundp #'buffer-narrowed-p) `(buffer-narrowed-p))
(t `(/= (- (point-max) (point-min)) (buffer-size)))))
+;;;###autoload
+(defmacro ergoemacs-translation (&rest body-and-plist)
+ "Defines an `ergoemacs-mode' translation.
+:text -- Text to display while completing this translation
+:keymap -- Local Keymap for translation
+:keymap-modal -- Modal keymap for overrides.
+:modal-always -- If the modal state is always on, regardless of
+ the values of `ergoemacs-modal-ignored-buffers',
+ `ergoemacs-modal-emacs-state-modes' `minibufferp'
+The following arguments allow the keyboard presses to be translated:
+ - :meta
+ - :control
+ - :shift
+ - :meta-control
+ - :meta-shift
+ - :control-shift
+ - :meta-control-shift
+ - :unchorded (no modifiers)
+This also creates functions:
+- ergoemacs-translate--NAME-universal-argument
+- ergoemacs-translate--NAME-digit-argument
+- ergoemacs-translate--NAME-negative-argument
+- ergoemacs-translate--NAME-modal"
+ (declare (doc-string 2)
+ (indent 2))
+ (let ((kb (make-symbol "kb")))
+ (setq kb (ergoemacs-theme-component--parse-keys-and-body body-and-plist))
+
+ `(progn (puthash ,(intern (concat ":" (plist-get (nth 0 kb) ':name)))
+ (lambda() ,(plist-get (nth 0 kb) ':description)
+ (ergoemacs-translate--create :key ,(intern (concat ":"
(plist-get (nth 0 kb) ':name)))
+ ,@(nth 0 kb)))
ergoemacs-translation-hash))))
+
+
(provide 'ergoemacs-macros)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ergoemacs-macros.el ends here
diff --git a/ergoemacs-mode.el b/ergoemacs-mode.el
index aa65846..d736b17 100644
--- a/ergoemacs-mode.el
+++ b/ergoemacs-mode.el
@@ -299,6 +299,12 @@ The `execute-extended-command' is now
\\[execute-extended-command].
(ergoemacs-setup-override-keymap))
(t (ergoemacs-setup-override-keymap)))
(setq ergoemacs-require--ini-p t)
+ (define-key key-translation-map (kbd "<apps>") (kbd "<menu>"))
+ (global-unset-key (kbd "<apps>"))
+ (global-unset-key (kbd "<menu>"))
+ (define-key ergoemacs-translate--parent-map (if (eq system-type
'windows-nt) [apps] [menu])
+ 'ergoemacs-command-loop--swap-translation)
+
(if refresh-p
(message "Ergoemacs-mode keys refreshed (%s)"
ergoemacs-keyboard-layout)
diff --git a/ergoemacs-themes.el b/ergoemacs-themes.el
index 635fd6e..1431ad3 100644
--- a/ergoemacs-themes.el
+++ b/ergoemacs-themes.el
@@ -1301,6 +1301,34 @@ keys (e.g. M-O A == <up>) or regular M-O keybinding."
(ergoemacs-set-menu-bar-search)
(ergoemacs-set-menu-bar-edit)
(ergoemacs-set-menu-bar-file)
+ (ergoemacs-define-key ergoemacs-override-keymap
+ (kbd "<menu> f")
+ (lambda ()
+ (interactive)
+ (ergoemacs-command-loop "C-x" :ctl-to-alt)))
+
+ (ergoemacs-define-key ergoemacs-override-keymap
+ (kbd "<menu> d")
+ (lambda ()
+ (interactive)
+ (ergoemacs-command-loop "C-c" :unchorded-ctl)))
+
+ (ergoemacs-define-key ergoemacs-override-keymap (kbd "<menu> n a")
'org-agenda)
+ (ergoemacs-define-key ergoemacs-override-keymap (kbd "<menu> n A")
'org-capture)
+ (ergoemacs-define-key ergoemacs-override-keymap (kbd "<menu> n C-a")
'org-capture)
+ (ergoemacs-define-key ergoemacs-override-keymap (kbd "<menu> n c")
'calc)
+ (ergoemacs-define-key ergoemacs-override-keymap (kbd "<menu> n d")
'dired-jump)
+ (ergoemacs-define-key ergoemacs-override-keymap (kbd "<menu> n e")
'eshell)
+ (ergoemacs-define-key ergoemacs-override-keymap (kbd "<menu> n p")
'powershell)
+ (ergoemacs-define-key ergoemacs-override-keymap (kbd "<menu> n f")
'ergoemacs-open-in-desktop)
+ (ergoemacs-define-key ergoemacs-override-keymap (kbd "<menu> n g")
'grep)
+ (ergoemacs-define-key ergoemacs-override-keymap (kbd "<menu> n m")
'magit-status)
+ (ergoemacs-define-key ergoemacs-override-keymap (kbd "<menu> n o")
'ergoemacs-open-in-external-app)
+ (ergoemacs-define-key ergoemacs-override-keymap (kbd "<menu> n r") 'R)
+ (ergoemacs-define-key ergoemacs-override-keymap (kbd "<menu> n s")
'shell)
+ (ergoemacs-define-key ergoemacs-override-keymap (kbd "<menu> n t")
'org-capture)
+ (ergoemacs-define-key ergoemacs-override-keymap (kbd "<menu> n C-t")
'org-agenda)
+ (ergoemacs-define-key ergoemacs-override-keymap (kbd "<menu> n T")
'org-agenda)
)
(defun ergoemacs-install-standard-theme ()
@@ -1385,4 +1413,82 @@ keys (e.g. M-O A == <up>) or regular M-O keybinding."
)
(add-hook 'calc-load-hook #'ergoemacs-install-calc-bindings)
+
+(ergoemacs-translation normal ()
+ "Identify transformation"
+ :keymap (let ((map (make-sparse-keymap)))
+ (define-key map [f1] 'ergoemacs-read-key-help)
+ (define-key map (read-kbd-macro "C-h") 'ergoemacs-read-key-help)
+ map))
+
+(ergoemacs-translation ctl-to-alt ()
+ "Ctl <-> Alt translation"
+ :text (lambda() (format "<Ctl%sAlt> " (ergoemacs :unicode-or-alt "↔" " to
")))
+
+ :meta '(control)
+ :control '(meta)
+
+ :meta-shift '(control shift)
+ :control-shift '(meta shift)
+
+ :control-hyper '(meta hyper)
+ :meta-hyper '(control hyper)
+
+ :control-super '(meta super)
+ :meta-super '(control super)
+
+ :meta-shift-hyper '(control shift hyper)
+ :control-shift-hyper '(meta shift hyper)
+
+ :meta-shift-super '(control shift super)
+ :control-shift-super '(meta shift super)
+
+ :meta-super-hyper '(control super hyper)
+ :control-super-hyper '(meta super hyper)
+
+ :meta-super-hyper-shift '(control super hyper shift)
+ :control-super-hyper-shift '(meta super hyper shift)
+
+ :modal-color "blue"
+ :modal-always t
+
+ :keymap (let ((map (make-sparse-keymap)))
+ (define-key map [f1] 'ergoemacs-read-key-help)
+ (define-key map (read-kbd-macro "M-h") 'ergoemacs-read-key-help)
+ (define-key map (if (eq system-type 'windows-nt) [M-apps]
[M-menu]) 'ergoemacs-read-key-force-next-key-is-quoted)
+ (define-key map (read-kbd-macro "SPC")
'ergoemacs-read-key-force-next-key-is-ctl)
+ (define-key map (read-kbd-macro "M-SPC")
'ergoemacs-read-key-force-next-key-is-alt)
+ ;; (define-key map "G" 'ergoemacs-read-key-next-key-is-quoted)
+ ;; (define-key map "g" 'ergoemacs-read-key-next-key-is-alt)
+ map))
+
+(ergoemacs-translation unchorded-ctl ()
+ "Make the Ctl key sticky."
+ :text "<Ctl+>"
+ :unchorded '(control)
+ :shift '(control shift)
+ :meta '()
+ :control '(meta)
+ :keymap (let ((map (make-sparse-keymap)))
+ (define-key map [f1] 'ergoemacs-read-key-help)
+ (define-key map (read-kbd-macro "SPC")
'ergoemacs-read-key-force-next-key-is-quoted)
+ (define-key map (read-kbd-macro "M-SPC")
'ergoemacs-read-key-force-next-key-is-alt-ctl)
+ (define-key map "g" 'ergoemacs-read-key-force-next-key-is-alt)
+ (define-key map "G" 'ergoemacs-read-key-force-next-key-is-alt-ctl)
+ map))
+
+(ergoemacs-translation unchorded-alt ()
+ "Make the Alt key sticky."
+ :text "<Alt+>"
+ :unchorded '(meta)
+ :shift '(meta shift)
+ :meta '(meta shift)
+ :modal-color "red"
+ :keymap-modal (let ((map (make-sparse-keymap)))
+ (define-key map (read-kbd-macro "<return>")
'ergoemacs-unchorded-alt-modal)
+ (define-key map (read-kbd-macro "RET")
'ergoemacs-unchorded-alt-modal)
+ map))
+
+
+
(provide 'ergoemacs-themes)
diff --git a/ergoemacs-translate.el b/ergoemacs-translate.el
index e4503a3..0770c0a 100644
--- a/ergoemacs-translate.el
+++ b/ergoemacs-translate.el
@@ -1,6 +1,6 @@
;;; ergoemacs-translate.el --- Keyboard translation functions -*-
lexical-binding: t -*-
-;; Copyright © 2013-2014 Free Software Foundation, Inc.
+;; Copyright © 2013-2021 Free Software Foundation, Inc.
;; Filename: ergoemacs-translate.el
;; Description:
@@ -62,10 +62,12 @@
(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")
@@ -83,6 +85,10 @@
(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))
@@ -191,6 +197,30 @@ KEY-SEQ must be a vector or string. If there is no need
to change the sequence,
(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.
@@ -202,6 +232,43 @@ If no changes are performed, return nil."
(setq ret new-key))
ret)))
+(defun ergoemacs-translate--ergoemacs-shift-select (key)
+ "Translate KEY to allow `ergoemacs-mode' shift translation.
+
+This will shift translate Alt+# to Alt+3."
+ (let (modifiers basic)
+ (when (and (vectorp key)
+ ;; only makes sense for single key combinations.
+ (= (length key) 1)
+ ;; Doesn't make sense if shifted...
+ (not (or (memq 'shift (setq modifiers
(ergoemacs-translate--event-modifiers (aref key 0))))
+ (memq 'ergoemacs-shift modifiers)))
+ ;; Only define if emacs doesn't handle shift selection.
+ (not (eq (event-convert-list (list 'shift (setq basic
(event-basic-type (aref key 0)))))
+ (ergoemacs-translate--event-convert-list (list
'ergoemacs-shift basic)))))
+ (setq ergoemacs-translate--define-key-if-defined-p nil
+ ergoemacs-translate--define-key-replacement-function
'ergoemacs-command-loop--shift-translate)
+ (vector (ergoemacs-translate--event-convert-list (append modifiers (list
'ergoemacs-shift basic)))))))
+
+(defun ergoemacs-translate--ergoemacs-timeout (key)
+ "Translates KEY to allow Shift translation to default to key sequence.
+
+This is done for key sequences like Ctrl+Shift+c which should
+allow the Ctrl+c key sequence to be called when text is
+seleceted (instead of copying the text)."
+ (let (modifiers basic)
+ (when (and (vectorp key)
+ ;; only makes sense for single key combinations.
+ (= (length key) 2)
+ (eq 'ergoemacs-timeout (aref key 1))
+ ;; Doesn't make sense if shifted...
+ (not (or (memq 'shift (setq modifiers
(ergoemacs-translate--event-modifiers (aref key 0))))
+ (memq 'ergoemacs-shift modifiers))))
+ (setq basic (ergoemacs-translate--event-basic-type (aref key 0))
+ ergoemacs-translate--define-key-if-defined-p nil
+ ergoemacs-translate--define-key-replacement-function
'ergoemacs-command-loop--shift-timeout)
+ (vector (ergoemacs-translate--event-convert-list (append modifiers (list
'shift basic)))))))
+
(defun ergoemacs-translate--to-string (key)
"Translates KEY to string format.
@@ -217,9 +284,12 @@ If no chanegs are performed, return nil."
(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
- )
+ ergoemacs-translate--ergoemacs-timeout
+ ergoemacs-translate--ergoemacs-shift-select)
"Functions to apply to key.
These functions take a key as an argument and translate it in
@@ -343,6 +413,11 @@ MODIFIERS is the precalculated modifiers from
new-modifiers
new-event
(translation-hash (ergoemacs-translate--get-hash layout-to
layout-from)))
+ (cond
+ ((and (eq system-type 'windows-nt) (eq basic 'menu))
+ (setq basic 'apps))
+ ((and (not (eq system-type 'windows-nt)) (eq basic 'apps))
+ (setq basic 'menu)))
(if (memq 'ergoemacs-control modifiers)
(setq new-event basic
new-modifiers modifiers)
@@ -489,6 +564,10 @@ make the translation."
(not just-first-p))
(setq translated-event
(ergoemacs-translate--event-layout event layout-to layout-from
basic modifiers)))
+ ((and (eq system-type 'windows-nt) (eq basic 'menu))
+ (setq translated-event (ergoemacs-translate--event-convert-list
(append modifiers '(apps)))))
+ ((and (not (eq system-type 'windows-nt)) (eq basic 'apps))
+ (setq translated-event (ergoemacs-translate--event-convert-list
(append modifiers '(menu)))))
(t (setq translated-event event)))
(setq untranslated (vconcat untranslated (list event))
ret (vconcat ret (list translated-event))))
@@ -626,6 +705,7 @@ For keys, the list consists of:
(universal-argument nil)
(negative-argument nil)
(digit-argument nil)
+ (modal nil)
(text "")
(keymap (make-sparse-keymap))
(keymap-modal (make-sparse-keymap))
@@ -634,6 +714,62 @@ For keys, the list consists of:
(key nil)
(unchorded nil))
+(defvar ergoemacs-translate--setup-command-loop-regexp
+
"^\\(?:ergoemacs\\(?:-translate-\\)?\\)-\\(.*?\\)-\\(universal-argument\\|negative-argument\\|digit-argument\\|modal\\)$"
+ "Command loop command match/setup regular expression.")
+
+(defun ergoemacs-translate--setup-command-loop ()
+ "Setup command loop.
+To do anything, `this-command' must match
+`ergoemacs-translate--setup-command-loop-regexp'. The first
+match is the NAME of the translation, the second match is the
+TYPE of command. This command will then
+call (ergoemacs-command-loop-TYPE :NAME)."
+ (interactive)
+ (let ((command-str (symbol-name this-command))
+ name type)
+ (save-match-data
+ (when (string-match ergoemacs-translate--setup-command-loop-regexp
command-str)
+ (setq name (match-string 1 command-str)
+ type (match-string 2 command-str))
+ (funcall (intern (concat "ergoemacs-command-loop--" type)) (intern
(concat ":" name)))))))
+
+(defun ergoemacs-translate--setup-translation (&optional name)
+ "Setup translation functions and keymaps.
+If NAME is nil, setup all translations.
+When NAME is a symbol, setup the translation function for the symbol."
+ (if (not name)
+ (maphash
+ (lambda(name _item)
+ (ergoemacs-translate--setup-translation name))
+ ergoemacs-translation-hash)
+ (let ((name-str (and (symbolp name) (substring (symbol-name name) 1))))
+ (eval
+ (macroexpand ; Fixme why?
+ `(progn
+ (defvar ,(intern (concat "ergoemacs-translate--" name-str "-map"))
(make-sparse-keymap)
+ ,(concat "Ergoemacs local map for translation :"
+ name-str
+ " while completing a key sequence."))
+ (define-obsolete-variable-alias ',(intern (concat "ergoemacs-"
name-str "-translation-local-map"))
+ ',(intern (concat "ergoemacs-translate--" name-str "-map"))
+ "Ergoemacs-v5.16")))
+ t)
+ (ergoemacs-map-properties--label-map (intern (concat
"ergoemacs-translate--" name-str "-map")) t)
+ (ergoemacs (symbol-value (intern (concat "ergoemacs-translate--"
name-str "-map"))) :only-local-modifications-p t)
+ ;;
+ (dolist (type '("-universal-argument" "-negative-argument"
+ "-digit-argument" "-modal"))
+ (fset (intern (concat "ergoemacs-translate--" name-str type))
+ 'ergoemacs-translate--setup-command-loop)
+ (fset (intern (concat "ergoemacs-" name-str type))
+ 'ergoemacs-translate--setup-command-loop)
+ (when (string= type "-universal-argument")
+ (cl-pushnew (intern (concat "ergoemacs-" name-str type))
ergoemacs-command-loop--universal-functions)
+ (cl-pushnew (intern (concat "ergoemacs-translate--" name-str type))
ergoemacs-command-loop--universal-functions))))))
+
+(add-hook 'ergoemacs-mode-intialize-hook
#'ergoemacs-translate--setup-translation)
+
(defun ergoemacs-translate--create (&rest plist)
"Create a translation from PLIST and return translation object."
(let ((plist plist)
@@ -641,6 +777,7 @@ For keys, the list consists of:
-universal-argument
-negative-argument
-digit-argument
+ -modal
translation
(local-keymap (or (plist-get plist :keymap) (make-sparse-keymap)))
(trans-keymap (intern (concat "ergoemacs-translate--" (plist-get plist
:name) "-map"))))
@@ -686,6 +823,7 @@ For keys, the list consists of:
:universal-argument -universal-argument
:negative-argument -negative-argument
:digit-argument -digit-argument
+ :modal -modal
:text (plist-get plist :text)
:keymap local-keymap
:keymap-modal (or (plist-get plist :keymap-modal)
(make-sparse-keymap))
@@ -720,7 +858,8 @@ If TYPE is unspecified, assume :normal translation"
((eq 'ergoemacs-shift e) 'shift)
((eq 'ergoemacs-control e) 'control)
(t e)))
- e-mod) #'string<))
+ e-mod)
+ #'string<))
(special-p (memq basic (list ?m ?i ?\[)))
(ambiguous-p (and special-p (memq 'control e-mod)))
tmp
@@ -746,7 +885,8 @@ If TYPE is unspecified, assume :normal translation"
((and special-p (display-graphic-p)
(memq 'control modifiers))
(push 'ergoemacs-gui modifiers)))
- (throw 'found-mod t))) nil)
+ (throw 'found-mod t)))
+ nil)
(if ambiguous-p
(setq ret (ergoemacs-translate--event-convert-list `(control
,@modifiers ,basic)))
(setq ret (ergoemacs-translate--event-convert-list `(,@modifiers
,basic)))))
@@ -754,23 +894,18 @@ If TYPE is unspecified, assume :normal translation"
(defun ergoemacs-translate--no-gui (event)
"Remove any gui elements to the EVENT.
-If there are no gui elements, retun nil."
+If there are no gui elements, return nil."
(if (vectorp event)
- (eval `(vector ,@(mapcar (lambda(x) (let ((ret (or
(ergoemacs-translate--no-gui x) x)))
- (if (symbolp ret)
- `(quote ,ret)
- ret))) event)))
+ (apply #'vector (mapcar (lambda(x) (or (ergoemacs-translate--no-gui x)
x)) event))
(let* ((last-event event)
(last-mod (ergoemacs-translate--event-modifiers last-event))
(last-basic-event (ergoemacs-translate--event-basic-type last-event))
- new-mod
- new-event)
+ new-mod)
(when (memq 'ergoemacs-gui last-mod)
(dolist (elt last-mod)
(unless (eq elt 'ergoemacs-gui)
(push elt new-mod)))
- (setq new-event (ergoemacs-translate--event-convert-list `(,@new-mod
,last-basic-event))))
- new-event)))
+ (ergoemacs-translate--event-convert-list `(,@new-mod
,last-basic-event))))))
(defvar ergoemacs-translate--parent-map nil
"Parent map for keymaps when completing a key sequence.")
@@ -810,16 +945,25 @@ If there are no gui elements, retun nil."
;; (add-hook 'ergoemacs-mode-intialize-hook
#'ergoemacs-translate--keymap-reset)
(defun ergoemacs-translate--keymap (&optional translation)
- "Get the keymap for TRANSLATION."
- (let* ((translation (or (and (ergoemacs-translation-struct-p translation)
+ "Get the keymap for TRANSLATION.
+This takes into consideration the modal state of `ergoemacs-mode'."
+ (let* ((modal (ergoemacs :modal-p))
+ (translation (or (and (ergoemacs-translation-struct-p translation)
+ (or (not modal) ;; prefer modal when :normal
+ (not (eq :normal
(ergoemacs-translation-struct-key translation))))
translation)
+ modal
(ergoemacs-translate--get (or translation :normal))))
- (key (ergoemacs-translation-struct-key translation))
+ (key (or (and modal (intern (concat ":"
(ergoemacs-translation-struct-name translation) "-modal")))
+ (ergoemacs-translation-struct-key translation)))
(ret (ergoemacs-gethash key ergoemacs-translate--keymap-hash))
keymap)
(unless ret
- (setq keymap (ergoemacs-translation-struct-keymap translation)
- ret (make-composed-keymap (ergoemacs keymap) (ergoemacs
ergoemacs-translate--parent-map)))
+ (if modal
+ (setq keymap (ergoemacs-translation-struct-keymap-modal translation)
+ ret keymap)
+ (setq keymap (ergoemacs-translation-struct-keymap translation)
+ ret (make-composed-keymap (ergoemacs keymap) (ergoemacs
ergoemacs-translate--parent-map))))
(puthash key ret ergoemacs-translate--keymap-hash))
ret))
@@ -984,13 +1128,15 @@ If there are no gui elements, retun nil."
(setq ret (format "%s\n%s=%s" ret f (ergoemacs-translate--ahk-code
key))))))
ret))
-(defun ergoemacs-translate--ahk-ini (&optional all-layouts)
+(defun ergoemacs-translate--ahk-ini (&optional all-layouts all-themes)
"Creates the ini file used with the autohotkey script."
(let ((layouts (or (and all-layouts (sort (ergoemacs-layouts--list)
'string<))
(and (eq (ergoemacs :layout) 'ergoemacs-layout-us) (list
"us"))
(list "us" ergoemacs-keyboard-layout)))
- (themes (list "standard"))
+ (themes (or (and all-themes (sort (ergoemacs-theme--list) 'string<))
+ (list ergoemacs-theme)))
(original-layout ergoemacs-keyboard-layout)
+ (original-theme ergoemacs-theme)
ret)
(unwind-protect
(setq ret (with-temp-buffer
@@ -1004,13 +1150,15 @@ If there are no gui elements, retun nil."
(dolist (lay layouts)
(dolist (theme themes)
(message "Getting information from %s-%s" lay theme)
- (setq ergoemacs-keyboard-layout lay)
+ (setq ergoemacs-keyboard-layout lay
+ ergoemacs-theme theme)
(ergoemacs-mode-reset)
(insert "[" lay "-" theme "]"
(ergoemacs-translate--ahk-functions-ini)
"\n")))
(buffer-string)))
- (setq ergoemacs-keyboard-layout original-layout)
+ (setq ergoemacs-keyboard-layout original-layout
+ ergoemacs-theme original-theme)
(ergoemacs-mode-reset))
ret))
@@ -1067,14 +1215,23 @@ If :type is :quail use the 180 length string that
((string-match "[a-zA-Z0-9]" char)
char)
(t
- ;; Insert fancy characters as is and hope that the font
- ;; will work.
(setq ret (format "&#x%04X;"
(encode-char
(with-temp-buffer
(insert char)
(char-before)) 'unicode))
- )
+ font (ergoemacs-key-description--display-char-p char))
+ (when font
+ (setq font (or (font-get font :name)
+ (font-get font :family)))
+ (when (and font (symbolp font))
+ (setq font (symbol-name font)))
+ (setq default-font (or (font-get default-font :name)
+ (font-get default-font :family)))
+ (when (and default-font (symbolp default-font))
+ (setq default-font (symbol-name default-font)))
+ (unless (string= font default-font)
+ (setq ret (format "<text style=\"font-family:
'%s'\">%s</text>" font ret))))
ret)))
(while (< i (length char))
(setq ret (concat ret (ergoemacs-translate--svg-quote (substring char
i (+ i 1))))
