ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

org-mime.el: Don't use letf or cl-letf 

* contrib/lisp/org-mime.el (org-mime-send-subtree, org-mime-compose):
  `cl-letf' doesn't exist in Emacs <= 23, but `letf' won't exist in
  future Emacs. Replace with `lambda' and `funcall'.
This commit is contained in:
Eric Abrahamsen 2015-04-01 10:08:34 +08:00 committed by Nicolas Goaziou
parent c677c206fd
commit 237d423d6c
1 changed files with 56 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
contrib/lisp/org-mime.el
View File

@ -252,12 +252,12 @@ export that region, otherwise export the entire body."
(save-restriction (save-restriction
(org-narrow-to-subtree) (org-narrow-to-subtree)
(run-hooks 'org-mime-send-subtree-hook) (run-hooks 'org-mime-send-subtree-hook)
(flet ((mp (p) (org-entry-get nil p org-mime-use-property-inheritance))) (let* ((mp (lambda (p) (org-entry-get nil p org-mime-use-property-inheritance)))
(let* ((file (buffer-file-name (current-buffer))) (file (buffer-file-name (current-buffer)))
(subject (or (mp "MAIL_SUBJECT") (nth 4 (org-heading-components)))) (subject (or (funcall mp "MAIL_SUBJECT") (nth 4 (org-heading-components))))
(to (mp "MAIL_TO")) (to (funcall mp "MAIL_TO"))
(cc (mp "MAIL_CC")) (cc (funcall mp "MAIL_CC"))
(bcc (mp "MAIL_BCC")) (bcc (funcall mp "MAIL_BCC"))
(body (buffer-substring (body (buffer-substring
(save-excursion (goto-char (point-min)) (save-excursion (goto-char (point-min))
(forward-line 1) (forward-line 1)
@ -267,7 +267,7 @@ export that region, otherwise export the entire body."
(point)) (point))
(point-max)))) (point-max))))
(org-mime-compose body (or fmt 'org) file to subject (org-mime-compose body (or fmt 'org) file to subject
`((cc . ,cc) (bcc . ,bcc))))))) `((cc . ,cc) (bcc . ,bcc))))))
(defun org-mime-send-buffer (&optional fmt) (defun org-mime-send-buffer (&optional fmt)
(run-hooks 'org-mime-send-buffer-hook) (run-hooks 'org-mime-send-buffer-hook)
@ -287,7 +287,8 @@ export that region, otherwise export the entire body."
(require 'message) (require 'message)
(message-mail to subject headers nil) (message-mail to subject headers nil)
(message-goto-body) (message-goto-body)
(flet ((bhook (body fmt) (let ((bhook
(lambda (body fmt)
(let ((hook (intern (concat "org-mime-pre-" (let ((hook (intern (concat "org-mime-pre-"
(symbol-name fmt) (symbol-name fmt)
"-hook")))) "-hook"))))
@ -298,16 +299,16 @@ export that region, otherwise export the entire body."
(eval `(run-hooks ',hook)) (eval `(run-hooks ',hook))
(buffer-string)) (buffer-string))
body)))) body))))
(let ((fmt (if (symbolp fmt) fmt (intern fmt)))) (fmt (if (symbolp fmt) fmt (intern fmt))))
(cond (cond
((eq fmt 'org) ((eq fmt 'org)
(require 'ox-org) (require 'ox-org)
(insert (org-export-string-as (insert (org-export-string-as
(org-babel-trim (bhook body 'org)) 'org t))) (org-babel-trim (funcall bhook body 'org)) 'org t)))
((eq fmt 'ascii) ((eq fmt 'ascii)
(require 'ox-ascii) (require 'ox-ascii)
(insert (org-export-string-as (insert (org-export-string-as
(concat "#+Title:\n" (bhook body 'ascii)) 'ascii t))) (concat "#+Title:\n" (funcall bhook body 'ascii)) 'ascii t)))
((or (eq fmt 'html) (eq fmt 'html-ascii)) ((or (eq fmt 'html) (eq fmt 'html-ascii))
(require 'ox-ascii) (require 'ox-ascii)
(require 'ox-org) (require 'ox-org)
@ -316,16 +317,16 @@ export that region, otherwise export the entire body."
(org-export-htmlize-output-type 'inline-css) (org-export-htmlize-output-type 'inline-css)
(html-and-images (html-and-images
(org-mime-replace-images (org-mime-replace-images
(org-export-string-as (bhook body 'html) 'html t) file)) (org-export-string-as (funcall bhook body 'html) 'html t) file))
(images (cdr html-and-images)) (images (cdr html-and-images))
(html (org-mime-apply-html-hook (car html-and-images)))) (html (org-mime-apply-html-hook (car html-and-images))))
(insert (org-mime-multipart (insert (org-mime-multipart
(org-export-string-as (org-export-string-as
(org-babel-trim (org-babel-trim
(bhook body (if (eq fmt 'html) 'org 'ascii))) (funcall bhook body (if (eq fmt 'html) 'org 'ascii)))
(if (eq fmt 'html) 'org 'ascii) t) (if (eq fmt 'html) 'org 'ascii) t)
html) html)
(mapconcat 'identity images "\n")))))))) (mapconcat 'identity images "\n")))))))
(defun org-mime-org-buffer-htmlize () (defun org-mime-org-buffer-htmlize ()
"Create an email buffer containing the current org-mode file "Create an email buffer containing the current org-mode file