[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] 29/287: Started parsing.
From: |
Matthew Fidler |
Subject: |
[elpa] 29/287: Started parsing. |
Date: |
Wed, 02 Jul 2014 14:44:20 +0000 |
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"))
- [elpa] 25/287: Started allowing parsing of the ergoemacs-mode key objects., (continued)
- [elpa] 25/287: Started allowing parsing of the ergoemacs-mode key objects., Matthew Fidler, 2014/07/02
- [elpa] 01/287: Stefan Monnier's Patch, Matthew Fidler, 2014/07/02
- [elpa] 30/287: Started adding modes and setq assignments., Matthew Fidler, 2014/07/02
- [elpa] 32/287: Fix Issue #226, Matthew Fidler, 2014/07/02
- [elpa] 33/287: Merge branch 'master' into eieio, Matthew Fidler, 2014/07/02
- [elpa] 04/287: Revert "Stefan Monnier's Patch", Matthew Fidler, 2014/07/02
- [elpa] 35/287: Remove debug-on-error, Matthew Fidler, 2014/07/02
- [elpa] 41/287: Take out hook to change bindings., Matthew Fidler, 2014/07/02
- [elpa] 38/287: Remove global-override, Matthew Fidler, 2014/07/02
- [elpa] 23/287: Basic classes written, Matthew Fidler, 2014/07/02
- [elpa] 29/287: Started parsing.,
Matthew Fidler <=
- [elpa] 34/287: Now can get the fixed maps for a list of components., Matthew Fidler, 2014/07/02
- [elpa] 36/287: Use pushnew for get-hooks., Matthew Fidler, 2014/07/02
- [elpa] 37/287: Added ergoemacs-keymap-collapse and ergoemacs-keymap-empty-p, Matthew Fidler, 2014/07/02
- [elpa] 40/287: Remove shortcut override mode., Matthew Fidler, 2014/07/02
- [elpa] 44/287: Suppress shortcuts, Matthew Fidler, 2014/07/02
- [elpa] 39/287: Starting applying keymaps to ergoemacs-emulation-mode-map-alist, Matthew Fidler, 2014/07/02
- [elpa] 45/287: Fix ergoemacs-describe-key, Matthew Fidler, 2014/07/02
- [elpa] 31/287: Created composite map list, Matthew Fidler, 2014/07/02
- [elpa] 42/287: Push shortcuts to the bottom. Should allow overrides., Matthew Fidler, 2014/07/02
- [elpa] 49/287: Bug fix for substitute-command-keys, Matthew Fidler, 2014/07/02