-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathorp-ok-utils.el
149 lines (138 loc) · 6.17 KB
/
orp-ok-utils.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
;;; orp-ok-utils.el --- Org Roam Plugin Okome Studio Utilities -*- lexical-binding: t -*-
;;
;; Copyright (C) 2024 Taro Sato
;;
;;; License:
;;
;; 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 <https://www.gnu.org/licenses/>.
;;
;;; Commentary:
;;
;; This module provides a collection of utility functions.
;;
;;; Code:
(require 'dash)
(defun orp-ok-ensure-all-headings-with-ids ()
"Ensure all headings have IDs."
(interactive)
(save-excursion
(goto-char (point-max))
(while (outline-previous-heading)
(org-id-get-create))))
(defun orp-ok-extract-subtree-to-subdir ()
"Extract the subtree to a new Org file within the current directory."
(interactive)
(save-excursion
(beginning-of-buffer)
(let* ((parent-node (org-roam-node-at-point))
(parent-file (org-roam-node-file parent-node))
;; Make the parent directory path relative to `org-roam-directory'
(directory (file-name-directory
(string-replace org-roam-directory
""
parent-file))))
(setq org-roam-extract-new-file-path (file-name-concat directory
"${slug}.org"))))
(call-interactively #'org-roam-extract-subtree))
(defun orp-ok-filetags ()
"Get filetags from the current node."
(remove-if (lambda (x) (string= "" x))
(string-split (cadar (org-collect-keywords '("filetags"))) ":")))
(defun orp-ok-interpolate-leaf-nodes-for-export ()
"Extrapolate leaf heading nodes for export.
When invoked within an Org buffer, the headings are traversed in
its copy, each leaf heading expanded with the body of the target
node."
(interactive)
(let ((tmp-buffer (org-export-copy-buffer)))
(with-current-buffer tmp-buffer
(beginning-of-buffer)
(while (outline-next-heading)
(while (org-goto-first-child) t)
(end-of-line)
(backward-char)
(when (link-hint--org-link-at-point-p) ; missing function?
(let ((has-content nil))
(save-excursion
(org-open-at-point +1)
(beginning-of-line)
(if (eq ?* (char-after))
(setq has-content t))
(with-current-buffer (current-buffer)
(org-preserve-local-variables
(let* ((end (org-end-of-subtree t t)))
(previous-line)
(org-back-to-heading)
(copy-region-as-kill (re-search-forward "^\\s-*$") end)))
(kill-buffer)))
(end-of-line)
(org-return-and-maybe-indent)
(when has-content
(org-yank))))))
(switch-to-buffer tmp-buffer)))
(defun orp-ok-link-get (&optional arg)
"Extract URL from org-mode link and add it to kill ring.
See emacs.stackexchange.com/a/60555/599."
(interactive "P")
(let* ((link (org-element-lineage (org-element-context) '(link) t))
(type (org-element-property :type link))
(url (org-element-property :path link))
(url (concat type ":" url)))
(kill-new url)))
(defun orp-ok-string-to-org-slug (title)
"Turn TITLE into its '-'-delimited slug.
This function is used in place of `org-roam-node-slug'."
(let (;; Combining Diacritical Marks
;; https://www.unicode.org/charts/PDF/U0300.pdf
(slug-trim-chars '(768 ; U+0300 COMBINING GRAVE ACCENT
769 ; U+0301 COMBINING ACUTE ACCENT
770 ; U+0302 COMBINING CIRCUMFLEX ACCENT
771 ; U+0303 COMBINING TILDE
772 ; U+0304 COMBINING MACRON
774 ; U+0306 COMBINING BREVE
775 ; U+0307 COMBINING DOT ABOVE
776 ; U+0308 COMBINING DIAERESIS
777 ; U+0309 COMBINING HOOK ABOVE
778 ; U+030A COMBINING RING ABOVE
779 ; U+030B COMBINING DOUBLE ACUTE ACCENT
780 ; U+030C COMBINING CARON
795 ; U+031B COMBINING HORN
803 ; U+0323 COMBINING DOT BELOW
804 ; U+0324 COMBINING DIAERESIS BELOW
805 ; U+0325 COMBINING RING BELOW
807 ; U+0327 COMBINING CEDILLA
813 ; U+032D COMBINING CIRCUMFLEX ACCENT BELOW
814 ; U+032E COMBINING BREVE BELOW
816 ; U+0330 COMBINING TILDE BELOW
817))) ; U+0331 COMBINING MACRON BELOW
(cl-flet* ((nonspacing-mark-p (char)
(memq char slug-trim-chars))
(strip-nonspacing-marks (s)
(string-glyph-compose
(apply #'string
(seq-remove #'nonspacing-mark-p
(string-glyph-decompose s)))))
(cl-replace (title pair)
(replace-regexp-in-string (car pair) (cdr pair) title)))
(let* ((pairs `(; convert anything not alphanumeric
("[^[:alnum:][:digit:]]" . "-")
("--*" . "-") ; remove sequential underscores
("^-" . "") ; remove starting underscore
("-$" . ""))) ; remove ending underscore
(slug (-reduce-from #'cl-replace
(strip-nonspacing-marks title)
pairs)))
(downcase slug)))))
(provide 'orp-ok-utils)
;;; orp-ok-utils.el ends here