[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 3d7d8c7 20/45: Add basic error handling
From: |
Oleh Krehel |
Subject: |
[elpa] master 3d7d8c7 20/45: Add basic error handling |
Date: |
Thu, 16 Apr 2015 12:45:47 +0000 |
branch: master
commit 3d7d8c764f99879987e11a3ead5c81ed70ddb04e
Author: Oleh Krehel <address@hidden>
Commit: Oleh Krehel <address@hidden>
Add basic error handling
* hydra.el (defhydra): When the macro fails, message an error and
continue as if the defhydra call wasn't there.
---
hydra.el | 218 +++++++++++++++++++++++++++++++------------------------------
1 files changed, 111 insertions(+), 107 deletions(-)
diff --git a/hydra.el b/hydra.el
index fcfe367..bfb003b 100644
--- a/hydra.el
+++ b/hydra.el
@@ -801,113 +801,117 @@ result of `defhydra'."
(setq docstring "hydra")))
(when (keywordp (car body))
(setq body (cons nil (cons nil body))))
- (let* ((keymap (copy-keymap hydra-base-map))
- (keymap-name (intern (format "%S/keymap" name)))
- (body-name (intern (format "%S/body" name)))
- (body-key (cadr body))
- (body-plist (cddr body))
- (body-map (or (car body)
- (plist-get body-plist :bind)))
- (body-pre (plist-get body-plist :pre))
- (body-body-pre (plist-get body-plist :body-pre))
- (body-before-exit (or (plist-get body-plist :post)
- (plist-get body-plist :before-exit)))
- (body-after-exit (plist-get body-plist :after-exit))
- (body-color (hydra--body-color body)))
- (hydra--make-funcall body-before-exit)
- (hydra--make-funcall body-after-exit)
- (dolist (h heads)
- (let ((len (length h)))
- (cond ((< len 2)
- (error "Each head should have at least two items: %S" h))
- ((= len 2)
- (setcdr (cdr h)
- (list
- (hydra-plist-get-default body-plist :hint "")))
- (setcdr (nthcdr 2 h)
- (list :cmd-name (hydra--head-name h name body))))
- (t
- (let ((hint (cl-caddr h)))
- (unless (or (null hint)
- (stringp hint))
- (setcdr (cdr h) (cons
- (hydra-plist-get-default body-plist :hint
"")
- (cddr h))))
- (let ((hint-and-plist (cddr h)))
- (if (null (cdr hint-and-plist))
- (setcdr hint-and-plist
- (list :cmd-name
- (hydra--head-name h name body)))
- (plist-put (cdr hint-and-plist)
- :cmd-name
- (hydra--head-name h name body)))))))))
- (let ((doc (hydra--doc body-key body-name heads))
- (heads-nodup (hydra--delete-duplicates heads)))
- (mapc
- (lambda (x)
- (define-key keymap (kbd (car x))
- (plist-get (cl-cdddr x) :cmd-name)))
- heads)
- (hydra--make-funcall body-pre)
- (hydra--make-funcall body-body-pre)
- (when (memq body-color '(amaranth pink))
- (unless (cl-some
- (lambda (h)
- (memq (hydra--head-color h body) '(blue teal)))
- heads)
- (error
- "An %S Hydra must have at least one blue head in order to exit"
- body-color)))
- `(progn
- ;; create keymap
- (set (defvar ,keymap-name
- nil
- ,(format "Keymap for %S." name))
- ',keymap)
- ;; create defuns
- ,@(mapcar
- (lambda (head)
- (hydra--make-defun name body doc head keymap-name
- body-pre
- body-before-exit
- body-after-exit))
- heads-nodup)
- ;; free up keymap prefix
- ,@(unless (or (null body-key)
- (null body-map)
- (hydra--callablep body-map))
- `((unless (keymapp (lookup-key ,body-map (kbd ,body-key)))
- (define-key ,body-map (kbd ,body-key) nil))))
- ;; bind keys
- ,@(delq nil
- (mapcar
- (lambda (head)
- (let ((name (hydra--head-property head :cmd-name)))
- (when (and (cadr head)
- (or body-key body-map))
- (let ((bind (hydra--head-property head :bind body-map))
- (final-key
- (if body-key
- (vconcat (kbd body-key) (kbd (car head)))
- (kbd (car head)))))
- (cond ((null bind) nil)
- ((hydra--callablep bind)
- `(funcall ,bind ,final-key (function ,name)))
- ((and (symbolp bind)
- (if (boundp bind)
- (keymapp (symbol-value bind))
- t))
- `(define-key ,bind ,final-key (function
,name)))
- (t
- (error "Invalid :bind property `%S' for head
%S" bind head)))))))
- heads))
- (defun ,(intern (format "%S/hint" name)) ()
- ,(hydra--message name body docstring heads))
- ,(hydra--make-defun
- name body doc '(nil body)
- keymap-name
- (or body-body-pre body-pre) body-before-exit
- '(setq prefix-arg current-prefix-arg))))))
+ (condition-case err
+ (let* ((keymap (copy-keymap hydra-base-map))
+ (keymap-name (intern (format "%S/keymap" name)))
+ (body-name (intern (format "%S/body" name)))
+ (body-key (cadr body))
+ (body-plist (cddr body))
+ (body-map (or (car body)
+ (plist-get body-plist :bind)))
+ (body-pre (plist-get body-plist :pre))
+ (body-body-pre (plist-get body-plist :body-pre))
+ (body-before-exit (or (plist-get body-plist :post)
+ (plist-get body-plist :before-exit)))
+ (body-after-exit (plist-get body-plist :after-exit))
+ (body-color (hydra--body-color body)))
+ (hydra--make-funcall body-before-exit)
+ (hydra--make-funcall body-after-exit)
+ (dolist (h heads)
+ (let ((len (length h)))
+ (cond ((< len 2)
+ (error "Each head should have at least two items: %S" h))
+ ((= len 2)
+ (setcdr (cdr h)
+ (list
+ (hydra-plist-get-default body-plist :hint "")))
+ (setcdr (nthcdr 2 h)
+ (list :cmd-name (hydra--head-name h name body))))
+ (t
+ (let ((hint (cl-caddr h)))
+ (unless (or (null hint)
+ (stringp hint))
+ (setcdr (cdr h) (cons
+ (hydra-plist-get-default body-plist
:hint "")
+ (cddr h))))
+ (let ((hint-and-plist (cddr h)))
+ (if (null (cdr hint-and-plist))
+ (setcdr hint-and-plist
+ (list :cmd-name
+ (hydra--head-name h name body)))
+ (plist-put (cdr hint-and-plist)
+ :cmd-name
+ (hydra--head-name h name body)))))))))
+ (let ((doc (hydra--doc body-key body-name heads))
+ (heads-nodup (hydra--delete-duplicates heads)))
+ (mapc
+ (lambda (x)
+ (define-key keymap (kbd (car x))
+ (plist-get (cl-cdddr x) :cmd-name)))
+ heads)
+ (hydra--make-funcall body-pre)
+ (hydra--make-funcall body-body-pre)
+ (when (memq body-color '(amaranth pink))
+ (unless (cl-some
+ (lambda (h)
+ (memq (hydra--head-color h body) '(blue teal)))
+ heads)
+ (error
+ "An %S Hydra must have at least one blue head in order to exit"
+ body-color)))
+ `(progn
+ ;; create keymap
+ (set (defvar ,keymap-name
+ nil
+ ,(format "Keymap for %S." name))
+ ',keymap)
+ ;; create defuns
+ ,@(mapcar
+ (lambda (head)
+ (hydra--make-defun name body doc head keymap-name
+ body-pre
+ body-before-exit
+ body-after-exit))
+ heads-nodup)
+ ;; free up keymap prefix
+ ,@(unless (or (null body-key)
+ (null body-map)
+ (hydra--callablep body-map))
+ `((unless (keymapp (lookup-key ,body-map (kbd
,body-key)))
+ (define-key ,body-map (kbd ,body-key) nil))))
+ ;; bind keys
+ ,@(delq nil
+ (mapcar
+ (lambda (head)
+ (let ((name (hydra--head-property head :cmd-name)))
+ (when (and (cadr head)
+ (or body-key body-map))
+ (let ((bind (hydra--head-property head :bind
body-map))
+ (final-key
+ (if body-key
+ (vconcat (kbd body-key) (kbd (car
head)))
+ (kbd (car head)))))
+ (cond ((null bind) nil)
+ ((hydra--callablep bind)
+ `(funcall ,bind ,final-key (function
,name)))
+ ((and (symbolp bind)
+ (if (boundp bind)
+ (keymapp (symbol-value bind))
+ t))
+ `(define-key ,bind ,final-key (function
,name)))
+ (t
+ (error "Invalid :bind property `%S' for
head %S" bind head)))))))
+ heads))
+ (defun ,(intern (format "%S/hint" name)) ()
+ ,(hydra--message name body docstring heads))
+ ,(hydra--make-defun
+ name body doc '(nil body)
+ keymap-name
+ (or body-body-pre body-pre) body-before-exit
+ '(setq prefix-arg current-prefix-arg)))))
+ (error
+ (message "Error in defhydra %S: %s" name (cdr err))
+ nil)))
(defmacro defhydradio (name _body &rest heads)
"Create radios with prefix NAME.
- [elpa] master 8875bf1 28/45: Make digit and negative arguments work in 24.3, (continued)
- [elpa] master 8875bf1 28/45: Make digit and negative arguments work in 24.3, Oleh Krehel, 2015/04/16
- [elpa] master 0ae639f 22/45: Use a variable instead of a function for the hint, Oleh Krehel, 2015/04/16
- [elpa] master d71386b 29/45: hydra.el (hydra--head-color): Simplify, Oleh Krehel, 2015/04/16
- [elpa] master 22348d7 23/45: hydra.el (hydra--face): Remove, Oleh Krehel, 2015/04/16
- [elpa] master 88f14a0 30/45: hydra.el (hydra--head-color): Remove, Oleh Krehel, 2015/04/16
- [elpa] master cb630df 16/45: Update the tests for the new `hydra-set-transient-map', Oleh Krehel, 2015/04/16
- [elpa] master 566aab7 31/45: Set `this-command' when appropriate, Oleh Krehel, 2015/04/16
- [elpa] master 19cc1be 21/45: Use `unwind-protect' for :after-exit, Oleh Krehel, 2015/04/16
- [elpa] master 986226f 18/45: Simplify `keyboard-quit', Oleh Krehel, 2015/04/16
- [elpa] master 51e7753 19/45: Alias :post to :before-exit, and add :after-exit, Oleh Krehel, 2015/04/16
- [elpa] master 3d7d8c7 20/45: Add basic error handling,
Oleh Krehel <=
- [elpa] master 684f8a2 39/45: Add integration test for red hydras temporarily exiting, Oleh Krehel, 2015/04/16
- [elpa] master d3d435d 25/45: Finalize head inheritance, Oleh Krehel, 2015/04/16
- [elpa] master b2c9ea6 36/45: README.md: Update intro, Oleh Krehel, 2015/04/16
- [elpa] master d678cc0 34/45: Work around `overriding-terminal-local-map' being terminal-local, Oleh Krehel, 2015/04/16
- [elpa] master d6e00ed 33/45: README.md: Add video demo link, Oleh Krehel, 2015/04/16
- [elpa] master 97c9b9b 32/45: Move `this-command' setter, Oleh Krehel, 2015/04/16
- [elpa] master 60ce256 41/45: Add an idle message timeout option, Oleh Krehel, 2015/04/16
- [elpa] master 99b2aea 35/45: hydra.el (hydra--format): Match alnum for the "_..._" syntax, Oleh Krehel, 2015/04/16
- [elpa] master f01c87e 38/45: Fix red heads not exiting temporarily, Oleh Krehel, 2015/04/16
- [elpa] master f972634 45/45: Merge commit '742d66a63e86ac740e610faa5abba97e7f8ad5c2' from hydra, Oleh Krehel, 2015/04/16