-
Notifications
You must be signed in to change notification settings - Fork 2
/
pjb-org.el
182 lines (165 loc) · 7.15 KB
/
pjb-org.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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
;;;; -*- mode:emacs-lisp;coding:utf-8;lexical-binding:t -*-
;;;;**************************************************************************
;;;;FILE: pjb-org.el
;;;;LANGUAGE: emacs lisp
;;;;SYSTEM: POSIX
;;;;USER-INTERFACE: NONE
;;;;DESCRIPTION
;;;;
;;;; org-mode utilities:
;;;;
;;;; - pjb-org-split-big-blocks splits out big blocks to separate
;;;; files that are then included.
;;;;
;;;;
;;;;AUTHORS
;;;; <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
;;;;MODIFICATIONS
;;;; 2021-10-05 <PJB> Created.
;;;;BUGS
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2021 - 2021
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero 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 Affero General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Affero General Public License
;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;;;**************************************************************************
(require 'cl)
(defun pjb-org-enough-namestring (path base)
"Compute a relative path to go to the `PATH' from a `BASE' directory.
If `PATH' is an absolute pathname,
then it is reduced to a pathname relative to `BASE'
else it's returned as is."
(let ((separator "/")
(here ".")
(back ".."))
(if (string= (subseq path 0 (min 1 (length path))) separator)
(let* ((apath (split-string path separator t))
(abase (split-string base separator t))
(i (mismatch apath abase :test (function string=))))
(if i
(mapconcat (function identity)
(let ((new (or (nthcdr i apath) '(""))))
(dotimes (n (- (length abase) i) new)
(push back new)))
separator)
(concat here separator)))
path)))
(defmacro generate-org-element-reader (&rest fields)
`(progn
,@(mapcar (lambda (field)
`(defun ,(intern (format "org-element-%s" field)) (element)
(getf (second element) ,(intern (format ":%s" field)))))
fields)))
(generate-org-element-reader begin end contents-begin contents-end
name language switches parameters
post-blank post-affiliated parent value switches number-lines
preserve-indent retain-labels use-labels label-fmt)
;; (defun org-element-type (element)
;; (first element))
(defun org-element-subtype (element)
(org-element-language element))
(defun pjb-org-make-document-directory (&optional buffer-or-path)
"Creates a directory named ${buffer-file-name}-inc
If it already exist, then signal a warning.
If it's a file, then signal an error.
Return the path of the new directory."
(cond
((null buffer-or-path)
(pjb-org-make-document-directory (current-buffer)))
((bufferp buffer-or-path)
(pjb-org-make-document-directory (buffer-file-name buffer-or-path)))
((stringp buffer-or-path)
(let ((path (concat (file-name-directory buffer-or-path)
(file-name-base buffer-or-path)
"-inc")))
(cond
((file-directory-p path)
path)
((file-exists-p path)
(error "file %S already exists" path))
(t
(make-directory path t)
path))))
(t
(error "Invalid argument, expected a buffer or a path (string), got a %S: %S"
(type-of buffer-or-path) buffer-or-path))))
;; (pjb-org-make-document-directory "/tmp/bar")
(defun pjb-org-random-uuid ()
"Return a UUID."
;; code here by Christopher Wellons, 2011-11-18.
;; and editted Hideki Saito further to generate all valid variants for "N" in xxxxxxxx-xxxx-Mxxx-Nxxx-xxxxxxxxxxxx format.
(let ((uuidata (md5 (format "%s%s%s%s%s%s%s%s%s%s"
(user-uid)
(emacs-pid)
(system-name)
(user-full-name)
(current-time)
(emacs-uptime)
(garbage-collect)
(buffer-string)
(random)
(recent-keys)))))
(format "%s-%s-4%s-%s%s-%s"
(substring uuidata 0 8)
(substring uuidata 8 12)
(substring uuidata 13 16)
(format "%x" (+ 8 (random 4)))
(substring uuidata 17 20)
(substring uuidata 20 32))))
(defun pjb-org-save-element (element name path)
(let ((text (buffer-substring (org-element-begin element)
(org-element-end element))))
(with-temp-buffer nil
(insert "#### -*- mode:org;coding:utf-8;lexical-binding:t -*-\n\n")
(insert (format "## the %s block\n\n" name))
(insert "\n" text "\n\n")
(write-file path nil))))
(defun pjb-org-insert-include (path type &optional subtype)
"Inserts a #+INCLUDE tag."
(insert "\n")
(insert (format "#+INCLUDE: %S %s" path type ))
(when subtype (insert (format " %s" subtype)))
(insert "\n\n"))
(defun pjb-org-split-big-blocks (&optional maxsize)
"Big blocks (greater than `maxsize`, default 2048) are saved to files, and replaced with #+include elements."
(interactive)
(let ((maxsize (or maxsize 2048))
(path (buffer-file-name)))
(org-block-map
(lambda ()
(let* ((element (org-element-at-point))
(size (- (or (org-element-contents-end element)
(org-element-end element))
(or (org-element-contents-begin element)
(org-element-begin element)))))
(message "pjb-org-split-big-blocks point = %s ; name = %S ; subtype = %S" (point) (org-element-name element) (org-element-subtype element))
(when (< maxsize size)
(let* ((dir-path (pjb-org-make-document-directory path))
;; not yet: we need to clean up the name.
;; (ele-name (let ((id (pjb-org-random-uuid))
;; (name (org-element-name element)))
;; (if name
;; (format "%s-%s.org" id name)
;; (format "%s.org" id))))
(ele-name (pjb-org-random-uuid))
(ele-path (concat (file-name-as-directory dir-path)
(format "%s.org" ele-name))))
(pjb-org-save-element element ele-name ele-path)
(delete-region (org-element-begin element) (org-element-end element))
(pjb-org-insert-include (pjb-org-enough-namestring ele-path (file-name-directory path))
(org-element-type element)
(org-element-subtype element)))))))))
(provide 'pjb-org)
;;;; THE END ;;;;