ergoemacs-cua.el

;;; ergoemacs-cua.el --- Keyboard keybinding translation -*- lexical-binding: t -*-

;; Copyright © 2013-2023  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
  "Non-nil if `ergoemacs-mode' is in the repeat phase,
I.e. 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
  "Non-nil if `ergoemacs-mode's override 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)

(defvar ergeoemacs-mode-term-raw-mode)
(defvar ergoemacs-mode)
(defvar ergoemacs--temporary-disable)
(defvar ergoemacs-mode-regular)
(defvar ergoemacs-mode-send-emacs-keys)
(defvar ergoemacs-send-keys-term)
(defvar term-raw-map)
(defun ergoemacs--select-keymaps ()
  "Setup conditions for selecting the proper keymaps in `ergoemacs--keymap-alist'."
  (if (and (eq major-mode 'term-mode)
           (eq (current-local-map) term-raw-map))
      (setq ergoemacs-mode-regular nil
            ergoemacs-mode-send-emacs-keys nil
            ergeoemacs-mode-term-raw-mode t)
    (when ergeoemacs-mode-term-raw-mode
      (setq ergeoemacs-mode-term-raw-mode nil
            ergoemacs-mode-regular t
            ergoemacs-mode-send-emacs-keys ergoemacs-send-keys-term
            ergoemacs--temporary-disable nil))
    (when ergoemacs--temporary-disable
      ;; The temporary disable commands set `ergoemacs--temporary-disable' to t
      ;; The first time when the keys are put on the `unread-command-events', `ergoemacs-mode' is disabled
      ;; The second command is executed, and `ergoemacs-mode' is turned back on and `ergoemacs--temporary-disable' is to nil
      (if ergoemacs-mode-regular
          (progn
            (setq ergoemacs--ena-region-keymap nil
                  ergoemacs--ena-prefix-override-keymap nil
                  ergoemacs--ena-prefix-repeat-keymap nil
                  ergoemacs-mode-regular nil
                  ergoemacs-mode-send-emacs-keys nil))
        (setq ergoemacs--temporary-disable nil
              ergoemacs-mode-regular t
              ;; This assumes that `ergoemacs--tempoary-disable' is only called on the remap keys layer
              ergoemacs-mode-send-emacs-keys t)))
    (when ergoemacs-mode
      ;; 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 (not ergeoemacs-mode-term-raw-mode) (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
                 (not ergeoemacs-mode-term-raw-mode)
                 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
                 (not ergeoemacs-mode-term-raw-mode)
	             (or (timerp ergoemacs--prefix-override-timer)
		             (eq ergoemacs--prefix-override-timer 'shift)))))))

(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-command-preserve-state ()
  "Compatibility layer for `prefix-command-preserve-state'."
  (if (fboundp 'prefix-command-preserve-state)
      (prefix-command-preserve-state)
    (setq prefix-arg current-prefix-arg)
    (reset-this-command-lengths)))

(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).
    (ergoemacs-prefix-command-preserve-state)
    
    ;; Push the key back on the event queue
    (if (version< emacs-version "26.2")
        (setq unread-command-events (cons key unread-command-events))
      (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).
  (ergoemacs-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