mirror/org-mode
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-12-12 09:28:11 +00:00
Code

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

Browse Source 
* 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

111
contrib/lisp/org-mime.el
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