branch: externals/ergoemacs-mode
commit 9be4392fd4d494cd7a12f9b26053647c36c766d7
Author: Walter Landry <wlan...@caltech.edu>
Commit: Walter Landry <wlan...@caltech.edu>
Remove lots of command-loop stuff
---
ergoemacs-command-loop.el | 672 ----------------------------------------------
1 file changed, 672 deletions(-)
diff --git a/ergoemacs-command-loop.el b/ergoemacs-command-loop.el
index 8842b09..68cdaf3 100644
--- a/ergoemacs-command-loop.el
+++ b/ergoemacs-command-loop.el
@@ -123,12 +123,6 @@
(defvar ergoemacs-command-loop--help-last-key nil)
-(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.")
@@ -240,35 +234,6 @@ This is called through `ergoemacs-command-loop'"
(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: :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: :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))
@@ -416,18 +381,6 @@ UNIVERSAL"
"")
(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."
(let (tmp)
@@ -540,118 +493,6 @@ 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 (progn
- (setq ergoemacs-command-loop--decode-event-timeout-p
t)
- nil))
- (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.
@@ -692,218 +533,6 @@ KEYS is the keys information"
(defvar ergoemacs-command--timeout-timer nil)
(defvar ergoemacs-command--timeout-keys nil)
-(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))
- (keys nil)
- (blink-on nil)
- input
- raw-input
- mod-keys tmp
- reset-key-p
- double)
-
- (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)))
- (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.
- (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.
@@ -997,8 +626,6 @@ from within the ergoemacs-mode command loop."
(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'.")
@@ -1047,69 +674,6 @@ Fix this issue."
(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.
@@ -1523,242 +1087,6 @@ 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 ret)
- (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)
- (ergoemacs-command-loop--message-binding new-key ret))
- (t
- (ergoemacs-command-loop--message-binding new-key ret key)
- (setq ergoemacs-command-loop--single-command-keys new-key)))
- (throw 'found-command ret))))))
- ret)))
-
-;; (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.
-
- ;; 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)
-
- (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)
- ))
-
(provide 'ergoemacs-command-loop)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ergoemacs-command-loop.el ends here
