blag/util.el
2020-04-17 16:55:54 -04:00

59 lines
1.9 KiB
EmacsLisp

;; See still:
;; command-line-args
(require 'ox-hugo)
(require 'cl)
;; Predicate for if 'el' is a headline that has some tag.
(defun element-has-tag-p (el tag)
(if (not (eq (org-element-type el) 'headline))
nil
(let* ((tags (org-element-property :tags el))
(match_fn (lambda (tag_test) (string= tag tag_test)))
(match (mapcar match_fn tags)))
(some 'identity match))))
;; Creates a new buffer of the given name, and write the contents of
;; some org mode AST into it (e.g. from org-element-parse-buffer)
(defun interpret-to-buffer (name tree)
(let ((buf (generate-new-buffer name)))
(with-current-buffer buf
(org-mode)
(mapc 'insert (org-element-interpret-data tree)))
buf))
;; Modifies 'tree' destructively to remove any headline that contains
;; 'tag'.
(defun filter-out-tag (tree tag)
(if (let ((el-type (org-element-type tree)))
(not (or (eq el-type 'headline)
(eq el-type 'org-data))))
tree
(if (element-has-tag-p tree tag)
;; has tag - stop recursing here:
nil
;; lacks tag - keep searching:
(org-element-set-contents
tree (mapcar (lambda (el) (filter-out-tag el tag))
(org-element-contents tree))))))
;; Produce a new buffer
(defun filter-buffer (fname newbuf tag)
(let* ((buf (find-file-noselect fname))
(tree (with-current-buffer buf (org-element-parse-buffer)))
(tree (filter-out-tag tree tag)))
(interpret-to-buffer newbuf tree)))
(defun filter-org-tag (tag src-name dst-name)
(with-current-buffer (filter-buffer src-name "tmp.org" tag)
(write-file dst-name)))
;; (filter-out-tag-from-file "/Users/hodapp/log_tmp2.org" "tmp.org" "dream")
;; (filter-org-tag "dream" "/Users/hodapp/log_tmp2.org" "/Users/hodapp/log_tmp_filter.org")
(defun export-run ()
(progn
(find-file "./log_tmp.org")
(org-hugo-export-as-md)
(write-file "./log_tmp.md")))