mlf176f2 pushed a commit to branch externals/ergoemacs-mode in repository elpa.
commit 57d9e5c3f8349ce2986dfbde06fe9756f503dbf9 Author: Matthew L. Fidler <[email protected]> Date: Sun Jun 1 14:54:17 2014 +0800 Started parsing. --- ergoemacs-theme-engine.el | 189 ++++++++++++++++++++++++++++++--------------- 1 files changed, 126 insertions(+), 63 deletions(-) diff --git a/ergoemacs-theme-engine.el b/ergoemacs-theme-engine.el index 62f8553..dcceca8 100644 --- a/ergoemacs-theme-engine.el +++ b/ergoemacs-theme-engine.el @@ -640,6 +640,9 @@ Assumes maps are orthogonal." ((variable-reg :initarg :variable-reg :initform (concat "\\(?:^\\|<\\)" (regexp-opt '("M-" "<apps>" "<menu>"))) :type string) + (description :initarg :description + :initform "" + :type string) (just-first :initarg :just-first :initform "" :type string) @@ -730,9 +733,16 @@ Assumes maps are orthogonal." (or (and (memq keymap '(global-map ergoemacs-keymap)) ergoemacs-theme-component-maps--global-map) keymap) key def))) +(defun ergoemacs-set (symbol newval) + (if (not (ergoemacs-theme-component-maps-p ergoemacs-theme-component-maps--curr-component)) + (warn "`ergoemacs-set' is meant to be called in a theme definition.") + ;; ergoemacs-set definition. + )) + (defun ergoemacs-theme-component--with-hook (hook plist body) ;; Adapted from Stefan Monnier - (let ((ergoemacs-theme-component-maps--modify-map + (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 @@ -744,51 +754,82 @@ Assumes maps are orthogonal." (funcall body))) (defun ergoemacs-theme-component--parse-remaining (remaining) - (let ((remaining - (mapcar - (lambda(elt) - (cond - (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))))) - ((ignore-errors (eq elt ':version)) - (setq last-was-version t) - nil) - ((ignore-errors (eq (nth 0 elt) 'global-reset-key)) - `(ergoemacs-theme-component--global-reset-key ,(nth 1 elt))) - ((ignore-errors (eq (nth 0 elt) 'global-unset-key)) - `(ergoemacs-theme-component--global-set-key ,(nth 1 elt) nil)) - ((ignore-errors (eq (nth 0 elt) 'setq)) - ;; Currently doesn't support (setq a b c d ), but it should. - `(ergoemacs-theme-component--set (quote ,(nth 1 elt)) ,(nth 2 elt))) - ((ignore-errors (eq (nth 0 elt) 'set)) - `(ergoemacs-theme-component--set (nth 1 elt) ,(nth 2 elt))) - ((ignore-errors (string-match "-mode$" (symbol-name (nth 0 elt)))) - `(ergoemacs-theme-component--mode (quote ,(nth 0 elt)) ,(nth 1 elt))) - ((ignore-errors (eq (nth 0 elt) 'global-set-key)) - (if (keymapp (symbol-value (nth 2 elt))) - `(ergoemacs-theme-component--global-set-key ,(nth 1 elt) (quote ,(nth 2 elt))) - `(ergoemacs-theme-component--global-set-key ,(nth 1 elt) ,(nth 2 elt)))) - ((ignore-errors (eq (nth 0 elt) 'define-key)) - (if (equal (nth 1 elt) '(current-global-map)) - (if (ignore-errors (keymapp (symbol-value (nth 3 elt)))) - `(ergoemacs-theme-component--global-set-key ,(nth 2 elt) (quote ,(nth 3 elt))) - `(ergoemacs-theme-component--global-set-key ,(nth 2 elt) ,(nth 3 elt))) - (if (keymapp (symbol-value (nth 3 elt))) - `(ergoemacs-theme-component--define-key (quote ,(nth 1 elt)) ,(nth 2 elt) (quote ,(nth 3 elt))) - `(ergoemacs-theme-component--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-keys-and-body (cdr (cdr elt)) t))) - `(ergoemacs--with-hook ',(nth 1 elt) ',(nth 0 tmp) - (lambda () ,@(nth 1 tmp))))))) - (t elt)))) + "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' +- Mode initialization like (delete-selection-mode 1) + or (delete-selection) is converted to + `ergoemacs-theme-component--mode' +- Allows :version statement expansion +- Adds with-hook syntax or (when -hook) or (when -mode) +" + (let* ((last-was-version nil) + (remaining + (mapcar + (lambda(elt) + (cond + (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))))) + ((ignore-errors (eq elt ':version)) + (setq last-was-version t) + nil) + ((ignore-errors (eq (nth 0 elt) 'global-reset-key)) + `(ergoemacs-define-key 'global-map ,(nth 1 elt) nil)) + ((ignore-errors (eq (nth 0 elt) 'global-unset-key)) + `(ergoemacs-define-key 'global-map ,(nth 1 elt) nil)) + ((ignore-errors (eq (nth 0 elt) 'set)) + ;; Currently doesn't support (setq a b c d ), but it should. + `(ergoemacs-theme-component--set ,(nth 1 elt) ,(nth 2 elt))) + ((ignore-errors (eq (nth 0 elt) 'setq)) + (let ((tmp-elt elt) + (ret '())) + (pop tmp-elt) + (while (and (= 0 (mod (length tmp-elt) 2)) (< 0 (length tmp-elt))) + (push `(ergoemacs-set (quote ,(pop tmp-elt)) ,(pop tmp-elt)) ret)) + (push 'progn ret) + ret)) + ;; ((ignore-errors (string-match "-mode$" (symbol-name (nth 0 elt)))) + ;; `(ergoemacs-theme-component--mode (quote ,(nth 0 elt)) ,(nth 1 elt))) + ((ignore-errors (eq (nth 0 elt) 'global-set-key)) + (if (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)) + (if (equal (nth 1 elt) '(current-global-map)) + (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))) + `(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))))) + (t elt))) + remaining))) remaining)) -(defun ergoemacs-theme-component--parse-keys-and-body (keys-and-body &optional skip-first no-parsing) +(defun ergoemacs-theme-component--parse (keys-and-body &optional skip-first) + "Parse KEYS-AND-BODY, optionally skipping the name and +documentation with SKIP-FIRST. + +Uses `ergoemacs-theme-component--parse-keys-and-body' and + `ergoemacs-theme-component--parse-remaining'." + (ergoemacs-theme-component--parse-keys-and-body + keys-and-body + 'ergoemacs-theme-component--parse-remaining + skip-first)) + +(defun ergoemacs-theme-component--parse-keys-and-body (keys-and-body parse-function &optional skip-first) "Split KEYS-AND-BODY into keyword-and-value pairs and the remaining body. KEYS-AND-BODY should have the form of a property list, with the @@ -801,19 +842,7 @@ and the body. This has been stolen directly from ert by Christian Ohler <[email protected]> -Afterward it was modified for use with `ergoemacs-mode'. In -particular it: -- `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' -- Mode initialization like (delete-selection-mode 1) - or (delete-selection) is converted to - `ergoemacs-theme-component--mode' -- Allows :version statement expansion -- Adds with-hook syntax or (when -hook) or (when -mode) -" +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 @@ -840,18 +869,52 @@ particular it: keys-and-body)) (push (cons keyword (pop remaining)) extracted-key-accu))) (setq extracted-key-accu (nreverse extracted-key-accu)) - ;; Now change remaining (define-key keymap key def) to - ;; (define-key 'keymap key def) - ;; Also change (with-hook hook-name ) to (let ((ergoemacs-hook - ;; 'hook-name))) - (unless no-parsing + (when parse-function (setq remaining - (ergoemacs-theme-component--parse-remaining remaining))) + (funcall parse-function remaining))) (setq plist (loop for (key . value) in extracted-key-accu collect key collect value)) (list plist remaining))) +(defun ergoemacs-theme-component--create-component (plist body) + (let* ((ergoemacs-theme-component-maps--curr-component + (ergoemacs-theme-component-maps + (plist-get (nth 0 kb) ':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))) + +(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)) + + `(ergoemacs-theme-component--create-component + ,(nth 0 kb) + (lambda () ,@(nth 1 kb))))) + +(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) + (setq )))) + + ;; (setq ergoemacs-theme-component-maps--curr-component ;; (ergoemacs-theme-component-maps "test" :layout "colemak"))
