FG42/core/fg42/system/keys.el

125 lines
4.5 KiB
EmacsLisp

;;; dependencies --- System library of FG42 -*- lexical-binding: t; -*-
;;
;; Copyright (c) 2010-2021 Sameer Rahmani & Contributors
;;
;; Author: Sameer Rahmani <lxsameer@gnu.org>
;; URL: https://gitlab.com/FG42/FG42
;; Version: 3.0.0
;;
;; 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 of the License, 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/>.
;;
;;; Commentary:
;; `System' is just a state monad which holds the state of the editor.
;; Each system has to have a `start' function to start the setup process.
;;
;;; Code:
(require 'seq)
(require 'fg42/system/core)
(defun fg42/system-merge-keys (system cube-name keys)
"Retun an updated SYSTEM with the given keys KEYS for CUBE-NAME.
It converts the `:keys' of the cube to the following format and adds
them to the system. (cube-nam mode (key f)s...)."
(let ((keyset :good))
(if keys
;; TODO: Validate the deps here
(fg42/system-cons-to system
:keys
(car
(seq-reduce
(lambda (bindings keys)
(let ((mode (car keys))
(pair-list (plist-get (cdr keys) keyset)))
(cons
(list cube-name mode pair-list)
bindings)))
keys
'())))
system)))
;; (defun fg42/system-merge-keys (system cube-name keys)
;; "Retun an updated SYSTEM with the given keys KEYS for CUBE-NAME.
;; It converts the `:keys' of the cube to the following format and adds
;; them to the system. (cube-nam mode (key f)s...)."
;; (let ((keyset :good))
;; (if keys
;; ;; TODO: Validate the deps here
;; (fg42/system-cons-to system
;; :keys
;; (car
;; (seq-reduce
;; (lambda (bindings keys)
;; (let ((mode (car keys))
;; (pair-list (plist-get (cdr keys) keyset)))
;; (cons
;; (list cube-name mode pair-list)
;; bindings)))
;; keys
;; (assoc))))
;; system)))
;; (defun fg42/system-setup-keys (system)
;; "Setup the key binding through out the SYSTEM."
;; (message "#$$$$$########### %s" (fg42/system-get system :keys))
;; (let ((keyset :good))
;; (mapcar
;; (lambda (key-desc)
;; (let ((cube-name (car key-desc))
;; (map (cadr key-desc))
;; (binding (caddr key-desc))
;; (f (cadddr key-desc)))
;; (message "Set keybinding %s" key-desc)
;; (if (eq keyset :good)
;; (define-in-keymap map binding f)
;; (define-evil-in-keymap map binding f))))
;; (fg42/system-get system :keys)))
;; system)
(defun fg42/system-setup-keys (system)
"Setup the key binding through out the SYSTEM."
(let ((keyset :good))
(mapcar
(lambda (key-desc)
(let ((cube-name (car key-desc))
(map (cadr key-desc))
(binding (caddr key-desc))
(f (cadddr key-desc)))
(message "Set keybinding %s" key-desc)
(if (eq keyset :good)
(define-in-keymap map binding f)
(define-evil-in-keymap map binding f))))
(fg42/system-get system :keys)))
system)
(defmacro define-in-keymap (map binding f)
"Set the given key BINDING in the given MAP to F."
(if (eq map :global)
`(global-set-key (kbd ,binding) ,f)
`(define-key ,map (kbd ,binding) ,f)))
(defmacro define-evil-in-keymap (map binding f)
"Set the given key BINDING in the given MAP to F (evil mode only)."
(message "TBD")
nil)
(provide 'fg42/system/keys)
;;; keys.el ends here