-
Notifications
You must be signed in to change notification settings - Fork 0
/
use-block.el
143 lines (116 loc) · 5.37 KB
/
use-block.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
;;; use-block.el --- Integrate Emacs Lisp source code blocks in Org mode into the form of use-package -*- lexical-binding: t; -*-
;; Copyright (c) 2017 Kazuho Sakoda
;; Author: Kazuho Sakoda <[email protected]>
;; Maintainer: Kazuho Sakoda <[email protected]>
;; Version: 0.1.0
;; Keywords: config, init, org
;; Package-Requires: ((emacs "24.3"))
;; URL: https://github.com/hyonhyoro/use-block
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'ob-core)
(defun use-block--make-package-object (&optional alist)
"Make a package object from ALIST.
To get ALIST, use `use-block--get-alist'.
To put a package, use `use-block--put-package'."
(let ((get (lambda () alist))
(put (lambda (name prop sequence)
(let ((old-plist (cdr (assoc name alist))))
(if old-plist
(plist-put old-plist
prop
(append (plist-get old-plist prop) sequence))
(push `(,name . (,prop ,sequence)) alist))))))
(lambda (m) (cond ((eq m 'get) get)
((eq m 'put) put)))))
(defun use-block--get-alist (obj)
"Get an alist from OBJ."
(funcall (funcall obj 'get)))
(defun use-block--put-package (obj name prop sequence)
"Put a package to OBJ.
NAME is the string of the package.
PROP is a symbol and SEQUENCE is a list of expressions."
(funcall (funcall obj 'put) name prop sequence))
(defun use-block--find-header-arg (args)
"Return a header argument whose car is :pre-init or :post-init from ARGS."
(let ((temp))
(dolist (arg args)
(when (memq (car arg) '(:pre-init :post-init))
(setq temp arg)))
temp))
(defun use-block--expand-use-package (form plist)
"Expand use-package FORM according to PLIST.
The property of PLIST is :pre-init and :post-init.
The value of PLIST is a list of expressions."
(let ((pre-init (plist-get plist :pre-init))
(post-init (plist-get plist :post-init)))
`(,@form :init ,@pre-init :config ,@post-init)))
(defun use-block--expand-body (body obj)
"Expand BODY according to OBJ.
If BODY is the form of the use-package, expand it by
`use-block--expand-use-package'."
(if (and (eq 'use-package (car body)) (<= 2 (length body)))
(let* ((name (format "%s" (cadr body)))
(plist (cdr (assoc name (use-block--get-alist obj)))))
(use-block--expand-use-package body plist))
body))
;;;###autoload
(defun use-block-extract-file (file &optional target-file)
"Extract the bodies of source code blocks in FILE.
Source code blocks are extracted with `use-block--expand-body'.
Optional argument TARGET-FILE can be used to specify a default export file
for all source code blocks."
(interactive "fFile to tangle: \nP")
(let ((body-list nil)
(package-object (use-block--make-package-object)))
(org-babel-map-src-blocks file
(let ((lang (org-no-properties lang))
(header-args (org-babel-parse-header-arguments header-args)))
(when (and (string= "emacs-lisp" lang)
(not (string= "no" (cdr (assq :tangle header-args)))))
(let ((header-arg (use-block--find-header-arg header-args))
(src-block (car (read-from-string (concat "(" body ")")))))
(if header-arg
(use-block--put-package package-object
(cdr header-arg)
(car header-arg)
src-block)
(dolist (body src-block) (push body body-list)))))))
(with-temp-file (or target-file
(concat (file-name-sans-extension file) ".el"))
(dolist (body (reverse body-list))
(insert (concat "\n"
(pp-to-string (use-block--expand-body body package-object))))))))
;;;###autoload
(defun use-block-load-file (file &optional compile)
"Load Emacs Lisp source code blocks in the Org-mode FILE.
This function exports the source code using `use-block-extract-file'
and then loads the resulting file using `load-file'.
If COMPILE is Non-nil, byte-compile the exported Emacs Lisp file
before it's loaded."
(interactive "fFile to load: \nP")
(let* ((base-name (file-name-sans-extension file))
(exported-file (concat base-name ".el")))
(unless (and (file-exists-p exported-file)
(file-newer-than-file-p exported-file file))
(use-block-extract-file file exported-file))
(message "%s %s" (if compile
(progn (byte-compile-file exported-file 'load)
"Compiled and loaded")
(progn (load-file exported-file) "Loaded"))
exported-file)))
(provide 'use-block)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; use-block.el ends here