0
0
Fork 1
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-09-29 19:37:52 +00:00

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

View file

@ -252,22 +252,22 @@ export that region, otherwise export the entire body."
(save-restriction
(org-narrow-to-subtree)
(run-hooks 'org-mime-send-subtree-hook)
(flet ((mp (p) (org-entry-get nil p org-mime-use-property-inheritance)))
(let* ((file (buffer-file-name (current-buffer)))
(subject (or (mp "MAIL_SUBJECT") (nth 4 (org-heading-components))))
(to (mp "MAIL_TO"))
(cc (mp "MAIL_CC"))
(bcc (mp "MAIL_BCC"))
(body (buffer-substring
(save-excursion (goto-char (point-min))
(forward-line 1)
(when (looking-at "[ \t]*:PROPERTIES:")
(re-search-forward ":END:" nil)
(forward-char))
(point))
(point-max))))
(org-mime-compose body (or fmt 'org) file to subject
`((cc . ,cc) (bcc . ,bcc)))))))
(let* ((mp (lambda (p) (org-entry-get nil p org-mime-use-property-inheritance)))
(file (buffer-file-name (current-buffer)))
(subject (or (funcall mp "MAIL_SUBJECT") (nth 4 (org-heading-components))))
(to (funcall mp "MAIL_TO"))
(cc (funcall mp "MAIL_CC"))
(bcc (funcall mp "MAIL_BCC"))
(body (buffer-substring
(save-excursion (goto-char (point-min))
(forward-line 1)
(when (looking-at "[ \t]*:PROPERTIES:")
(re-search-forward ":END:" nil)
(forward-char))
(point))
(point-max))))
(org-mime-compose body (or fmt 'org) file to subject
`((cc . ,cc) (bcc . ,bcc))))))
(defun org-mime-send-buffer (&optional fmt)
(run-hooks 'org-mime-send-buffer-hook)
@ -287,45 +287,46 @@ export that region, otherwise export the entire body."
(require 'message)
(message-mail to subject headers nil)
(message-goto-body)
(flet ((bhook (body fmt)
(let ((hook (intern (concat "org-mime-pre-"
(symbol-name fmt)
"-hook"))))
(if (> (eval `(length ,hook)) 0)
(with-temp-buffer
(insert body)
(goto-char (point-min))
(eval `(run-hooks ',hook))
(buffer-string))
body))))
(let ((fmt (if (symbolp fmt) fmt (intern fmt))))
(cond
((eq fmt 'org)
(require 'ox-org)
(insert (org-export-string-as
(org-babel-trim (bhook body 'org)) 'org t)))
((eq fmt 'ascii)
(require 'ox-ascii)
(insert (org-export-string-as
(concat "#+Title:\n" (bhook body 'ascii)) 'ascii t)))
((or (eq fmt 'html) (eq fmt 'html-ascii))
(require 'ox-ascii)
(require 'ox-org)
(let* ((org-link-file-path-type 'absolute)
;; we probably don't want to export a huge style file
(org-export-htmlize-output-type 'inline-css)
(html-and-images
(org-mime-replace-images
(org-export-string-as (bhook body 'html) 'html t) file))
(images (cdr html-and-images))
(html (org-mime-apply-html-hook (car html-and-images))))
(insert (org-mime-multipart
(org-export-string-as
(org-babel-trim
(bhook body (if (eq fmt 'html) 'org 'ascii)))
(if (eq fmt 'html) 'org 'ascii) t)
html)
(mapconcat 'identity images "\n"))))))))
(let ((bhook
(lambda (body fmt)
(let ((hook (intern (concat "org-mime-pre-"
(symbol-name fmt)
"-hook"))))
(if (> (eval `(length ,hook)) 0)
(with-temp-buffer
(insert body)
(goto-char (point-min))
(eval `(run-hooks ',hook))
(buffer-string))
body))))
(fmt (if (symbolp fmt) fmt (intern fmt))))
(cond
((eq fmt 'org)
(require 'ox-org)
(insert (org-export-string-as
(org-babel-trim (funcall bhook body 'org)) 'org t)))
((eq fmt 'ascii)
(require 'ox-ascii)
(insert (org-export-string-as
(concat "#+Title:\n" (funcall bhook body 'ascii)) 'ascii t)))
((or (eq fmt 'html) (eq fmt 'html-ascii))
(require 'ox-ascii)
(require 'ox-org)
(let* ((org-link-file-path-type 'absolute)
;; we probably don't want to export a huge style file
(org-export-htmlize-output-type 'inline-css)
(html-and-images
(org-mime-replace-images
(org-export-string-as (funcall bhook body 'html) 'html t) file))
(images (cdr html-and-images))
(html (org-mime-apply-html-hook (car html-and-images))))
(insert (org-mime-multipart
(org-export-string-as
(org-babel-trim
(funcall bhook body (if (eq fmt 'html) 'org 'ascii)))
(if (eq fmt 'html) 'org 'ascii) t)
html)
(mapconcat 'identity images "\n")))))))
(defun org-mime-org-buffer-htmlize ()
"Create an email buffer containing the current org-mode file