procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

gmm-util.el: Re-introduce gmm-flet using cl-letf

Browse source
This commit is contained in:
Katsumi Yamaoka 2012-12-05 02:26:15 +00:00
parent 49596095d0
commit 066f0e09bc
4 changed files with 37 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
lisp/gnus/ChangeLog
View file

@ -1,3 +1,9 @@
2012-12-05 Katsumi Yamaoka <yamaoka@jpl.org>
* gmm-utils.el (gmm-flet): Restore it using cl-letf.
* gnus-sync.el (gnus-sync-lesync-call)
* message.el (message-read-from-minibuffer): Use it.
2012-12-05 Katsumi Yamaoka <yamaoka@jpl.org>
* gmm-utils.el (gmm-flet): Remove.

18
lisp/gnus/gmm-utils.el
View file

@ -417,7 +417,23 @@ coding-system."
(write-region start end filename append visit lockname))
(write-region start end filename append visit lockname mustbenew)))
;; `labels' got obsolete since Emacs 24.3.
;; `flet' and `labels' got obsolete since Emacs 24.3.
(defmacro gmm-flet (bindings &rest body)
"Make temporary overriding function definitions.
This is an analogue of a dynamically scoped `let' that operates on
the function cell of FUNCs rather than their value cell.
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
(require 'cl)
(if (fboundp 'cl-letf)
`(cl-letf ,(mapcar (lambda (binding)
`((symbol-function ',(car binding))
(lambda ,@(cdr binding))))
bindings)
,@body)
`(flet ,bindings ,@body)))
(put 'gmm-flet 'lisp-indent-function 1)
(defmacro gmm-labels (bindings &rest body)
"Make temporary function bindings.
The bindings can be recursive and the scoping is lexical, but capturing

26
lisp/gnus/gnus-sync.el
View file

@ -88,6 +88,7 @@
(require 'gnus)
(require 'gnus-start)
(require 'gnus-util)
(require 'gmm-utils)
(defvar gnus-topic-alist) ;; gnus-group.el
(eval-when-compile
@ -176,21 +177,16 @@ and `gnus-topic-alist'. Also see `gnus-variable-list'."
(defun gnus-sync-lesync-call (url method headers &optional kvdata)
"Make an access request to URL using KVDATA and METHOD.
KVDATA must be an alist."
(let ((orig-json-alist-p (symbol-function 'json-alist-p)))
(fset 'json-alist-p
(lambda (list) (gnus-sync-json-alist-p list))) ; temp patch
(unwind-protect
(let ((url-request-method method)
(url-request-extra-headers headers)
(url-request-data (if kvdata (json-encode kvdata) nil)))
(with-current-buffer (url-retrieve-synchronously url)
(let ((data (gnus-sync-lesync-parse)))
(gnus-message
12 "gnus-sync-lesync-call: %s URL %s sent %S got %S"
method url `((headers . ,headers) (data ,kvdata)) data)
(kill-buffer (current-buffer))
data)))
(fset 'json-alist-p orig-json-alist-p))))
(gmm-flet ((json-alist-p (list) (gnus-sync-json-alist-p list))) ; temp patch
(let ((url-request-method method)
(url-request-extra-headers headers)
(url-request-data (if kvdata (json-encode kvdata) nil)))
(with-current-buffer (url-retrieve-synchronously url)
(let ((data (gnus-sync-lesync-parse)))
(gnus-message 12 "gnus-sync-lesync-call: %s URL %s sent %S got %S"
method url `((headers . ,headers) (data ,kvdata)) data)
(kill-buffer (current-buffer))
data)))))
(defun gnus-sync-lesync-PUT (url headers &optional data)
(gnus-sync-lesync-call url "PUT" headers data))

10
lisp/gnus/message.el
View file

@ -8140,13 +8140,9 @@ regexp VARSTR."
"Read from the minibuffer while providing abbrev expansion."
(if (fboundp 'mail-abbrevs-setup)
(let ((minibuffer-setup-hook 'mail-abbrevs-setup)
(minibuffer-local-map message-minibuffer-local-map)
(orig-m-a-i-e-h-p (symbol-function
'mail-abbrev-in-expansion-header-p)))
(fset 'mail-abbrev-in-expansion-header-p (lambda (&rest args) t))
(unwind-protect
(read-from-minibuffer prompt initial-contents)
(fset 'mail-abbrev-in-expansion-header-p orig-m-a-i-e-h-p)))
(minibuffer-local-map message-minibuffer-local-map))
(gmm-flet ((mail-abbrev-in-expansion-header-p nil t))
(read-from-minibuffer prompt initial-contents)))
(let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook)
(minibuffer-local-map message-minibuffer-local-map))
(read-string prompt initial-contents))))