summary refs log tree commit diff stats
path: root/lisp
diff options
context:
space:
mode:
authorCase Duckworth2021-09-13 22:09:56 -0500
committerCase Duckworth2021-09-13 22:09:56 -0500
commit47f1bffa23c5e1f4302dc1ec3d9a92a864d9b792 (patch)
tree8b3dfb4259ff529af00035b1fac5e388055c85e5 /lisp
parentMerge branch 'main' of https://tildegit.org/acdw/emacs (diff)
downloademacs-47f1bffa23c5e1f4302dc1ec3d9a92a864d9b792.tar.gz
emacs-47f1bffa23c5e1f4302dc1ec3d9a92a864d9b792.zip
Make acdw-org.el "Emacs News"-worthy
Hi sachac!
Diffstat (limited to 'lisp')
-rw-r--r--lisp/acdw-org.el110
1 files changed, 75 insertions, 35 deletions
diff --git a/lisp/acdw-org.el b/lisp/acdw-org.el index 63f6516..f210301 100644 --- a/lisp/acdw-org.el +++ b/lisp/acdw-org.el
@@ -1,10 +1,11 @@
1;;; acdw-org.el -*- lexical-binding: t; coding: utf-8-unix -*- 1;;; acdw-org.el --- org extras -*- lexical-binding: t; coding: utf-8-unix -*-
2;; Author: Various 2;; Author: Various
3;; URL: https://tildegit.org/acdw/emacs 3;; URL: https://tildegit.org/acdw/emacs
4 4
5;; This file is NOT part of GNU Emacs. 5;; This file is NOT part of GNU Emacs.
6 6
7;;; License: 7;;; License:
8
8;; Everyone is permitted to do whatever with this software, without 9;; Everyone is permitted to do whatever with this software, without
9;; limitation. This software comes without any warranty whatsoever, 10;; limitation. This software comes without any warranty whatsoever,
10;; but with two pieces of advice: 11;; but with two pieces of advice:
@@ -12,11 +13,38 @@
12;; - Make good choices. 13;; - Make good choices.
13 14
14;;; Commentary: 15;;; Commentary:
16
15;; This file is for the weird little `org-mode' functions that just take up 17;; This file is for the weird little `org-mode' functions that just take up
16;; space in my main init file. I've tried to give credit where credit is due. 18;; space in my main init file. I've tried to give credit where credit is due.
17 19
20;; 2021-09-13 Hi readers of "Emacs News!" I just saw that Sacha decided to
21;; include this in her weekly newsletter. Thanks for the gold kind stranger,
22;; etc. If you're looking for stuff in here that /isn't/ just ripped
23;; wholesale from something else on the internet, you'll want the following
24;; (updated as I write more/remember to update them):
25
26;; `acdw-org/fix-blank-lines-in-buffer'
27;; `acdw-org/count-words-stupidly'
28;; `acdw/org-next-heading-widen'
29;; `acdw/org-previous-heading-widen'
30;; `acdw-org/work-month-headings'
31
32;; To be honest, I could easily (and probably should) extract some of these out
33;; into their own /real/ libraries.
34
35;; Until then, just require this file /after/ you require org -- i.e.,
36;; (with-eval-after-load 'org (require 'acdw-org)) -- or else it'll load every
37;; time you start up Emacs.
38
18;;; Code: 39;;; Code:
19 40
41(require 'dom)
42(require 'org)
43(require 'org-element)
44(require 'ox)
45(require 'subr-x)
46(require 'calendar)
47
20 48
21;;; unpackaged.el: https://github.com/alphapapa/unpackaged.el 49;;; unpackaged.el: https://github.com/alphapapa/unpackaged.el
22 50
@@ -29,13 +57,14 @@ ELEMENT should be a list like that returned by `org-element-context'."
29 (or (eq type (car parent)) 57 (or (eq type (car parent))
30 (acdw-org/element-descendant-of type parent)))) 58 (acdw-org/element-descendant-of type parent))))
31 59
32(defun acdw-org/return-dwim (&optional default) 60(defun acdw-org/return-dwim (&optional prefix)
33 "A helpful replacement for `org-return'. With prefix, call `org-return'. 61 "A helpful replacement for `org-return'. With PREFIX, call `org-return'.
34 62
35On headings, move point to position after entry content. In 63On headings, move point to position after entry content. In
36lists, insert a new item or end the list, with checkbox if 64lists, insert a new item or end the list, with checkbox if
37appropriate. In tables, insert a new row or end the table." 65appropriate. In tables, insert a new row or end the table."
38 ;; Inspired by John Kitchin: http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/ 66 ;; Inspired by John Kitchin:
67 ;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/
39 (interactive "P") 68 (interactive "P")
40 ;; Auto-fill if enabled 69 ;; Auto-fill if enabled
41 (when auto-fill-function 70 (when auto-fill-function
@@ -43,13 +72,13 @@ appropriate. In tables, insert a new row or end the table."
43 (dolist (func auto-fill-function) 72 (dolist (func auto-fill-function)
44 (funcall func)) 73 (funcall func))
45 (funcall auto-fill-function))) 74 (funcall auto-fill-function)))
46 (if default 75 (if prefix
47 ;; Handle prefix args 76 ;; Handle prefix args
48 (pcase default 77 (pcase prefix
49 ('(4) (newline)) 78 ('(4) (newline))
50 ('(16) (newline 2)) 79 ('(16) (newline 2))
51 ;; this is ... not ideal. but whatever. 80 ;; this is ... not ideal. but whatever.
52 (_ (newline default))) 81 (_ (newline prefix)))
53 (cond 82 (cond
54 ;; Act depending on context around point. 83 ;; Act depending on context around point.
55 ((and org-return-follows-link 84 ((and org-return-follows-link
@@ -76,8 +105,10 @@ appropriate. In tables, insert a new row or end the table."
76 (forward-line) 105 (forward-line)
77 (insert "\n") 106 (insert "\n")
78 (forward-line -1)) 107 (forward-line -1))
79 ;; FIXME: looking-back is supposed to be called with more arguments. 108 (while (not
80 (while (not (looking-back (rx (repeat 3 (seq (optional blank) "\n"))))) 109 (looking-back
110 (rx (repeat 3 (seq (optional blank) "\n")))
111 nil))
81 (insert "\n")) 112 (insert "\n"))
82 (forward-line -1))))) 113 (forward-line -1)))))
83 114
@@ -135,10 +166,9 @@ appropriate. In tables, insert a new row or end the table."
135 (org-return))))) 166 (org-return)))))
136 167
137(defun acdw-org/fix-blank-lines (&optional prefix) 168(defun acdw-org/fix-blank-lines (&optional prefix)
138 "Ensure that blank lines exist between headings and 169 "Ensure blank lines around headings.
139 between headings and their contents. With prefix, operate on 170Optional PREFIX argument operates on the entire buffer.
140 whole buffer. Ensures that blank lines exist after each 171Drawers are included with their headings."
141 headings's drawers."
142 (interactive "P") 172 (interactive "P")
143 (org-map-entries (lambda () 173 (org-map-entries (lambda ()
144 (org-with-wide-buffer 174 (org-with-wide-buffer
@@ -168,14 +198,10 @@ appropriate. In tables, insert a new row or end the table."
168 (org-at-heading-p) 198 (org-at-heading-p)
169 (looking-at-p "\n")) 199 (looking-at-p "\n"))
170 (insert "\n")))) 200 (insert "\n"))))
171 t (if prefix 201 t
172 nil 202 (if prefix
173 'tree))) 203 nil
174 204 'tree)))
175(defun acdw-org/fix-blank-lines-in-buffer ()
176 (when (eq major-mode 'org-mode)
177 (let ((current-prefix-arg 4))
178 (call-interactively #'acdw-org/fix-blank-lines))))
179 205
180 206
181;;; Generate custom IDs: 207;;; Generate custom IDs:
@@ -205,19 +231,20 @@ appropriate. In tables, insert a new row or end the table."
205 "Convert TITLE to a reasonable filename." 231 "Convert TITLE to a reasonable filename."
206 ;; Based on the slug logic in `org-roam', but `org-roam' also uses a 232 ;; Based on the slug logic in `org-roam', but `org-roam' also uses a
207 ;; timestamp, and I only use the slug. 233 ;; timestamp, and I only use the slug.
208 (setq title (s-downcase title)) 234 (setq title (downcase title))
209 (setq title (s-replace-regexp "[^a-zA-Z0-9]+" "-" title)) 235 (setq title (replace-regexp-in-string "[^a-zA-Z0-9]+" "-" title))
210 (setq title (s-replace-regexp "-+" "-" title)) 236 (setq title (replace-regexp-in-string "-+" "-" title))
211 (setq title (s-replace-regexp "^-" "" title)) 237 (setq title (replace-regexp-in-string "^-" "" title))
212 (setq title (s-replace-regexp "-$" "" title)) 238 (setq title (replace-regexp-in-string "-$" "" title))
213 title) 239 title)
214 240
215 241
216;;; ADVICE AND TWEAKS 242;;; ADVICE AND TWEAKS
217 243
244;; I definitely got this from somewhere.
218;; Correct `org-delete-backward-char' to use `backward-delete-char-untabify' 245;; Correct `org-delete-backward-char' to use `backward-delete-char-untabify'
219(defun acdw-org/delete-backward-char (N) 246(defun acdw-org/delete-backward-char (N)
220 "Like `delete-backward-char-untabify', insert whitespace at field end in tables. 247 "Keep tables aligned while deleting N characters backward.
221When deleting backwards, in tables this function will insert 248When deleting backwards, in tables this function will insert
222whitespace in front of the next \"|\" separator, to keep the 249whitespace in front of the next \"|\" separator, to keep the
223table aligned. The table will still be marked for re-alignment 250table aligned. The table will still be marked for re-alignment
@@ -237,9 +264,10 @@ the deletion might narrow the column."
237 (backward-delete-char-untabify N) 264 (backward-delete-char-untabify N)
238 (org-fix-tags-on-the-fly)))) 265 (org-fix-tags-on-the-fly))))
239 266
267;; Same here.
240(defun acdw-org/org-table-copy-down (n) 268(defun acdw-org/org-table-copy-down (n)
241 "Like `org-table-copy-down', except instead of erroring when 269 "Call `org-table-copy-down', or `org-return' outside of a table.
242 that command makes no sense, just call `org-return'." 270N is passed to the functions."
243 (interactive "p") 271 (interactive "p")
244 (if (org-table-check-inside-data-field 'noerror) 272 (if (org-table-check-inside-data-field 'noerror)
245 (org-table-copy-down n) 273 (org-table-copy-down n)
@@ -279,7 +307,7 @@ instead of the true count."
279 ;; Ignore tables 307 ;; Ignore tables
280 ((org-at-table-p) (forward-line)) 308 ((org-at-table-p) (forward-line))
281 ;; Ignore hyperlinks, but count the descriptions 309 ;; Ignore hyperlinks, but count the descriptions
282 ((looking-at org-bracket-link-analytic-regexp) 310 ((looking-at org-link-bracket-re)
283 (when-let ((desc (match-string-no-properties 5))) 311 (when-let ((desc (match-string-no-properties 5)))
284 (save-match-data 312 (save-match-data
285 (setq words (+ words 313 (setq words (+ words
@@ -349,9 +377,9 @@ instead of the true count."
349 (region-end))))) 377 (region-end)))))
350 (cond ((and region-content clipboard-url (not point-in-link)) 378 (cond ((and region-content clipboard-url (not point-in-link))
351 (delete-region (region-beginning) (region-end)) 379 (delete-region (region-beginning) (region-end))
352 (insert (org-make-link-string clipboard-url region-content))) 380 (insert (org-link-make-string clipboard-url region-content)))
353 ((and clipboard-url (not point-in-link)) 381 ((and clipboard-url (not point-in-link))
354 (insert (org-make-link-string 382 (insert (org-link-make-string
355 clipboard-url 383 clipboard-url
356 (read-string "title: " 384 (read-string "title: "
357 (with-current-buffer 385 (with-current-buffer
@@ -369,6 +397,7 @@ instead of the true count."
369 397
370;;; Next and previous heading, with widening 398;;; Next and previous heading, with widening
371(defun acdw/org-next-heading-widen (arg) 399(defun acdw/org-next-heading-widen (arg)
400 "Find the ARGth next org heading, widening if necessary."
372 (interactive "p") 401 (interactive "p")
373 (let ((current-point (point)) 402 (let ((current-point (point))
374 (point-target (if (> arg 0) (point-max) (point-min)))) 403 (point-target (if (> arg 0) (point-max) (point-min))))
@@ -382,6 +411,7 @@ instead of the true count."
382 (org-next-visible-heading arg)))) 411 (org-next-visible-heading arg))))
383 412
384(defun acdw/org-previous-heading-widen (arg) 413(defun acdw/org-previous-heading-widen (arg)
414 "Find the ARGth previous org heading, widening if necessary."
385 (interactive "p") 415 (interactive "p")
386 (acdw/org-next-heading-widen (- arg))) 416 (acdw/org-next-heading-widen (- arg)))
387 417
@@ -390,11 +420,17 @@ instead of the true count."
390;; Gets rid of weekends. 420;; Gets rid of weekends.
391 421
392(defun acdw-org/work-month-headings (&optional month year) 422(defun acdw-org/work-month-headings (&optional month year)
423 "Create headings for every workday in MONTH and YEAR, or this month.
424Workdays are Monday through Friday. This function inserts a new
425heading with an inactive timestamp for each workday of MONTH in YEAR.
426
427I use this function to attempt to organize my work month. I'll
428probably abandon it at some point for a better solution (see:
429`org-agenda')."
393 (interactive (list 430 (interactive (list
394 (read-number "Month: " (car (calendar-current-date))) 431 (read-number "Month: " (car (calendar-current-date)))
395 (read-number "Year: " (nth 2 (calendar-current-date))))) 432 (read-number "Year: " (nth 2 (calendar-current-date)))))
396 (let ((offset 0) 433 (let ((month (or month
397 (month (or month
398 (car (calendar-current-date)))) 434 (car (calendar-current-date))))
399 (year (or year 435 (year (or year
400 (car (last (calendar-current-date)))))) 436 (car (last (calendar-current-date))))))
@@ -415,4 +451,8 @@ instead of the true count."
415 451
416 452
417(provide 'acdw-org) 453(provide 'acdw-org)
418;; acdw-org.el ends here 454;;; acdw-org.el ends here
455
456;; Local Variables:
457;; flymake-inhibit: t
458;; End: