116 lines
4.5 KiB
Bash
Executable File
116 lines
4.5 KiB
Bash
Executable File
#!/usr/bin/env bash
|
|
":"; exec emacs --quick --script "$0" -- "$@" # -*- mode: emacs-lisp; lexical-binding: t; -*-
|
|
;;; bin/org-tangle
|
|
|
|
;; Tangles source blocks from org files. Debug/info messages are directed to
|
|
;; stderr and can be ignored.
|
|
;;
|
|
;; -l/--lang LANG
|
|
;; Only include blocks in the specified language (e.g. emacs-lisp).
|
|
;; -a/--all
|
|
;; Tangle all blocks by default (unless it has :tangle nil set or a
|
|
;; :notangle: tag)
|
|
;; -t/--tag TAG
|
|
;; --and TAG
|
|
;; --or TAG
|
|
;; Only include blocks in trees that have these tags. Combine multiple --and
|
|
;; and --or's, or just use --tag (implicit --and).
|
|
;; -p/--print
|
|
;; Prints tangled code to stdout instead of to files
|
|
;;
|
|
;; Usage: org-tangle [[-l|--lang] LANG] some-file.org another.org
|
|
;; Examples:
|
|
;; org-tangle -l sh modules/some/module/README.org > install_module.sh
|
|
;; org-tangle -l sh modules/lang/go/README.org | sh
|
|
;; org-tangle --and tagA --and tagB my/literate/config.org
|
|
|
|
(require 'cl-lib)
|
|
(require 'ob-tangle)
|
|
|
|
(defun *org-babel-tangle (orig-fn &rest args)
|
|
"Don't write tangled blocks to files, print them to stdout."
|
|
(cl-letf (((symbol-function 'write-region)
|
|
(lambda (start end filename &optional append visit lockname mustbenew)
|
|
(princ (buffer-string)))))
|
|
(apply orig-fn args)))
|
|
|
|
(defun *org-babel-tangle-collect-blocks (&optional language tangle-file)
|
|
"Like `org-babel-tangle-collect-blocks', but will ignore blocks that are in
|
|
trees with the :notangle: tag."
|
|
(let ((counter 0) last-heading-pos blocks)
|
|
(org-babel-map-src-blocks (buffer-file-name)
|
|
(let ((current-heading-pos
|
|
(org-with-wide-buffer
|
|
(org-with-limited-levels (outline-previous-heading)))))
|
|
(if (eq last-heading-pos current-heading-pos) (cl-incf counter)
|
|
(setq counter 1)
|
|
(setq last-heading-pos current-heading-pos)))
|
|
(unless (org-in-commented-heading-p)
|
|
(require 'org)
|
|
(let* ((tags (org-get-tags-at))
|
|
(info (org-babel-get-src-block-info 'light))
|
|
(src-lang (nth 0 info))
|
|
(src-tfile (cdr (assq :tangle (nth 2 info)))))
|
|
(cond ((member "notangle" tags))
|
|
|
|
((and (or or-tags and-tags)
|
|
(or (not and-tags)
|
|
(let ((a (cl-intersection and-tags tags :test #'string=))
|
|
(b and-tags))
|
|
(not (or (cl-set-difference a b :test #'equal)
|
|
(cl-set-difference b a :test #'equal)))))
|
|
(or (not or-tags)
|
|
(cl-intersection or-tags tags :test #'string=))
|
|
t))
|
|
|
|
((or (not (or all-blocks src-tfile))
|
|
(string= src-tfile "no") ; tangle blocks by default
|
|
(and tangle-file (not (equal tangle-file src-tfile)))
|
|
(and language (not (string= language src-lang)))))
|
|
|
|
;; Add the spec for this block to blocks under its language.
|
|
((let ((by-lang (assoc src-lang blocks))
|
|
(block (org-babel-tangle-single-block counter)))
|
|
(if by-lang
|
|
(setcdr by-lang (cons block (cdr by-lang)))
|
|
(push (cons src-lang (list block)) blocks))))))))
|
|
;; Ensure blocks are in the correct order.
|
|
(mapcar (lambda (b) (cons (car b) (nreverse (cdr b)))) blocks)))
|
|
(advice-add #'org-babel-tangle-collect-blocks
|
|
:override #'*org-babel-tangle-collect-blocks)
|
|
|
|
(defvar all-blocks nil)
|
|
(defvar and-tags nil)
|
|
(defvar or-tags nil)
|
|
(let (lang srcs and-tags or-tags)
|
|
(pop argv)
|
|
(while argv
|
|
(let ((arg (pop argv)))
|
|
(pcase arg
|
|
((or "-h" "--help")
|
|
;; TODO
|
|
(error "No help yet, sorry!"))
|
|
((or "-a" "--all")
|
|
(setq all-blocks t))
|
|
((or "--lang" "-l")
|
|
(setq lang (pop argv)))
|
|
((or "-p" "--print")
|
|
(advice-add #'org-babel-tangle :around #'*org-babel-tangle))
|
|
((or "-t" "--tag" "--and")
|
|
(push (pop argv) and-tags))
|
|
("--or"
|
|
(push (pop argv) or-tags))
|
|
((guard (string-match-p "^--lang=" arg))
|
|
(setq lang (cadr (split-string arg "=" t t))))
|
|
((guard (file-directory-p arg))
|
|
(setq srcs
|
|
(append (directory-files-recursively arg "\\.org$")
|
|
srcs)))
|
|
((guard (file-exists-p arg))
|
|
(push arg srcs))
|
|
(_ (error "Unknown option or file: %s" arg)))))
|
|
|
|
(dolist (file srcs)
|
|
(org-babel-tangle-file file nil lang))
|
|
(kill-emacs 0))
|