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
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
|
;;; +org.el --- -*- lexical-binding: t -*-
;;; Org Return DWIM
;; [[https://github.com/alphapapa/unpackaged.el][unpackaged]] and [[http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/][kitchin]]
(defun +org-element-descendant-of (type element)
"Return non-nil if ELEMENT is a descendant of TYPE.
TYPE should be an element type, like `item' or `paragraph'.
ELEMENT should be a list like that returned by `org-element-context'."
;; MAYBE: Use `org-element-lineage'.
(when-let* ((parent (org-element-property :parent element)))
(or (eq type (car parent))
(+org-element-descendant-of type parent))))
(defun +org-return-dwim (&optional prefix)
"A helpful replacement for `org-return'.
With PREFIX, call `org-return'."
(interactive "P")
;; Auto-fill if enabled
(when auto-fill-function
(dolist (func (ensure-list auto-fill-function))
(funcall func)))
(cond
(prefix ; Handle prefix
(pcase prefix
('(4) (newline))
('(16) (newline 2))
(_ (newline prefix))))
((and org-return-follows-link ; Open link
(eq 'link (car (org-element-context))))
(org-open-at-point-global))
((org-at-heading-p) ; Open a line after a heading
(let ((heading-start (org-entry-beginning-position)))
(goto-char (org-entry-end-position))
(cond ((and (org-at-heading-p)
(= heading-start (org-entry-beginning-position)))
;; Entry ends on its heading, so add 2 newlines
(end-of-line)
(newline 2))
(t
;; Entry ends after its heading, so back up
(forward-line -1)
(end-of-line)
(when (org-at-heading-p)
(forward-line)
(newline)
(forward-line -1))
(while (not (looking-back (rx (repeat 3 (seq (optional blank) "\n")))
nil))
(newline))
(forward-line -1)))))
((org-at-item-checkbox-p) ; Insert a new checkbox item
(end-of-line)
(org-insert-todo-heading nil))
((org-in-item-p) ; Insert a new list item
(let* ((context (org-element-context))
(first-item-p (eq 'plain-list (car context)))
(itemp (eq 'item (car context)))
(emptyp (or
;; This (regular) list item is empty
(eq (org-element-property :contents-begin context)
(org-element-property :contents-end context))
;; This (definition) list item is empty
(looking-at " *::")))
(item-child-p (+org-element-descendant-of 'item context)))
(cond ((and itemp emptyp)
(delete-region (line-beginning-position) (line-end-position))
(newline))
((or first-item-p
(and itemp (not emptyp))
item-child-p)
(org-end-of-item)
(org-insert-item))
(t
(delete-region (line-beginning-position) (line-end-position))
(newline)))))
((and (fboundp 'org-inlinetask-in-task-p) ; Don't insert a new heading with
(org-inlinetask-in-task-p)) ; inline tasks
(org-return))
((org-at-table-p) ; Insert a new org-table row
(cond ((save-excursion
(beginning-of-line)
(cl-loop with end = (line-end-position)
for cell = (org-element-table-cell-parser)
always (equal (org-element-property :contents-begin cell)
(org-element-property :contents-end cell))
while (re-search-forward "|" end t)))
;; Empty row: end the table
(delete-region (line-beginning-position) (line-end-position))
(org-return))
(t
;; Non-empty row
(org-return))))
(t ; Otherwise---just call `org-return'.
(org-return))))
(defun +org-table-copy-down|+org-return (&optional n)
"Call `org-table-copy-down' or `+org-return' depending on context."
(interactive "P")
(if (org-table-check-inside-data-field 'noerror)
(org-table-copy-down (or n 1))
(+org-return-dwim n)))
;;; Copy org trees as HTML
;; Thanks to Oleh Krehel, via [[https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard][this StackExchange question]].
(defun +org-export-clip-to-html
(&optional async subtreep visible-only body-only ext-plist post-process)
"Export region to HTML, and copy it to the clipboard.
Arguments ASYNC, SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST,
and POST-PROCESS are passed to `org-export-to-file'."
(interactive) ; XXX: hould this be interactive?
(message "Exporting Org to HTML...")
(let ((org-tmp-file "/tmp/org.html"))
(org-export-to-file 'html org-tmp-file
async subtreep visible-only body-only ext-plist post-process)
(start-process "xclip" "*xclip*"
"xclip" "-verbose"
"-i" org-tmp-file
"-t" "text/html"
"-selection" "clipboard"))
(message "Exporting Org to HTML...done."))
;; Specialized functions
(defun +org-export-clip-subtree-to-html ()
"Export current subtree to HTML."
(interactive)
(+org-export-clip-to-html nil :subtree))
;;; Unsmartify quotes and dashes and stuff.
(defun +org-unsmartify ()
"Replace \"smart\" punctuation with their \"dumb\" counterparts."
(interactive)
(save-excursion
(goto-char (point-min))
(while (re-search-forward "[“”‘’–—]" nil t)
(let ((replace (pcase (match-string 0)
((or "“" "”") "\"")
((or "‘" "’") "'")
("–" "--")
("—" "---"))))
(replace-match replace nil nil)))))
;;; A ... different ... `org-open-at-point-dwim'
;; I honestly don't remember what the difference is between this and the
;; O.G. one is.. hopefully this one fixes annoying stupid problems.
(defun +org-open-at-point-dwim (&optional arg)
"Open thing at point, or if there isn't something, list things."
(interactive "P")
(save-excursion
(let* ((this-char-type (org-element-type (org-element-context)))
(prev-char-type (ignore-errors
(save-excursion
(backward-char)
(org-element-type (org-element-context)))))
(types '(citation citation-reference clock comment comment-block
footnote-definition footnote-reference headline
inline-src-block inlinetask keyword link
node-property planning src-block timestamp))
(type this-char-type))
(when (and (memq this-char-type types) (memq prev-char-type types))
(backward-char)
(setq type prev-char-type)) ; what the fuckckckckck
;; Okay, so this ^ is pretty janky and doesn't /really/ work that well,
;; especially on DEADLINE (and probably SCHEDULED) lines. However, since
;; I really just want to open the list of URLs /most of the time/, I'm
;; fixing it like this instead.
(unless (and (memq type types)
(ignore-errors (org-open-at-point arg)
t))
(while (not
(progn
(org-back-to-heading)
(car (org-offer-links-in-entry (current-buffer) (point) 1))))
(org-up-heading-all 1))
(org-open-at-point arg)))))
;;; Skip invisible shit when moving around
(defun +org-ignore-invisible (fn &rest r)
":around ADVICE to ignore invisible text in `org-mode' buffers."
;; TODO: generalize to all modes
(cond ((and (derived-mode-p #'org-mode)
(org-invisible-p))
(while (org-invisible-p)
(forward-char))
(apply fn r))
(t (apply fn r))))
;;; Faces
;;; Better org faces
;; see `org-emphasis-alist'
(defface org-bold '((t (:weight bold)))
"Bold face in `org-mode' documents.")
(defface org-italic '((t (:slant italic)))
"Italic face in `org-mode' documents.")
(defface org-underline '((t (:underline t)))
"Underline face in `org-mode' documents.")
(defface org-strikethrough '((t (:strike-through t)))
"Strike-through face for `org-mode' documents.")
;; `org-verbatim' and `org-code' are apparently already things, so we skip them
;; here.
(provide '+org)
|
