mlf176f2 pushed a commit to branch externals/ergoemacs-mode in repository elpa.
commit 6edcd6a57fbe4ffc62d081f4b46e54ddf2362493 Author: Matthew L. Fidler <[email protected]> Date: Mon Jun 2 10:32:30 2014 -0500 Created composite map list --- ergoemacs-theme-engine.el | 353 +++++++++++++++++++++++++++++++++++---------- 1 files changed, 278 insertions(+), 75 deletions(-) diff --git a/ergoemacs-theme-engine.el b/ergoemacs-theme-engine.el index 6934e1e..c16cb75 100644 --- a/ergoemacs-theme-engine.el +++ b/ergoemacs-theme-engine.el @@ -209,6 +209,8 @@ (modify-map :initarg :modify-map :initform nil :type boolean) + (hook :initarg :hook + :type symbol) (full-map :initarg :full-map :initform nil :type boolean) @@ -432,6 +434,8 @@ DEF is anything that can be a key's definition: (modify-map :initarg :modify-map :initform nil :type boolean) + (hook :initarg :hook + :type symbol) (full-map :initarg :full-map :initform nil :type boolean) @@ -541,6 +545,8 @@ Optionally use DESC when another description isn't found in `ergoemacs-function- (modify-map :initarg :modify-map :initform nil :type boolean) + (hook :initarg :hook + :type symbol) (full-map :initarg :full-map :initform nil :type boolean) @@ -556,21 +562,26 @@ Optionally use DESC when another description isn't found in `ergoemacs-function- (defmethod ergoemacs-define-map ((obj ergoemacs-composite-map) key def &optional no-unbind) ;; Initialize classes (unless (slot-boundp obj 'fixed) - (oset obj fixed (ergoemacs-fixed-map (oref obj object-name) - :global-map-p (oref obj global-map-p) - :modify-map (oref obj modify-map) - :full-map (oref obj full-map) - :always (oref obj always)))) + (let ((fixed (ergoemacs-fixed-map (oref obj object-name) + :global-map-p (oref obj global-map-p) + :modify-map (oref obj modify-map) + :full-map (oref obj full-map) + :always (oref obj always)))) + (when (slot-boundp obj 'hook) + (oset fixed hook (oref obj hook))) + (oset obj fixed fixed))) (unless (slot-boundp obj 'variable) - (oset obj variable - (ergoemacs-variable-map - (oref obj object-name) - :global-map-p (oref obj global-map-p) - :just-first (oref obj just-first) - :layout (oref obj layout) - :modify-map (oref obj modify-map) - :full-map (oref obj full-map) - :always (oref obj always)))) + (let ((var (ergoemacs-variable-map + (oref obj object-name) + :global-map-p (oref obj global-map-p) + :just-first (oref obj just-first) + :layout (oref obj layout) + :modify-map (oref obj modify-map) + :full-map (oref obj full-map) + :always (oref obj always)))) + (when (slot-boundp obj 'hook) + (oset var hook (oref obj hook))) + (oset obj variable var))) (with-slots (object-name fixed variable @@ -616,24 +627,29 @@ Assumes maps are orthogonal." global-map-p) obj (let* ((lay (or layout ergoemacs-keyboard-layout)) (var (ergoemacs-get-fixed-map variable lay)) - (fix fixed) map1 map2) - (ergoemacs-fixed-map - object-name - :global-map-p global-map-p - :modify-map modify-map - :full-map full-map - :always always - :read-map (ergoemacs-get-fixed-map--combine-maps (oref var read-map) (oref fix read-map)) - :shortcut-map (ergoemacs-get-fixed-map--combine-maps (oref var shortcut-map) (oref fix shortcut-map)) - :no-shortcut-map (ergoemacs-get-fixed-map--combine-maps (oref var no-shortcut-map) (oref fix no-shortcut-map)) - :map (ergoemacs-get-fixed-map--combine-maps (oref var map) (oref fix map)) - :unbind-map (ergoemacs-get-fixed-map--combine-maps (oref var unbind-map) (oref fix unbind-map)) - :shortcut-list (append (oref var shortcut-list) (oref fix shortcut-list)) - :shortcut-movement (append (oref var shortcut-movement) (oref fix shortcut-movement)) - :shortcut-shifted-movement (append (oref var shortcut-shifted-movement) (oref fix shortcut-shifted-movement)) - :rm-keys (append (oref var rm-keys) (oref fix rm-keys)) - :cmd-list (append (oref var cmd-list) (oref fix cmd-list)) - :deferred-keys (append (oref var deferred-keys) (oref fix deferred-keys)))))) + (fix fixed) map1 map2 + (ret (ergoemacs-fixed-map + object-name + :global-map-p global-map-p + :modify-map modify-map + :full-map full-map + :always always + :read-map (ergoemacs-get-fixed-map--combine-maps (oref var read-map) (oref fix read-map)) + :shortcut-map (ergoemacs-get-fixed-map--combine-maps (oref var shortcut-map) (oref fix shortcut-map)) + :no-shortcut-map (ergoemacs-get-fixed-map--combine-maps (oref var no-shortcut-map) (oref fix no-shortcut-map)) + :map (ergoemacs-get-fixed-map--combine-maps (oref var map) (oref fix map)) + :unbind-map (ergoemacs-get-fixed-map--combine-maps (oref var unbind-map) (oref fix unbind-map)) + :shortcut-list (append (oref var shortcut-list) (oref fix shortcut-list)) + :shortcut-movement (append (oref var shortcut-movement) (oref fix shortcut-movement)) + :shortcut-shifted-movement (append (oref var shortcut-shifted-movement) (oref fix shortcut-shifted-movement)) + :rm-keys (append (oref var rm-keys) (oref fix rm-keys)) + :cmd-list (append (oref var cmd-list) (oref fix cmd-list)) + :deferred-keys (append (oref var deferred-keys) (oref fix deferred-keys))))) + (when (slot-boundp obj 'hook) + (oset ret hook (oref obj hook))) + ret))) + + (defclass ergoemacs-theme-component-maps (eieio-named) @@ -660,6 +676,12 @@ Assumes maps are orthogonal." (applied-init :initarg :applied-init :initform () :type list) + (version :initarg :version ;; "" is default version + :initform "" + :type string) + (versions :initarg :versions + :initform () + :type list) (deferred-init :initarg :deferred-init :initform () :type list)) @@ -684,13 +706,15 @@ Assumes maps are orthogonal." (defvar ergoemacs-theme-component-maps--modify-map nil) (defvar ergoemacs-theme-component-maps--global-map nil) (defvar ergoemacs-theme-component-maps--curr-component nil) +(defvar ergoemacs-theme-component-maps--versions '()) +(defvar ergoemacs-theme-component-maps--hook nil) (defmethod ergoemacs-theme-component-maps--keymap ((obj ergoemacs-theme-component-maps) keymap) (ergoemacs-theme-component-maps--ini obj) (with-slots (variable-reg just-first layout - maps) + maps) obj (let (ret) (catch 'found-keymap (dolist (map maps) @@ -707,7 +731,9 @@ Assumes maps are orthogonal." :layout layout :always ergoemacs-theme-component-maps--always :full-map ergoemacs-theme-component-maps--full-map - :modify-map)) + :modify-map ergoemacs-theme-component-maps--modify-map)) + (when ergoemacs-theme-component-maps--hook + (oset ret hook ergoemacs-theme-component-maps--hook)) (push ret maps) (oset obj maps maps)) ret))) @@ -733,6 +759,102 @@ Assumes maps are orthogonal." (t (ergoemacs-get-fixed-map (ergoemacs-theme-component-maps--keymap obj keymap) layout))))) + +(defclass ergoemacs-theme-component-map-list (eieio-named) + ((map-list :initarg :map-list + :initform () + :type list)) + "`ergoemacs-mode' theme-component maps") + +(defmethod ergoemacs-get-fixed-map ((obj ergoemacs-theme-component-map-list) &optional keymap layout) + (with-slots (map-list) obj + (let ((fixed-maps (mapcar (lambda(map) (ergoemacs-get-fixed-map map keymap layout)) map-list)) + new-global-map-p + new-read-map + new-shortcut-map + new-no-shortcut-map + new-map + new-unbind-map + new-shortcut-list + new-shortcut-movement + new-shortcut-shifted-movement + new-rm-keys + new-cmd-list + new-modify-map + new-hook + new-full-map + new-always + new-deferred-keys + (first t) + ret) + (dolist (map-obj fixed-maps) + (with-slots (global-map-p + read-map + shortcut-map + no-shortcut-map + map + unbind-map + shortcut-list + shortcut-movement + shortcut-shifted-movement + rm-keys + cmd-list + modify-map + full-map + always + deferred-keys) map-obj + (push read-map new-read-map) + (push shortcut-map new-shortcut-map) + (push no-shortcut-map new-no-shortcut-map) + (push map new-map) + (push unbind-map new-unbind-map) + (when (slot-boundp map 'hook) + (setq new-hook (oref map hook))) + (setq new-global-map-p global-map-p + new-modify-map modify-map + new-full-map full-map + new-always always) + (if first + (setq new-shortcut-list shortcut-list + new-shortcut-movement shortcut-movement + new-shortcut-shifted-movement shortcut-shifted-movement + new-rm-keys rm-keys + new-cmd-list cmd-list + new-deferred-keys deferred-keys + first nil) + (setq new-global-map-p global-map-p + new-modify-map modify-map + new-full-map full-map + new-always always + new-shortcut-list (append new-shortcut-list shortcut-list) + new-shortcut-movement (append new-shortcut-movement shortcut-movement) + new-shortcut-shifted-movement (append new-shortcut-shifted-movement shortcut-shifted-movement) + new-rm-keys (append new-rm-keys rm-keys) + new-cmd-list (append new-cmd-list cmd-list) + new-deferred-keys (append new-deferred-keys deferred-keys))))) + (setq ret + (ergoemacs-fixed-map + "composite" + :global-map-p new-global-map-p + :read-map (make-composed-keymap (reverse new-read-map)) + :shortcut-map (make-composed-keymap (reverse new-shortcut-map)) + :no-shortcut-map (make-composed-keymap (reverse new-no-shortcut-map)) + :map (make-composed-keymap (reverse new-map)) + :unbind-map (make-composed-keymap (reverse new-unbind-map)) + :shortcut-list new-shortcut-list + :shortcut-movement new-shortcut-movement + :shortcut-shifted-movement new-shortcut-shifted-movement + :rm-keys new-rm-keys + :cmd-list new-cmd-list + :modify-map new-modify-map + :full-map new-full-map + :always new-always + :deferred-keys new-deferred-keys)) + (when new-hook + (oset ret hook new-hook)) + ret))) + + (defun ergoemacs-define-key (keymap key def) "Defines KEY to be DEF in KEYMAP for object `ergoemacs-theme-component-maps--curr-component'." (if (not (ergoemacs-theme-component-maps-p ergoemacs-theme-component-maps--curr-component)) @@ -751,30 +873,63 @@ Assumes maps are orthogonal." (oset ergoemacs-theme-component-maps--curr-component init init)))) +(defun ergoemacs-theme-component--version (version) + "Changes the theme component version to VERSION." + (if (not (ergoemacs-theme-component-maps-p ergoemacs-theme-component-maps--curr-component)) + (warn "`ergoemacs-theme-component--version' is meant to be called in a theme definition.") + ;; ergoemacs-set definition. + (push ergoemacs-theme-component-maps--curr-component + ergoemacs-theme-component-maps--versions) + (setq ergoemacs-theme-component-maps--curr-component + (clone ergoemacs-theme-component-maps--curr-component)) + (oset ergoemacs-theme-component-maps--curr-component + version version))) + (defun ergoemacs-theme-component--with-hook (hook plist body) ;; Adapted from Stefan Monnier - (let ((ergoemacs-theme-component-maps--hook hook) - (ergoemacs-theme-component-maps--modify-map - (or (plist-get plist ':modify-keymap) - (plist-get plist ':modify-map))) - (ergoemacs-theme-component-maps--full-map - (or (plist-get plist ':full-shortcut-keymap) - (plist-get plist ':full-shortcut-map) - (plist-get plist ':full-map) - (plist-get plist ':full-keymap))) - (ergoemacs-theme-component-maps--always (plist-get plist ':always))) + (let* ((ergoemacs-theme-component-maps--hook + (or (and (string-match-p "-hook\\'" (symbol-name hook)) hook) + (and (string-match-p "mode.*" (symbol-name hook)) + (save-match-data + (intern-soft + (replace-regexp-in-string + "-mode.*" "mode-hook" + (symbol-name hook))))) + (and (string-match-p "(key)?map" (symbol-name hook)) + (save-match-data + (intern-soft + (replace-regexp-in-string + "(key)?map.*" "hook" + (symbol-name hook))))))) + ;; Globally set keys should be an emulation map for the mode. + (ergoemacs-theme-component-maps--global-map + (and (string-match-p "mode.*" (symbol-name hook)) + (save-match-data + (intern-soft + (replace-regexp-in-string + "mode.*" "mode" (symbol-name hook)))))) + (ergoemacs-theme-component-maps--modify-map ;; boolean + (or (plist-get plist ':modify-keymap) + (plist-get plist ':modify-map))) + (ergoemacs-theme-component-maps--full-map + (or (plist-get plist ':full-shortcut-keymap) + (plist-get plist ':full-shortcut-map) + (plist-get plist ':full-map) + (plist-get plist ':full-keymap))) + (ergoemacs-theme-component-maps--always + (plist-get plist ':always))) (funcall body))) (defun ergoemacs-theme-component--parse-remaining (remaining) "In parsing, this function converts -- `define-key' is converted to `ergoemacs-theme-component--define-key' and keymaps are quoted -- `global-set-key' is converted to `ergoemacs-theme-component--global-set-key' -- `global-unset-key' is converted to `ergoemacs-theme-component--global-set-key' -- `global-reset-key' is converted `ergoemacs-theme-component--global-reset-key' -- `setq' and `set' is converted to `ergoemacs-theme-component--set' +- `define-key' is converted to `ergoemacs-define-key' and keymaps are quoted +- `global-set-key' is converted to `ergoemacs-define-key' with keymap equal to `global-map' +- `global-unset-key' is converted to `ergoemacs-define-key' with keymap equal to `global-map' and function definition is `nil' +- `global-reset-key' is converted `ergoemacs-define-key' +- `setq' and `set' is converted to `ergoemacs-set' - Mode initialization like (delete-selection-mode 1) or (delete-selection) is converted to - `ergoemacs-theme-component--mode' + `ergoemacs-set' - Allows :version statement expansion - Adds with-hook syntax or (when -hook) or (when -mode) " @@ -786,8 +941,8 @@ Assumes maps are orthogonal." (last-was-version (setq last-was-version nil) (if (stringp elt) - `(when (boundp 'component-version) (setq component-version ,elt)) - `(when (boundp 'component-version) (setq component-version ,(symbol-name elt))))) + `(ergoemacs-theme-component--version ,elt) + `(ergoemacs-theme-component--version ,(symbol-name elt)))) ((ignore-errors (eq elt ':version)) (setq last-was-version t) nil) @@ -809,7 +964,7 @@ Assumes maps are orthogonal." ((ignore-errors (string-match "-mode$" (symbol-name (nth 0 elt)))) `(ergoemacs-set (quote ,(nth 0 elt)) ,(nth 1 elt))) ((ignore-errors (eq (nth 0 elt) 'global-set-key)) - (if (keymapp (symbol-value (nth 2 elt))) + (if (ignore-errors (keymapp (symbol-value (nth 2 elt)))) `(ergoemacs-define-key 'global-map ,(nth 1 elt) (quote ,(nth 2 elt))) `(ergoemacs-define-key 'global-map ,(nth 1 elt) ,(nth 2 elt)))) ((ignore-errors (eq (nth 0 elt) 'define-key)) @@ -817,15 +972,16 @@ Assumes maps are orthogonal." (if (ignore-errors (keymapp (symbol-value (nth 3 elt)))) `(ergoemacs-define-key 'global-map ,(nth 2 elt) (quote ,(nth 3 elt))) `(ergoemacs-define-key 'global-map ,(nth 2 elt) ,(nth 3 elt))) - (if (keymapp (symbol-value (nth 3 elt))) + (if (ignore-errors (keymapp (symbol-value (nth 3 elt)))) `(ergoemacs-define-key (quote ,(nth 1 elt)) ,(nth 2 elt) (quote ,(nth 3 elt))) `(ergoemacs-define-key (quote ,(nth 1 elt)) ,(nth 2 elt) ,(nth 3 elt))))) ((or (ignore-errors (eq (nth 0 elt) 'with-hook)) (and (ignore-errors (eq (nth 0 elt) 'when)) (ignore-errors (string-match "-\\(hook\\|mode\\)$" (symbol-name (nth 1 elt)))))) (let ((tmp (ergoemacs-theme-component--parse (cdr (cdr elt)) t))) - `(ergoemacs--with-hook ',(nth 1 elt) ',(nth 0 tmp) - (lambda () ,@(nth 1 tmp))))) + `(ergoemacs-theme-component--with-hook + ',(nth 1 elt) ',(nth 0 tmp) + '(lambda () ,@(nth 1 tmp))))) (t elt))) remaining))) remaining)) @@ -854,7 +1010,8 @@ and the body. This has been stolen directly from ert by Christian Ohler <[email protected]> -Afterward it was modified for use with `ergoemacs-mode' to use additional parsing routines defined by PARSE-FUNCTION." +Afterward it was modified for use with `ergoemacs-mode' to use +additional parsing routines defined by PARSE-FUNCTION." (let ((extracted-key-accu '()) last-was-version plist @@ -890,40 +1047,86 @@ Afterward it was modified for use with `ergoemacs-mode' to use additional parsin (list plist remaining))) (defun ergoemacs-theme-component--create-component (plist body) - (let* ((ergoemacs-theme-component-maps--curr-component + (let* ((ergoemacs-theme-component-maps--versions '()) + (ergoemacs-theme-component-maps--curr-component (ergoemacs-theme-component-maps - (plist-get (nth 0 kb) ':name) + (plist-get plist ':name) :description (plist-get plist :description) :layout (or (plist-get plist ':layout) "us") :variable-reg (or (plist-get plist ':variable-reg) (concat "\\(?:^\\|<\\)" (regexp-opt '("M-" "<apps>" "<menu>")))) :just-first (or (plist-get plist ':just-first) (plist-get plist ':first-is-variable-reg) - "")))) - (funcall body))) - + ""))) + ver-list tmp) + (funcall body) + (if (equal ergoemacs-theme-component-maps--versions '()) + (puthash (oref ergoemacs-theme-component-maps--curr-component object-name) + ergoemacs-theme-component-maps--curr-component + ergoemacs-theme-comp-hash) + (push ergoemacs-theme-component-maps--curr-componentr + ergoemacs-theme-component-maps--versions) + (dolist (comp ergoemacs-theme-component-maps--versions) + (setq tmp (oref comp version)) + (unless (string= tmp "") + (push tmp ver-list))) + (dolist (comp ergoemacs-theme-component-maps--versions) + (oset comp versions ver-list) + (setq tmp (oref comp version)) + (unless (string= tmp "") + (setq tmp (concat "::" tmp))) + (puthash (concat (oref comp object-name) tmp) + comp ergoemacs-theme-comp-hash))))) + +(defvar ergoemacs-theme-comp-hash (make-hash-table :test 'equal) + "Hash of ergoemacs theme components") (defmacro ergoemacs-theme-comp (&rest body-and-plist) "A component of an ergoemacs-theme." (declare (doc-string 2) (indent 2)) (let ((kb (make-symbol "body-and-plist"))) (setq kb (ergoemacs-theme-component--parse body-and-plist)) - - `(lambda() (ergoemacs-theme-component--create-component - ,(nth 0 kb) - (lambda () ,@(nth 1 kb)))))) + `(puthash ,(plist-get (nth 0 kb) ':name) + (lambda() (ergoemacs-theme-component--create-component + ',(nth 0 kb) + '(lambda () ,@(nth 1 kb)))) ergoemacs-theme-comp-hash))) + + + +(defun ergoemacs-theme-get-component (component &optional version) + "Gets the VERSION of COMPONENT from `ergoemacs-theme-comp-hash'. +COMPONENT can be defined as component::version" + (if (listp component) + (ergoemacs-theme-component-map-list "list" + :map-list (mapcar (lambda(comp) (ergoemacs-theme-get-component comp version)) component)) + (let* ((comp-name (or (and (symbolp component) (symbol-name component)) + component)) + (version (or (and (symbolp version) (symbol-name version)) + version "")) + comp ver-list ver) + (save-match-data + (when (string-match "::\\([0-9.]+\\)$" comp-name) + (setq version (match-string 1 comp-name) + comp-name (replace-match "" nil nil comp-name)))) + (setq comp (gethash comp-name ergoemacs-theme-comp-hash)) + (when (and (not (ergoemacs-theme-component-maps-p comp)) + (functionp comp)) + ;; Calculate component (and versions) + (funcall comp) + (setq comp (gethash comp-name ergoemacs-theme-comp-hash))) + (if (not (ergoemacs-theme-component-maps-p comp)) + (message "Component %s has not been defined!" component) + (when (not (string= "" version)) + (setq ver-list (oref comp versions)) + (setq version + (ergoemacs-theme-component-get-closest-version + version ver-list)) + (setq comp (gethash (concat comp-name version) + ergoemacs-theme-comp-hash)))) + comp))) ;; (message "%s" -;; (macroexpand `(ergoemacs-theme-comp standard-vars () -;; "Enabled/changed variables/modes" -;; (setq org-CUA-compatible t -;; org-support-shift-select t -;; set-mark-command-repeat-pop t -;; org-special-ctrl-a/e t -;; ido-vertical-define-keys 'C-n-C-p-up-down-left-right -;; scroll-error-top-bottom t) -;; (shift-select-mode t) -;; (delete-selection-mode 1)))) +;; (macroexpand `))
