diff options
| author | Katsumi Yamaoka <yamaoka@jpl.org> | 2012-12-04 23:24:24 +0000 |
|---|---|---|
| committer | Katsumi Yamaoka <yamaoka@jpl.org> | 2012-12-04 23:24:24 +0000 |
| commit | 68c2d59da47ba77a9e31e27550c39cc86beb5b67 (patch) | |
| tree | 6071740c48ee9c67108242224e5735982513eb56 /lisp/gnus/gmm-utils.el | |
| parent | 396376f1aeb072d20f1a8271ee47620b2ba9c15b (diff) | |
| download | emacs-68c2d59da47ba77a9e31e27550c39cc86beb5b67.tar.gz emacs-68c2d59da47ba77a9e31e27550c39cc86beb5b67.tar.bz2 emacs-68c2d59da47ba77a9e31e27550c39cc86beb5b67.zip | |
gmm-utils.el (gmm-labels): Use cl-labels if available
Diffstat (limited to 'lisp/gnus/gmm-utils.el')
| -rw-r--r-- | lisp/gnus/gmm-utils.el | 36 |
1 files changed, 2 insertions, 34 deletions
diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el index 3d504d73cee..9be6c66b63a 100644 --- a/lisp/gnus/gmm-utils.el +++ b/lisp/gnus/gmm-utils.el @@ -435,46 +435,14 @@ coding-system." (fmakunbound (car orig))))))) (put 'gmm-flet 'lisp-indent-function 1) -;; An alist of original function names and those unique names. -(defvar gmm-labels-environment) - -(defun gmm-labels-expand (form) - "Expand funcalls in FORM according to `gmm-labels-environment'. -This function is a subroutine that `gmm-labels' uses to convert any -`(FN ...)' and #'FN elements in FORM into `(funcall UN ...)' and `UN' -respectively if `(FN . UN)' is listed in `gmm-labels-environment'." - (cond ((or (not (consp form)) (memq (car form) '(\` backquote quote))) - form) - ((assq (car form) gmm-labels-environment) - `(funcall ,(cdr (assq (car form) gmm-labels-environment)) - ,@(mapcar #'gmm-labels-expand (cdr form)))) - ((eq (car form) 'function) - (if (and (assq (cadr form) gmm-labels-environment) - (not (cddr form))) - (cdr (assq (cadr form) gmm-labels-environment)) - (cons 'function (mapcar #'gmm-labels-expand (cdr form))))) - (t - (mapcar #'gmm-labels-expand form)))) - (defmacro gmm-labels (bindings &rest body) "Make temporary function bindings. The lexical scoping is handled via `lexical-let' rather than relying on `lexical-binding'. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" - (let (gmm-labels-environment def defs) - (dolist (binding bindings) - (push (cons (car binding) - (make-symbol (format "--gmm-%s--" (car binding)))) - gmm-labels-environment)) - `(lexical-let ,(mapcar #'cdr gmm-labels-environment) - (setq ,@(dolist (env gmm-labels-environment (nreverse defs)) - (setq def (cdr (assq (car env) bindings))) - (push (cdr env) defs) - (push `(lambda ,(car def) - ,@(mapcar #'gmm-labels-expand (cdr def))) - defs))) - ,@(mapcar #'gmm-labels-expand body)))) + `(,(progn (require 'cl) (if (fboundp 'cl-labels) 'cl-labels 'labels)) + ,bindings ,@body)) (put 'gmm-labels 'lisp-indent-function 1) (provide 'gmm-utils) |