Browse Source

Merge branch 'master' of git+ssh://repo.or.cz/srv/git/org-mode

Carsten Dominik 14 years ago
parent
commit
a43055a26f
4 changed files with 156 additions and 62 deletions
  1. 97 31
      contrib/lisp/org-mime.el
  2. 16 3
      doc/org.texi
  3. 2 1
      lisp/ob.el
  4. 41 27
      lisp/org-latex.el

+ 97 - 31
contrib/lisp/org-mime.el

@@ -85,6 +85,21 @@
   :group 'org-mime
   :group 'org-mime
   :type 'hook)
   :type 'hook)
 
 
+(mapc (lambda (fmt)
+	(eval `(defcustom
+		 ,(intern (concat "org-mime-pre-" fmt "-hook"))
+		 nil
+		 (concat "Hook to run before " fmt " export.\nFunctions "
+			 "should take no arguments and will be run in a "
+			 "buffer holding\nthe text to be exported."))))
+      '("ascii" "org" "html" "html-ascii"))
+
+(defcustom org-mime-send-subtree-hook nil
+  "Hook to run in the subtree in the Org-mode file before export.")
+
+(defcustom org-mime-send-buffer-hook nil
+  "Hook to run in the Org-mode file before export.")
+
 ;; example hook, for setting a dark background in <pre style="background-color: #EEE;"> elements
 ;; example hook, for setting a dark background in <pre style="background-color: #EEE;"> elements
 (defun org-mime-change-element-style (element style)
 (defun org-mime-change-element-style (element style)
   "Set new default htlm style for <ELEMENT> elements in exported html."
   "Set new default htlm style for <ELEMENT> elements in exported html."
@@ -174,7 +189,8 @@ export that region, otherwise export the entire body."
                        ;; TODO: should catch signature...
                        ;; TODO: should catch signature...
                        (point-max)))
                        (point-max)))
          (raw-body (buffer-substring html-start html-end))
          (raw-body (buffer-substring html-start html-end))
-         (tmp-file (make-temp-name (expand-file-name "mail" temporary-file-directory)))
+         (tmp-file (make-temp-name (expand-file-name
+				    "mail" temporary-file-directory)))
          (body (org-export-string raw-body 'org (file-name-directory tmp-file)))
          (body (org-export-string raw-body 'org (file-name-directory tmp-file)))
          ;; because we probably don't want to skip part of our mail
          ;; because we probably don't want to skip part of our mail
          (org-export-skip-text-before-1st-heading nil)
          (org-export-skip-text-before-1st-heading nil)
@@ -207,37 +223,87 @@ export that region, otherwise export the entire body."
         (buffer-string))
         (buffer-string))
     html))
     html))
 
 
-(defun org-mime-org-buffer-htmlize ()
-  "Export the current org-mode buffer to HTML using
-`org-export-as-html' and package the results into an email
-handling with appropriate MIME encoding."
-  (interactive)
-  (require 'reporter)
+(defmacro org-mime-try (&rest body)
+  `(condition-case nil ,@body (error nil)))
+
+(defun org-mime-send-subtree (&optional fmt)
+  (save-restriction
+    (org-narrow-to-subtree)
+    (run-hooks 'org-mime-send-subtree-hook)
+    (let* ((file (buffer-file-name (current-buffer)))
+	   (subject (nth 4 (org-heading-components)))
+	   (to (org-entry-get nil "MAIL_TO"))
+	   (cc (org-entry-get nil "MAIL_CC"))
+	   (bcc (org-entry-get nil "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)
   (let* ((region-p (org-region-active-p))
   (let* ((region-p (org-region-active-p))
-         (current-file (buffer-file-name (current-buffer)))
-	 (title (org-export-grab-title-from-buffer))
-         (html-start (or (and region-p (region-beginning))
-                         (save-excursion
-                           (goto-char (point-min)))))
-         (html-end (or (and region-p (region-end))
-                       (point-max)))
+	 (subject (org-export-grab-title-from-buffer))
+         (file (buffer-file-name (current-buffer)))
+         (body-start (or (and region-p (region-beginning))
+                         (save-excursion (goto-char (point-min)))))
+         (body-end (or (and region-p (region-end)) (point-max)))
 	 (temp-body-file (make-temp-file "org-mime-export"))
 	 (temp-body-file (make-temp-file "org-mime-export"))
-	 (raw-body (buffer-substring html-start html-end))
-         (body (org-export-string raw-body 'org))
-         (org-link-file-path-type 'absolute)
-         ;; because we probably don't want to export a huge style file
-         (org-export-htmlize-output-type 'inline-css)
-         ;; to hold attachments for inline html images
-         (html-and-images (org-mime-replace-images
-                           (org-export-as-html nil nil nil 'string t)
-                           current-file))
-         (html-images (cdr html-and-images))
-         (html (org-mime-apply-html-hook (car html-and-images))))
-    ;; dump the exported html into a fresh message buffer
-    (message-mail nil title)
-    (message-goto-body)
-    (prog1 (insert (org-mime-multipart body html)
-		   (mapconcat 'identity html-images "\n"))
-      (delete-file temp-body-file))))
+	 (body (buffer-substring body-start body-end)))
+    (org-mime-compose body (or fmt 'org) file nil subject)))
+
+(defun org-mime-compose (body fmt file &optional to subject headers)
+  (require 'message)
+  (message-mail to subject headers nil)
+  (message-goto-body)
+  (let* ((fmt (if (symbolp fmt) fmt (intern fmt)))
+	 (hook (intern (concat "org-mime-pre-" (symbol-name fmt) "-hook")))
+	 (body (if (> (eval `(length ,hook)) 0)
+		   (with-temp-buffer
+		     (insert body)
+		     (goto-char (point-min))
+		     (eval `(run-hooks ',hook))
+		     (buffer-string))
+		 body)))
+    (cond
+     ((eq fmt 'org)
+      (insert (org-export-string (org-babel-trim body) 'org)))
+     ((eq fmt 'ascii)
+      (insert (org-export-string (concat "#+Title:\n" body) 'ascii)))
+     ((or (eq fmt 'html) (eq fmt 'html-ascii))
+      (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
+				body 'html (file-name-nondirectory file))
+			       file))
+	     (images (cdr html-and-images))
+	     (html (org-mime-apply-html-hook (car html-and-images))))
+	(insert (org-mime-multipart
+		 (org-export-string
+		  (org-babel-trim body) (if (eq fmt 'html) 'org 'ascii))
+		 html)
+		(mapconcat 'identity images "\n")))))))
+
+(defun org-mime-org-buffer-htmlize ()
+  "Create an email buffer containing the current org-mode file
+  exported to html and encoded in both html and in org formats as
+  mime alternatives."
+  (interactive)
+  (org-mime-send-buffer 'html))
+
+(defun org-mime-subtree ()
+  "Create an email buffer containing the current org-mode subtree
+  exported to a org format or to the format specified by the
+  MAIL_FMT property of the subtree."
+  (interactive)
+  (org-mime-send-subtree (or (org-entry-get nil "MAIL_FMT") 'org)))
 
 
 (provide 'org-mime)
 (provide 'org-mime)

+ 16 - 3
doc/org.texi

@@ -9978,9 +9978,10 @@ All lines between these markers are exported literally
 For @LaTeX{} export of a table, you can specify a label and a caption
 For @LaTeX{} export of a table, you can specify a label and a caption
 (@pxref{Images and tables}).  You can also use the @code{ATTR_LaTeX} line to
 (@pxref{Images and tables}).  You can also use the @code{ATTR_LaTeX} line to
 request a @code{longtable} environment for the table, so that it may span
 request a @code{longtable} environment for the table, so that it may span
-several pages, or provide the @code{multicolumn} keyword that will make the
-table span the page in a multicolumn environment (@code{table*} environment).
-Finally, you can set the alignment string:
+several pages, or to change the default table environment from @code{table}
+to @code{table*} or to change the default inner tabular environment to
+@code{tabularx} or @code{tabulary}.  Finally, you can set the alignment
+string, and (with @code{tabularx} or @code{tabulary}) the width:
 
 
 @cindex #+CAPTION
 @cindex #+CAPTION
 @cindex #+LABEL
 @cindex #+LABEL
@@ -9993,6 +9994,18 @@ Finally, you can set the alignment string:
 | ..... | ..... |
 | ..... | ..... |
 @end example
 @end example
 
 
+or to specify a multicolumn table with @code{tabulary}
+
+@cindex #+CAPTION
+@cindex #+LABEL
+@cindex #+ATTR_LaTeX
+@example
+#+CAPTION: A wide table with tabulary
+#+LABEL: tbl:wide
+#+ATTR_LaTeX: table* tabulary width=\textwidth
+| ..... | ..... |
+| ..... | ..... |
+@end example
 
 
 @node Images in LaTeX export, Beamer class export, Tables in LaTeX export, LaTeX and PDF export
 @node Images in LaTeX export, Beamer class export, Tables in LaTeX export, LaTeX and PDF export
 @subsection Images in @LaTeX{} export
 @subsection Images in @LaTeX{} export

+ 2 - 1
lisp/ob.el

@@ -407,7 +407,8 @@ block."
 		      ((lambda (result)
 		      ((lambda (result)
 			 (cond
 			 (cond
 			  ((member "file" result-params)
 			  ((member "file" result-params)
-			   (cdr (assoc :file params)))
+			   (or (cdr (assoc :file params))
+			       (if (stringp result) result)))
 			  ((and (eq (cdr (assoc :result-type params)) 'value)
 			  ((and (eq (cdr (assoc :result-type params)) 'value)
 				(or (member "vector" result-params)
 				(or (member "vector" result-params)
 				    (member "table" result-params))
 				    (member "table" result-params))

+ 41 - 27
lisp/org-latex.el

@@ -1741,7 +1741,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
              (org-table-last-column-widths (copy-sequence
              (org-table-last-column-widths (copy-sequence
                                             org-table-last-column-widths))
                                             org-table-last-column-widths))
              fnum fields line lines olines gr colgropen line-fmt align
              fnum fields line lines olines gr colgropen line-fmt align
-             caption shortn label attr floatp placement longtblp)
+             caption shortn label attr floatp placement
+	     longtblp tblenv tabular-env)
         (if org-export-latex-tables-verbatim
         (if org-export-latex-tables-verbatim
             (let* ((tbl (concat "\\begin{verbatim}\n" raw-table
             (let* ((tbl (concat "\\begin{verbatim}\n" raw-table
                                 "\\end{verbatim}\n")))
                                 "\\end{verbatim}\n")))
@@ -1758,6 +1759,17 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
                          'org-label raw-table)
                          'org-label raw-table)
                   longtblp (and attr (stringp attr)
                   longtblp (and attr (stringp attr)
                                 (string-match "\\<longtable\\>" attr))
                                 (string-match "\\<longtable\\>" attr))
+		  tblenv (if (and attr (stringp attr)
+				  (string-match (regexp-quote "table*") attr))
+			     "table*" "table")
+		  tabular-env
+		  (if (and attr (stringp attr)
+			   (string-match "\\(tabular.\\)" attr))
+		      (match-string 1 attr)
+		    org-export-latex-tabular-environment)
+		  width (and attr (stringp attr)
+                             (string-match "\\<width=\\([^ \t\n\r]+\\)" attr)
+                             (match-string 1 attr))
                   align (and attr (stringp attr)
                   align (and attr (stringp attr)
                              (string-match "\\<align=\\([^ \t\n\r]+\\)" attr)
                              (string-match "\\<align=\\([^ \t\n\r]+\\)" attr)
                              (match-string 1 attr))
                              (match-string 1 attr))
@@ -1821,7 +1833,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
                        (concat
                        (concat
                         (if longtblp
                         (if longtblp
                             (concat "\\begin{longtable}{" align "}\n")
                             (concat "\\begin{longtable}{" align "}\n")
-                          (if floatp (format "\\begin{table}%s\n" placement)))
+                          (if floatp
+			      (format "\\begin{%s}%s\n" tblenv placement)))
                         (if floatp
                         (if floatp
                             (format
                             (format
                              "\\caption%s{%s} %s"
                              "\\caption%s{%s} %s"
@@ -1832,8 +1845,10 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
                         (if (and org-export-latex-tables-centered (not longtblp))
                         (if (and org-export-latex-tables-centered (not longtblp))
                             "\\begin{center}\n")
                             "\\begin{center}\n")
                         (if (not longtblp)
                         (if (not longtblp)
-			    (format "\\begin{%s}{%s}\n"
-				    org-export-latex-tabular-environment align))
+			    (format "\\begin{%s}%s{%s}\n"
+				    tabular-env
+				    (if width (format "{%s}" width) "")
+				    align))
                         (orgtbl-to-latex
                         (orgtbl-to-latex
                          lines
                          lines
                          `(:tstart nil :tend nil
                          `(:tstart nil :tend nil
@@ -1845,14 +1860,12 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
 \\endfoot
 \\endfoot
 \\endlastfoot" (length org-table-last-alignment))
 \\endlastfoot" (length org-table-last-alignment))
                                              nil)))
                                              nil)))
-                        (if (not longtblp)
-			    (format "\n\\end{%s}"
-				    org-export-latex-tabular-environment))
+                        (if (not longtblp) (format "\n\\end{%s}" tabular-env))
                         (if longtblp "\n" (if org-export-latex-tables-centered
                         (if longtblp "\n" (if org-export-latex-tables-centered
                                               "\n\\end{center}\n" "\n"))
                                               "\n\\end{center}\n" "\n"))
                         (if longtblp
                         (if longtblp
                             "\\end{longtable}"
                             "\\end{longtable}"
-                          (if floatp "\\end{table}"))))
+                          (if floatp (format "\\end{%s}" tblenv)))))
                       "\n\n"))))))))
                       "\n\n"))))))))
 
 
 (defun org-export-latex-convert-table.el-table ()
 (defun org-export-latex-convert-table.el-table ()
@@ -2166,14 +2179,14 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
   (while (re-search-forward "^[ \t]*\\\\begin{\\([a-zA-Z]+\\*?\\)}" nil t)
   (while (re-search-forward "^[ \t]*\\\\begin{\\([a-zA-Z]+\\*?\\)}" nil t)
     (org-if-unprotected
     (org-if-unprotected
      (let* ((start (progn (beginning-of-line) (point)))
      (let* ((start (progn (beginning-of-line) (point)))
-	   (end (and (re-search-forward
-		      (concat "^[ \t]*\\\\end{"
-			      (regexp-quote (match-string 1))
-			      "}") nil t)
-		     (point-at-eol))))
-      (if end
-	  (add-text-properties start end '(org-protected t))
-	(goto-char (point-at-eol))))))
+	    (end (and (re-search-forward
+		       (concat "^[ \t]*\\\\end{"
+			       (regexp-quote (match-string 1))
+			       "}") nil t)
+		      (point-at-eol))))
+       (if end
+	   (add-text-properties start end '(org-protected t))
+	 (goto-char (point-at-eol))))))
 
 
   ;; Preserve math snippets
   ;; Preserve math snippets
 
 
@@ -2284,13 +2297,13 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
 	  (concat "<<<?" org-export-latex-all-targets-re
 	  (concat "<<<?" org-export-latex-all-targets-re
 		  ">>>?\\((INVISIBLE)\\)?") nil t)
 		  ">>>?\\((INVISIBLE)\\)?") nil t)
     (org-if-unprotected-at (+ (match-beginning 0) 2)
     (org-if-unprotected-at (+ (match-beginning 0) 2)
-     (replace-match
-      (concat
-       (org-export-latex-protect-string
-	(format "\\label{%s}" (save-match-data (org-solidify-link-text
-						(match-string 1)))))
-       (if (match-string 2) "" (match-string 1)))
-      t t)))
+      (replace-match
+       (concat
+	(org-export-latex-protect-string
+	 (format "\\label{%s}" (save-match-data (org-solidify-link-text
+						 (match-string 1)))))
+	(if (match-string 2) "" (match-string 1)))
+       t t)))
 
 
   ;; Delete @<...> constructs
   ;; Delete @<...> constructs
   ;; Thanks to Daniel Clemente for this regexp
   ;; Thanks to Daniel Clemente for this regexp
@@ -2303,7 +2316,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
   ;; FIXME: don't protect footnotes from conversion
   ;; FIXME: don't protect footnotes from conversion
   (when (plist-get org-export-latex-options-plist :footnotes)
   (when (plist-get org-export-latex-options-plist :footnotes)
     (goto-char (point-min))
     (goto-char (point-min))
-    (while (re-search-forward "\\[\\([0-9]+\\)\\]" nil t)
+    (while (and (re-search-forward "\\[\\([0-9]+\\)\\]" nil t)
+		(not (equal (char-before (match-beginning 0)) ?\])))
       (org-if-unprotected
       (org-if-unprotected
        (when (and (save-match-data
        (when (and (save-match-data
 		    (save-excursion (beginning-of-line)
 		    (save-excursion (beginning-of-line)
@@ -2334,9 +2348,9 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
 				      (length footnote-rpl)
 				      (length footnote-rpl)
 				      '(org-protected t) footnote-rpl)
 				      '(org-protected t) footnote-rpl)
 		 (if (org-on-heading-p)
 		 (if (org-on-heading-p)
-                     (setq footnote-rpl
-                           (concat (org-export-latex-protect-string "\\protect")
-                                   footnote-rpl)))
+		     (setq footnote-rpl
+			   (concat (org-export-latex-protect-string "\\protect")
+				   footnote-rpl)))
 		 (insert footnote-rpl)))
 		 (insert footnote-rpl)))
 	     )))))
 	     )))))