diff options
author | Katsumi Yamaoka <yamaoka@jpl.org> | 2012-12-04 08:22:12 +0000 |
---|---|---|
committer | Katsumi Yamaoka <yamaoka@jpl.org> | 2012-12-04 08:22:12 +0000 |
commit | 46a2cc4470732ec3d8ac152932704bbcf394ee67 (patch) | |
tree | 849560f8345609f829ae90d2fcf3869e0c2150fd /lisp/gnus/gmm-utils.el | |
parent | ce3e7725b44e2785814cfb9bb68496e7ff95da3c (diff) | |
download | emacs-46a2cc4470732ec3d8ac152932704bbcf394ee67.tar.gz |
gmm-utils.el (gmm-flet, gmm-labels): New macros.
gnus-sync.el (gnus-sync-lesync-call)
message.el (message-read-from-minibuffer): Use gmm-flet.
gnus-score.el (gnus-score-decode-text-parts): Use gmm-labels.
gnus-util.el (gnus-macroexpand-all): Remove.
Diffstat (limited to 'lisp/gnus/gmm-utils.el')
-rw-r--r-- | lisp/gnus/gmm-utils.el | 60 |
1 files changed, 60 insertions, 0 deletions
diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el index 975b83370ba..3d504d73cee 100644 --- a/lisp/gnus/gmm-utils.el +++ b/lisp/gnus/gmm-utils.el @@ -417,6 +417,66 @@ coding-system." (write-region start end filename append visit lockname)) (write-region start end filename append visit lockname mustbenew))) +;; `flet' and `labels' got obsolete since Emacs 24.3. +(defmacro gmm-flet (bindings &rest body) + "Make temporary overriding function definitions. + +\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" + `(let (fn origs) + (dolist (bind ',bindings) + (setq fn (car bind)) + (push (cons fn (and (fboundp fn) (symbol-function fn))) origs) + (fset fn (cons 'lambda (cdr bind)))) + (unwind-protect + (progn ,@body) + (dolist (orig origs) + (if (cdr orig) + (fset (car orig) (cdr orig)) + (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)))) +(put 'gmm-labels 'lisp-indent-function 1) + (provide 'gmm-utils) ;;; gmm-utils.el ends here |