[elpa] externals/ergoemacs-mode fa095e8 295/325: Use Kim Storms approach for cua binding

[Stefan Monnier]

branch: externals/ergoemacs-mode
commit fa095e8d763bddd40179217aa3c128fa7de55cac
Author: Matthew Fidler <514778+mattfidler@users.noreply.github.com>
Commit: Matthew Fidler <514778+mattfidler@users.noreply.github.com>

    Use Kim Storms approach for cua binding
---
 ergoemacs-calculate-bindings.el |   2 +-
 ergoemacs-cua.el                | 287 ++++++++++++++++++++++++++++++++++++++++
 ergoemacs-mode.el               |  19 ++-
 ergoemacs-themes.el             |   2 +
 4 files changed, 306 insertions(+), 4 deletions(-)

diff --git a/ergoemacs-calculate-bindings.el b/ergoemacs-calculate-bindings.el
index f09b8e7..4202453 100644
--- a/ergoemacs-calculate-bindings.el
+++ b/ergoemacs-calculate-bindings.el
@@ -2,7 +2,7 @@
 
 ;; Copyright © 2013-2021  Free Software Foundation, Inc.
 
-;; Filename: ergoemacs-translate.el
+;; Filename: ergoemacs-calculate-bindings.el
 ;; Description:
 ;; Author: Matthew L. Fidler
 ;; Maintainer:
diff --git a/ergoemacs-cua.el b/ergoemacs-cua.el
new file mode 100644
index 0000000..79da893
--- /dev/null
+++ b/ergoemacs-cua.el
@@ -0,0 +1,287 @@
+;;; ergoemacs-cua.el --- Keyboard keybinding translation -*- lexical-binding: 
t -*-
+
+;; Copyright © 2013-2021  Free Software Foundation, Inc.
+
+;; Filename: ergoemacs-cua.el
+;; Description:
+;; Author: Matthew L. Fidler
+;; Maintainer:
+;; Created: Sat Sep 28 20:08:09 2013 (-0500)
+;; Version:
+;; Last-Updated:
+;;           By:
+;;     Update #: 0
+;; URL:
+;; Doc URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;;   None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change Log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 3, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+;; Adapted from 
https://github.com/emacs-mirror/emacs/blob/3ae275eedc1c8d2a61a4a549c39c88bb08fd8ff2/lisp/emulation/cua-base.el#L623
+
+
+(defvar ergoemacs--prefix-override-timer nil
+  "Override timer for cua-style keys.")
+
+(defvar ergoemacs--prefix-override-length nil
+  "The last saved key prefix override length.")
+
+(defvar ergoemacs--prefix-override-keymap
+  (let ((map (make-sparse-keymap)))
+    (define-key map [(control x)] 'ergoemacs--prefix-override-handler)
+    (define-key map [(control c)] 'ergoemacs--prefix-override-handler)
+    map)
+  "Prefix override keymap.")
+
+(defvar ergoemacs--ena-prefix-repeat-keymap nil
+  "Variable that states that `ergoemacs-mode' is in the repeat phase, 
immediately after using the prefix key.")
+
+(defvar ergoemacs--prefix-repeat-keymap
+  (let ((map (make-sparse-keymap)))
+    (define-key map [(control x) (control x)] 
'ergoemacs--prefix-repeat-handler)
+    (define-key map [(control c) (control c)] 
'ergoemacs--prefix-repeat-handler)
+    (dolist (key '(up down left right home end next prior))
+      (define-key map (vector '(control x) key) 'ergoemacs--prefix-cut-handler)
+      (define-key map (vector '(control c) key) 
'ergoemacs--prefix-copy-handler)))
+  "Prefix repeat keymap.")
+
+
+(defcustom ergoemacs-prefix-override-inhibit-delay 0.2
+  "If non-nil, time in seconds to delay before overriding prefix key.
+If there is additional input within this time, the prefix key is
+used as a normal prefix key.  So typing a key sequence quickly will
+inhibit overriding the prefix key.
+As a special case, if the prefix key is repeated within this time, the
+first prefix key is discarded, so typing a prefix key twice in quick
+succession will also inhibit overriding the prefix key.
+If the value is nil, use a shifted prefix key to inhibit the override."
+  :type '(choice (number :tag "Inhibit delay")
+                        (const :tag "No delay" nil))
+  :group 'ergoemacs)
+
+(defcustom ergoemacs-enable-cua-keys t
+  "Enable C-x and C-v for cut and copy.
+If the value is t, these mappings are always enabled.  If the value is
+`shift', these keys are only enabled if the last region was marked with
+a shifted movement key.  If the value is nil, these keys are never
+enabled."
+  :type '(choice (const :tag "Disabled" nil)
+                        (const :tag "Shift region only" shift)
+                        (other :tag "Enabled" t))
+  :group 'cua)
+
+(defvar ergoemacs--ena-region-keymap nil
+  "Variable that tells the `ergoemacs-mode' if the region is selected.
+
+This is also used to select the region keymaps.")
+
+(defvar ergoemacs--ena-prefix-override-keymap nil
+  "Variable that tels the `ergoemacs-mode' of the overide step is active.
+
+This override is enabled for active regions before the copy and paste are 
enabled.")
+
+
+
+(defvar ergoemacs-inhibit-cua-keys nil
+  "Buffer-local variable that may disable the CUA keymappings.")
+(make-variable-buffer-local 'ergoemacs-inhibit-cua-keys)
+
+(defun ergoemacs--select-keymaps ()
+  "Setup conditions for selecting the proper keymaps in 
`ergoemacs--keymap-alist'."
+  ;; The prefix override (when mark-active) operates in three substates:
+  ;; [1] Before using a prefix key
+  ;; [2] Immediately after using a prefix key
+  ;; [3] A fraction of a second later
+  (setq ergoemacs--ena-region-keymap ; Determines if the ergion is active
+        (and (region-active-p) (not deactivate-mark))
+        ;; Enable Override -- This is the first state where the keys are 
intercepted; cua state [1]
+        ergoemacs--ena-prefix-override-keymap
+        (and ergoemacs--ena-region-keymap
+             ergoemacs-enable-cua-keys
+                (not ergoemacs-inhibit-cua-keys)
+                (or (eq ergoemacs-enable-cua-keys t)
+                        (region-active-p))
+                (not executing-kbd-macro)
+                (not ergoemacs--prefix-override-timer))
+        ;; Enable The repeat layer.  This is the layer that the keys are 
intercepted; cua state [2]
+        ergoemacs--ena-prefix-repeat-keymap
+        (and ergoemacs--ena-region-keymap
+                (or (timerp ergoemacs--prefix-override-timer)
+                        (eq ergoemacs--prefix-override-timer 'shift))))
+  ;; In ergoemacs-mode the corresponding `cua--ena-cua-keys-keymap' and 
`cua--ena-global-mark-keymap' are not needed or used
+  (message "r: %s po: %s pr: %s")
+  )
+
+(defun ergoemacs--prefix-override-timeout ()
+  "This is whap happens on the `ergoemacs-mode' timeout for C-c and C-v are 
supplied."
+  (setq ergoemacs--prefix-override-timer t)
+  (when (= (length (this-command-keys)) ergoemacs--prefix-override-length)
+    (setq unread-command-events (cons 'ergoemacs-timeout 
unread-command-events))
+    (if prefix-arg
+        nil
+      ;; FIXME: Why?
+      (setq overriding-terminal-local-map nil))
+    (ergoemacs--select-keymaps)))
+
+(defun ergoemacs--prefix-override-replay (repeat)
+  "This replays the events from the intial key press.
+
+REPEAT is the flag that tells it if is repeated environmennt."
+  (let* ((keys (this-command-keys))
+            (i (length keys))
+            (key (aref keys (1- i))))
+    (setq ergoemacs--prefix-override-length (- i repeat))
+    (setq ergoemacs--prefix-override-timer
+             (or
+              ;; In state [2], change to state [3]
+              (> repeat 0)
+              ;; In state [1], change directly to state [3]
+              (input-pending-p)
+              ;; In state [1], [T] disabled, so change to state [3]
+              (not (numberp ergoemacs-prefix-override-inhibit-delay))
+              (<= ergoemacs-prefix-override-inhibit-delay 0)
+              ;; In state [1], start [T] and change to state [2]
+              (run-with-timer ergoemacs-prefix-override-inhibit-delay nil
+                                      #'ergoemacs--prefix-override-timeout)))
+    ;; Don't record this command
+    (setq this-command last-command)
+    ;; Restore the prefix arg
+    ;; This should make it so that exchange-point-and-mark gets the prefix when
+    ;; you do C-u C-x C-x C-x work (where the C-u is properly passed to the C-x
+    ;; C-x binding after the first C-x C-x was rewritten to just C-x).
+    (prefix-command-preserve-state)
+    ;; Push the key back on the event queue
+    (setq unread-command-events (cons (cons 'no-record key)
+                                      unread-command-events))))
+
+
+(defun ergoemacs--prefix-override-handler ()
+  "Start timer waiting for prefix key to be followed by another key.
+Repeating prefix key when region is active works as a single prefix key."
+  (interactive)
+  (ergoemacs--prefix-override-replay 0))
+
+(defun cua--prefix-repeat-handler ()
+  "Repeating prefix key when region is active works as a single prefix key."
+  (interactive)
+  (ergoemacs--prefix-override-replay 1))
+
+(defun ergoemacs--prefix-copy-handler (arg)
+  "Copy region, then replay last key.
+
+This uses `ergoemacs-copy-line-or-region' (unlike `cua-mode').
+
+Pass prefix ARG to the respective copy functions."
+  (interactive "P")
+  (ergoemacs-copy-line-or-region arg)
+  ;; Send next key
+  (let ((keys (this-single-command-keys)))
+    (setq unread-command-events
+             (cons (aref keys (1- (length keys))) unread-command-events))))
+
+(defun cua--prefix-cut-handler (arg)
+  "Cut region, then replay last key.
+
+This uses `ergoemacs-cut-line-or-region' (unlike `cua-mode').
+
+Pass prefix ARG to the respective copy functions."
+  (interactive "P")
+  (ergoemacs-cut-line-or-region arg)
+  (let ((keys (this-single-command-keys)))
+    (setq unread-command-events
+             (cons (aref keys (1- (length keys))) unread-command-events))))
+
+(defvar ergoemacs-mode)
+;;; Pre-command hook
+
+(defun ergoemacs--cua-pre-command-handler-1 ()
+  "Cancel prefix key timeout if user enters another key."
+  (when ergoemacs--prefix-override-timer
+    (if (timerp ergoemacs--prefix-override-timer)
+           (cancel-timer ergoemacs--prefix-override-timer))
+    (setq ergoemacs--prefix-override-timer nil)))
+
+(defun ergoemacs--cua-pre-command-handler ()
+  "Cancel prefix key timeout if user enters another key. (has error 
protection)"
+  (when ergoemacs-mode
+    (condition-case nil
+           (ergoemacs--cua-pre-command-handler-1)
+      (error nil))))
+
+
+(defun ergoemacs--cua-post-command-handler-1 ()
+  "Post command hook for ergoemacs-mode based cua-keys."
+  ;; Select the keymaps for the next command
+  (ergoemacs--select-keymaps))
+
+(defun ergoemacs--cua-post-command-handler ()
+  "Post command hook for `ergoemacs-mode' based cua keys."
+  (when ergoemacs-mode
+    (condition-case nil
+        (ergoemacs--cua-post-command-handler-1)
+      (error nil))))
+
+(add-hook 'post-command-hook #'ergoemacs--cua-post-command-handler)
+(add-hook 'pre-command-hook  #'ergoemacs--cua-pre-command-handler)
+
+(defun ergoemacs--shift-control-prefix (prefix)
+   "Handle S-C-x and S-C-c by emulating the fast double prefix function.
+PREFIX is the key prefix that is being sent for these keys."
+  ;; Don't record this command
+  (setq this-command last-command)
+  ;; Restore the prefix arg
+  ;; This should make it so that exchange-point-and-mark gets the prefix when
+  ;; you do C-u S-C-x C-x work (where the C-u is properly passed to the C-x
+  ;; C-x binding after the first S-C-x was rewritten to just C-x).
+  (prefix-command-preserve-state)
+  ;; Activate the cua--prefix-repeat-keymap
+  (setq ergoemacs--prefix-override-timer 'shift)
+  ;; Push duplicate keys back on the event queue
+  (setq unread-command-events
+        (cons prefix (cons prefix unread-command-events))))
+
+(defun ergoemacs--shift-control-c-prefix ()
+  "Shift control c prefix."
+  (interactive)
+  (ergoemacs--shift-control-prefix ?\C-c))
+
+(defun ergoemacs--shift-control-x-prefix ()
+  "Shift control x prefix."
+  (interactive)
+  (ergoemacs--shift-control-prefix ?\C-x))
+
+(provide 'ergoemacs-cua)
+;;; ergoemacs-cua.el ends here
diff --git a/ergoemacs-mode.el b/ergoemacs-mode.el
index e522142..213fd7c 100644
--- a/ergoemacs-mode.el
+++ b/ergoemacs-mode.el
@@ -327,7 +327,8 @@ This is structured by valid keyboard layouts for
 (defvar ergoemacs-translation-hash (make-hash-table)
   "Hash table of translations, structured by translatin type.")
 
-(dolist (pkg '(ergoemacs-command-loop
+(dolist (pkg '(ergoemacs-cua
+               ergoemacs-command-loop
                ergoemacs-advice
                ergoemacs-functions
                ergoemacs-key-description
@@ -400,6 +401,8 @@ after initializing ergoemacs-mode.
 
 (defvar ergoemacs-mark-active-keymap (let ((map (make-sparse-keymap)))
                                        (define-key map (kbd "TAB") 
'indent-region)
+                                       (define-key map [(shift control x)] 
'ergoemacs--shift-control-x-prefix)
+                                       (define-key map [(shift control c)] 
'ergoemacs--shift-control-c-prefix)
                                        map)
   "The keybinding that is active when the mark is active.")
 
@@ -411,14 +414,24 @@ after initializing ergoemacs-mode.
 
 (declare-function ergoemacs-advice-undefined "ergoemacs-advice")
 
+(defvar ergoemacs--ena-prefix-override-keymap)
+(defvar ergoemacs--prefix-override-keymap)
+(defvar ergoemacs--ena-prefix-repeat-keymap)
+(defvar ergoemacs--prefix-repeat-keymap)
+(defvar ergoemacs--ena-region-keymap)
+
+  ;; Enable shifted fallbacks for C-x and C-c when region is active
+
 (defun ergoemacs-setup-override-keymap ()
   "Setup `ergoemacs-mode' keymaps."
-  (setq ergoemacs-override-alist `((ergoemacs-mode . ,ergoemacs-user-keymap)
+  (setq ergoemacs-override-alist `((ergoemacs--ena-prefix-override-keymap . 
,ergoemacs--prefix-override-keymap)
+                                   (ergoemacs--ena-prefix-repeat-keymap .   
,ergoemacs--prefix-repeat-keymap)
+                                   (ergoemacs--ena-region-keymap . 
,ergoemacs-mark-active-keymap)
+                                   (ergoemacs-mode . ,ergoemacs-user-keymap)
                                    (ergoemacs-mode . 
,ergoemacs-override-keymap)
                                    (ergoemacs-mode . ,ergoemacs-keymap))
         ergoemacs-minor-alist `(mark-active . ,ergoemacs-mark-active-keymap))
   (add-hook 'emulation-mode-map-alists ergoemacs-override-alist)
-  (add-hook 'minor-mode-map-alist ergoemacs-minor-alist)
   (advice-add 'undefined :around #'ergoemacs-advice-undefined)
   (advice-add 'read-key :before #'ergoemacs-advice-read-key))
 
diff --git a/ergoemacs-themes.el b/ergoemacs-themes.el
index c9a95e4..a4d0a32 100644
--- a/ergoemacs-themes.el
+++ b/ergoemacs-themes.el
@@ -460,7 +460,9 @@ These keys do not depend on the layout."
 (defun ergoemacs-set-copy (keymap)
   "Copy, Cut, Paste, Redo and Undo for KEYMAP."
   (ergoemacs-define-key keymap (kbd "M-x") 'ergoemacs-cut-line-or-region)
+  (define-key keymap (kbd "C-x <ergoemacs-timeout>") 
'ergoemacs-cut-line-or-region)
   (ergoemacs-define-key keymap (kbd "M-c") 'ergoemacs-copy-line-or-region)
+  (define-key keymap (kbd "C-c <ergoemacs-timeout>") 
'ergoemacs-copy-line-or-region)
   (ergoemacs-define-key keymap (kbd "M-v") 'ergoemacs-paste)
   (ergoemacs-define-key keymap (kbd "M-V") 'ergoemacs-paste-cycle)