how to make org-babel-tangle to take account of :dir property?

Question

I want org babel to take account of the dir header property when i use org-babel-tangle.

E.g.

#+begin_src bash :dir ~/blubb
echo $PWD
#+end_src

or even

#+begin_src bash :dir /ssh:someone@somewhere|sudo:anotherone@somewhere:somedir
echo $(hostname) $USER $PWD
#+end_src

When I do org-babel-tangle it creates a bash file with just the echo statement. I would like it to do a dir change, or wrap it in an ssh statement for the second example. (Same issue when I do org-export: the dir information is lost).

Has anybody found a solution for that?

Answer 1

This patch adds the ability to tangle to the header-args :dir value. I needed this to tangle to remote hosts. I'm sure it's not ready to be upstreamed, but I don't really know the first thing about making it ready, if anyone could provide some insight or guidance, I would appreciate it. It at least worked for me, twice. I have noticed that `file-exists-p` doesn't appear to work over tramp, and I was unable to find a emacs function that did work in my short search.

(defun org-babel-tangle (&optional arg target-file lang-re)
  "Write code blocks to source-specific files.
Extract the bodies of all source code blocks from the current
file into their own source-specific files.  Return the list of files.
With one universal prefix argument, only tangle the block at point.
When two universal prefix arguments, only tangle blocks for the
tangle file of the block at point.
Optional argument TARGET-FILE can be used to specify a default
export file for all source blocks.  Optional argument LANG-RE can
be used to limit the exported source code blocks by languages
matching a regular expression."
  (interactive "P")
  (run-hooks 'org-babel-pre-tangle-hook)
  ;; Possibly Restrict the buffer to the current code block
  (save-restriction
    (save-excursion
      (when (equal arg '(4))
        (let ((head (org-babel-where-is-src-block-head)))
          (if head
            (goto-char head)
            (user-error "Point is not in a source code block"))))
      (let ((block-counter 0)
             (org-babel-default-header-args
               (if target-file
                 (org-babel-merge-params org-babel-default-header-args
                   (list (cons :tangle target-file)))
                 org-babel-default-header-args))
             (tangle-file
               (when (equal arg '(16))
                 (or (cdr (assq :tangle (nth 2 (org-babel-get-src-block-info 'no-eval))))
                   (user-error "Point is not in a source code block"))))
             path-collector)
        (mapc ;; map over file-names
          (lambda (by-fn)
            (let* ((header-args-dir
                     (plist-get
                       (funcall
                         #'read (concat "(" (org-entry-get nil "header-args" t) ")"))
                       :dir))
                    (header-args-dir (if (and header-args-dir
                                           (symbolp header-args-dir))
                                       (prin1-to-string header-args-dir)
                                       header-args-dir))
                    (file-name (if header-args-dir
                                 (concat header-args-dir (car by-fn))
                                 (car by-fn))))
              (when file-name
                (let ((lspecs (cdr by-fn))
                       (fnd (file-name-directory file-name))
                       modes make-dir she-banged lang)
                  ;; drop source-blocks to file
                  ;; We avoid append-to-file as it does not work with tramp.
                  (with-temp-buffer
                    (mapc
                      (lambda (lspec)
                        (let* ((block-lang (car lspec))
                                (spec (cdr lspec))
                                (get-spec (lambda (name) (cdr (assq name (nth 4 spec)))))
                                (she-bang (let ((sheb (funcall get-spec :shebang)))
                                            (when (> (length sheb) 0) sheb)))
                                (tangle-mode (funcall get-spec :tangle-mode)))
                          (unless (string-equal block-lang lang)
                            (setq lang block-lang)
                            (let ((lang-f (org-src-get-lang-mode lang)))
                              (when (fboundp lang-f) (ignore-errors (funcall lang-f)))))
                          ;; if file contains she-bangs, then make it executable
                          (when she-bang
                            (unless tangle-mode (setq tangle-mode #o755)))
                          (when tangle-mode
                            (add-to-list 'modes (org-babel-interpret-file-mode tangle-mode)))
                          ;; Possibly create the parent directories for file.
                          (let ((m (funcall get-spec :mkdirp)))
                            (and m fnd (not (string= m "no"))
                              (setq make-dir t)))
                          ;; Handle :padlines unless first line in file
                          (unless (or (string= "no" (funcall get-spec :padline))
                                    (= (point) (point-min)))
                            (insert "\n"))
                          (when (and she-bang (not she-banged))
                            (insert (concat she-bang "\n"))
                            (setq she-banged t))
                          (org-babel-spec-to-string spec)
                          (setq block-counter (+ 1 block-counter))))
                      lspecs)
                    (when make-dir
                      (make-directory fnd 'parents))
                    (unless
                      (and (file-exists-p file-name)
                        (let ((tangle-buf (current-buffer)))
                          (with-temp-buffer
                            (insert-file-contents file-name)
                            (and
                              (equal (buffer-size)
                                (buffer-size tangle-buf))
                              (= 0
                                (let (case-fold-search)
                                  (compare-buffer-substrings
                                    nil nil nil
                                    tangle-buf nil nil)))))))
                      ;; erase previous file
                      (when (file-exists-p file-name)
                        (delete-file file-name))
                      (write-region nil nil file-name)
                      (mapc (lambda (mode) (set-file-modes file-name mode)) modes))
                    (push file-name path-collector))))))
          (if (equal arg '(4))
            (org-babel-tangle-single-block 1 t)
            (org-babel-tangle-collect-blocks lang-re tangle-file)))
        (message "Tangled %d code block%s from %s" block-counter
          (if (= block-counter 1) "" "s")
          (file-name-nondirectory
            (buffer-file-name
              (or (buffer-base-buffer)
                (current-buffer)
                (and (org-src-edit-buffer-p)
                  (org-src-source-buffer))))))
        ;; run `org-babel-post-tangle-hook' in all tangled files
        (when org-babel-post-tangle-hook
          (mapc
            (lambda (file)
              (org-babel-with-temp-filebuffer file
                (run-hooks 'org-babel-post-tangle-hook)))
            path-collector))
        (run-hooks 'org-babel-tangle-finished-hook)
        path-collector))))

I have only tested this in the with a global property header-args setting :dir with a trailing slash, and without a trailing slash like the example below.

C-c C-c next line to load property

C-c C-c next source block to check if our connection works, we're sudo'd, and our to-be-tangled file doesn't already exist.

whoami
hostname
ls /requires-root 2>&1

C-u C-c C-v C-t next source block to tangle only the single block. (C-u to tangle the single block isn't necessary in this demo because there is only one :tangle'd block, but I prefer to tangle one at a time)

hello world :)

C-c C-c next source block to check that we sucessfully tangled

cat /requires-root

Viola.