Browse Source

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

Carsten Dominik 15 years ago
parent
commit
facd02f812

+ 1 - 1
contrib/babel/lisp/langs/org-babel-clojure.el

@@ -119,7 +119,7 @@ Emacs-lisp table, otherwise return the results as a string."
 specifying a var of the same value."
   (if (listp var)
       (format "'%s" var)
-    (format "%s" var)))
+    (format "%S" var)))
 
 (defun org-babel-clojure-build-full-form (body vars)
   "Construct a clojure let form with vars as the let vars"

+ 79 - 4
contrib/babel/lisp/langs/org-babel-latex.el

@@ -28,9 +28,9 @@
 
 ;; Org-Babel support for evaluating LaTeX source code.
 ;;
-;; Currently on evaluation this returns raw LaTeX code, however at
-;; some point it *may* (it may not) make sense to have LaTeX blocks
-;; compile small pdfs on evaluation.
+;; Currently on evaluation this returns raw LaTeX code, unless a :file
+;; header argument is given in which case small png or pdf files will
+;; be created directly form the latex source code.
 
 ;;; Code:
 (require 'org-babel)
@@ -54,7 +54,82 @@ called by `org-babel-execute-src-block'."
                  (if (stringp (cdr pair))
                      (cdr pair) (format "%S" (cdr pair)))
                  body))) (second (org-babel-process-params params)))
-  body)
+  (if (cdr (assoc :file params))
+      (let ((out-file (cdr (assoc :file params)))
+            (tex-file (make-temp-file "org-babel-latex" nil ".tex"))
+            (pdfheight (cdr (assoc :pdfheight params)))
+            (pdfwidth (cdr (assoc :pdfwidth params)))
+            (in-buffer (not (string= "no" (cdr (assoc :buffer params)))))
+            (org-export-latex-packages-alist
+             (append (cdr (assoc :packages params))
+                     org-export-latex-packages-alist)))
+        (cond
+         ((string-match "\\.png$" out-file)
+          (org-create-formula-image
+           body out-file org-format-latex-options in-buffer))
+         ((string-match "\\.pdf$" out-file)
+          (org-babel-latex-body-to-tex-file tex-file body pdfheight pdfwidth)
+          (delete-file out-file)
+          (rename-file (org-babel-latex-tex-to-pdf tex-file) out-file))
+         ((string-match "\\.\\([^\\.]+\\)$" out-file)
+          (error
+           (message "can not create %s files, please specify a .png or .pdf file"
+                    (match-string 1 out-file)))))
+        out-file)
+    body))
+
+(defun org-babel-latex-body-to-tex-file (tex-file body &optional height width)
+  "Extracted from `org-create-formula-image' in org.el."
+  (with-temp-file tex-file
+    (insert org-format-latex-header
+            (if org-export-latex-packages-alist
+                (concat "\n"
+                        (mapconcat (lambda(p)
+                                     (if (equal "" (car p))
+                                         (format "\\usepackage{%s}" (cadr p))
+                                       (format "\\usepackage[%s]{%s}"
+                                               (car p) (cadr p))))
+                                   org-export-latex-packages-alist "\n"))
+              "")
+            (if height (concat "\n" (format "\\pdfpageheight %s" height)) "")
+            (if width (concat "\n" (format "\\pdfpagewidth %s" width)) "")
+            (if org-format-latex-header-extra
+                (concat "\n" org-format-latex-header-extra)
+              "")
+            "\n\\begin{document}\n" body "\n\\end{document}\n")))
+
+(defun org-babel-latex-tex-to-pdf (tex-file)
+  "Extracted from `org-export-as-pdf' in org-latex.el."
+  (let* ((wconfig (current-window-configuration))
+         (default-directory (file-name-directory tex-file))
+         (base (file-name-sans-extension tex-file))
+         (pdffile (concat base ".pdf"))
+         (cmds org-latex-to-pdf-process)
+         (outbuf (get-buffer-create "*Org PDF LaTeX Output*"))
+         cmd)
+    (if (and cmds (symbolp cmds))
+        (funcall cmds tex-file)
+      (while cmds
+        (setq cmd (pop cmds))
+        (while (string-match "%b" cmd)
+          (setq cmd (replace-match
+                     (save-match-data
+                       (shell-quote-argument base))
+                     t t cmd)))
+        (while (string-match "%s" cmd)
+          (setq cmd (replace-match
+                     (save-match-data
+                       (shell-quote-argument tex-file))
+                     t t cmd)))
+        (shell-command cmd outbuf outbuf)))
+    (if (not (file-exists-p pdffile))
+        (error "PDF file was not produced from %s" tex-file)
+      (set-window-configuration wconfig)
+      (when org-export-pdf-remove-logfiles
+        (dolist (ext org-export-pdf-logfiles)
+          (setq tex-file (concat base "." ext))
+          (and (file-exists-p tex-file) (delete-file tex-file))))
+      pdffile)))
 
 (defun org-babel-prep-session:latex (session params)
   (error "Latex does not support sessions"))

+ 16 - 5
contrib/babel/lisp/langs/org-babel-sh.el

@@ -36,6 +36,10 @@
 
 (add-to-list 'org-babel-tangle-langs '("sh" "sh" "#!/usr/bin/env sh"))
 
+(defvar org-babel-sh-command "sh"
+  "Command used to invoke a shell.  This will be passed to
+  `shell-command-on-region'")
+
 (defun org-babel-execute:sh (body params)
   "Execute a block of Shell commands with org-babel.  This
 function is called by `org-babel-execute-src-block'."
@@ -44,12 +48,13 @@ function is called by `org-babel-execute-src-block'."
          (session (org-babel-sh-initiate-session (first processed-params)))
          (vars (second processed-params))
          (result-type (fourth processed-params))
+         (sep (cdr (assoc :separator params)))
          (full-body (concat
                      (mapconcat ;; define any variables
                       (lambda (pair)
                         (format "%s=%s"
                                 (car pair)
-                                (org-babel-sh-var-to-sh (cdr pair))))
+                                (org-babel-sh-var-to-sh (cdr pair) sep)))
                       vars "\n") "\n" body "\n\n"))) ;; then the source block body
     (org-babel-sh-evaluate session full-body result-type)))
 
@@ -57,11 +62,12 @@ function is called by `org-babel-execute-src-block'."
   "Prepare SESSION according to the header arguments specified in PARAMS."
   (let* ((session (org-babel-sh-initiate-session session))
          (vars (org-babel-ref-variables params))
+         (sep (cdr (assoc :separator params)))
          (var-lines (mapcar ;; define any variables
                      (lambda (pair)
                        (format "%s=%s"
                                (car pair)
-                               (org-babel-sh-var-to-sh (cdr pair))))
+                               (org-babel-sh-var-to-sh (cdr pair) sep)))
                      vars)))
     (org-babel-comint-in-buffer session
       (mapc (lambda (var)
@@ -80,11 +86,16 @@ function is called by `org-babel-execute-src-block'."
 
 ;; helper functions
 
-(defun org-babel-sh-var-to-sh (var)
+(defun org-babel-sh-var-to-sh (var &optional sep)
   "Convert an elisp var into a string of shell commands
 specifying a var of the same value."
   (if (listp var)
-      (concat "[" (mapconcat #'org-babel-sh-var-to-sh var ", ") "]")
+      (flet ((deep-string (el)
+                          (if (listp el)
+                              (mapcar #'deep-string el)
+                            (format "%S" el))))
+        (format "$(cat <<BABEL_TABLE\n%s\nBABEL_TABLE\n)"
+                (orgtbl-to-generic (deep-string var) (list :sep (or sep "\t")))))
     (format "%S" var)))
 
 (defun org-babel-sh-table-or-results (results)
@@ -122,7 +133,7 @@ last statement in BODY."
         (with-temp-buffer
           (insert body)
           ;; (message "buffer=%s" (buffer-string)) ;; debugging
-          (shell-command-on-region (point-min) (point-max) "sh" 'replace)
+          (shell-command-on-region (point-min) (point-max) org-babel-sh-command 'replace)
 	  (case result-type
 	    (output (buffer-string))
 	    (value ;; TODO: figure out how to return non-output values from shell scripts

+ 41 - 38
contrib/babel/lisp/org-babel-tangle.el

@@ -48,8 +48,8 @@ file using `load-file'."
   (flet ((age (file)
               (time-to-seconds
                (time-subtract (current-time)
-                              (sixth (file-attributes
-                                      (file-truename file)))))))
+                              (sixth (or (file-attributes (file-truename file))
+                                         (file-attributes file)))))))
     (let* ((base-name (file-name-sans-extension file))
            (exported-file (concat base-name ".el")))
       ;; tangle if the org-mode file is newer than the elisp file
@@ -95,41 +95,42 @@ exported source code blocks by language."
                 she-banged)
            (mapc
             (lambda (spec)
-              (let* ((tangle (cdr (assoc :tangle (third spec))))
-                     (base-name (or (cond
-                                     ((string= "yes" tangle)
-                                      (file-name-sans-extension (buffer-file-name)))
-                                     ((string= "no" tangle) nil)
-                                     ((> (length tangle) 0) tangle))
-                                    target-file))
-                     (file-name (when base-name
-                                  (if (and ext
-                                          (string= base-name
-                                                   (file-name-sans-extension base-name)))
-                                     (concat base-name "." ext) base-name))))
-                ;; ;; debugging
-                ;; (message "tangle=%S base-name=%S file-name=%S"
-                ;;          tangle base-name file-name)
-                (when file-name
-                  ;; delete any old versions of file
-                  (when (and (file-exists-p file-name)
-                             (not (member file-name path-collector)))
-                    (delete-file file-name))
-                  ;; drop source-block to file
-                  (with-temp-buffer
-                    (funcall lang-f)
-                    (when (and she-bang (not (member file-name she-banged)))
-                      (insert (concat she-bang "\n"))
-                      (setq she-banged (cons file-name she-banged)))
-                    (when commentable
-                      (comment-region
-                       (point) (progn (insert "generated by org-babel-tangle") (point)))
-                      (move-end-of-line nil))
-                    (org-babel-spec-to-string spec)
-                    (append-to-file nil nil file-name))
-                  ;; update counter
-                  (setq block-counter (+ 1 block-counter))
-                  (add-to-list 'path-collector file-name))))
+              (flet ((get-spec (name)
+                               (cdr (assoc name (third spec)))))
+                (let* ((tangle (get-spec :tangle))
+                       (she-bang (if (> (length (get-spec :shebang)) 0)
+                                     (get-spec :shebang)
+                                   she-bang))
+                       (base-name (or (cond
+                                       ((string= "yes" tangle)
+                                        (file-name-sans-extension (buffer-file-name)))
+                                       ((string= "no" tangle) nil)
+                                       ((> (length tangle) 0) tangle))
+                                      target-file))
+                       (file-name (when base-name
+                                    ;; decide if we want to add ext to base-name
+                                    (if (and ext (not (string= (file-name-extension base-name) ext)))
+                                        (concat base-name "." ext) base-name))))
+                  ;; ;; debugging
+                  ;; (message
+                  ;;  "tangle=%S base-name=%S file-name=%S she-bang=%S commentable=%s"
+                  ;;  tangle base-name file-name she-bang commentable)
+                  (when file-name
+                    ;; delete any old versions of file
+                    (when (and (file-exists-p file-name)
+                               (not (member file-name path-collector)))
+                      (delete-file file-name))
+                    ;; drop source-block to file
+                    (with-temp-buffer
+                      (funcall lang-f)
+                      (when (and she-bang (not (member file-name she-banged)))
+                        (insert (concat she-bang "\n"))
+                        (setq she-banged (cons file-name she-banged)))
+                      (org-babel-spec-to-string spec)
+                      (append-to-file nil nil file-name))
+                    ;; update counter
+                    (setq block-counter (+ 1 block-counter))
+                    (add-to-list 'path-collector file-name)))))
             specs)))
        (org-babel-tangle-collect-blocks lang))
       (message "tangled %d code block%s" block-counter
@@ -197,7 +198,9 @@ form
     (let ((link (first spec))
           (source-name (second spec))
           (body (fourth spec))
-          (commentable (not (fifth spec))))
+          (commentable (not (if (> (length (cdr (assoc :comments (third spec)))) 0)
+                                (string= (cdr (assoc :comments (third spec))) "no")
+                              (fifth spec)))))
       (insert-comment (format "[[%s][%s]]" (org-link-escape link) source-name))
       (insert (format "%s" (org-babel-chomp body)))
       (insert-comment (format "%s ends here" source-name)))))

+ 15 - 8
contrib/babel/lisp/org-babel.el

@@ -835,7 +835,7 @@ parameters when merging lists."
 	   ("output" "value")))
 	(exports-exclusive-groups
 	 '(("code" "results" "both" "none")))
-	params results exports tangle noweb cache vars var ref)
+	params results exports tangle noweb cache vars var ref shebang comments)
     (flet ((e-merge (exclusive-groups &rest result-params)
                     ;; maintain exclusivity of mutually exclusive parameters
                     (let (output)
@@ -879,22 +879,29 @@ parameters when merging lists."
                          (setq tangle (or (list (cdr pair)) tangle)))
                         (:noweb
                          (setq noweb (e-merge '(("yes" "no"))
-                                               noweb (split-string (or (cdr pair) "")))))
+                                              noweb (split-string (or (cdr pair) "")))))
                         (:cache
                          (setq cache (e-merge '(("yes" "no"))
                                               cache (split-string (or (cdr pair) "")))))
+                        (:shebang ;; take the latest -- always overwrite
+                         (setq shebang (or (list (cdr pair)) shebang)))
+                        (:comments
+                         (setq comments (e-merge '(("yes" "no"))
+                                                 comments (split-string (or (cdr pair) "")))))
                         (t ;; replace: this covers e.g. :session
                          (setq params (cons pair (assq-delete-all (car pair) params))))))
                     plist))
             plists))
     (setq vars (mapcar (lambda (pair) (format "%s=%s" (car pair) (cdr pair))) vars))
     (while vars (setq params (cons (cons :var (pop vars)) params)))
-    (cons (cons :cache (mapconcat 'identity cache " "))
-          (cons (cons :noweb (mapconcat 'identity noweb " "))
-                (cons (cons :tangle (mapconcat 'identity tangle " "))
-                      (cons (cons :exports (mapconcat 'identity exports " "))
-                            (cons (cons :results (mapconcat 'identity results " "))
-                                  params)))))))
+    (cons (cons :comments (mapconcat 'identity comments " "))
+          (cons (cons :shebang (mapconcat 'identity shebang " "))
+                (cons (cons :cache (mapconcat 'identity cache " "))
+                      (cons (cons :noweb (mapconcat 'identity noweb " "))
+                            (cons (cons :tangle (mapconcat 'identity tangle " "))
+                                  (cons (cons :exports (mapconcat 'identity exports " "))
+                                        (cons (cons :results (mapconcat 'identity results " "))
+                                              params)))))))))
 
 (defun org-babel-expand-noweb-references (&optional info parent-buffer)
   "This function expands Noweb style references in the body of