[elpa] 29/287: Started parsing.

[Matthew Fidler]

mlf176f2 pushed a commit to branch externals/ergoemacs-mode
in repository elpa.

commit 57d9e5c3f8349ce2986dfbde06fe9756f503dbf9
Author: Matthew L. Fidler <address@hidden>
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 <address@hidden>
 
-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"))