2021-03-12 23:20:49 +00:00
|
|
|
|
;;; acdw-org.el -*- lexical-binding: t; coding: utf-8-unix -*-
|
|
|
|
|
;; Author: Various
|
|
|
|
|
;; URL: https://tildegit.org/acdw/emacs
|
2021-03-16 16:16:21 +00:00
|
|
|
|
|
2021-03-12 23:20:49 +00:00
|
|
|
|
;; This file is NOT part of GNU Emacs.
|
2021-03-16 16:16:21 +00:00
|
|
|
|
|
2021-03-12 23:20:49 +00:00
|
|
|
|
;;; License:
|
|
|
|
|
;; Everyone is permitted to do whatever with this software, without
|
|
|
|
|
;; limitation. This software comes without any warranty whatsoever,
|
|
|
|
|
;; but with two pieces of advice:
|
|
|
|
|
;; - Don't hurt yourself.
|
|
|
|
|
;; - Make good choices.
|
2021-03-16 16:16:21 +00:00
|
|
|
|
|
2021-03-12 23:20:49 +00:00
|
|
|
|
;;; Commentary:
|
|
|
|
|
;; This file is for the weird little `org-mode' functions that just take up
|
|
|
|
|
;; space in my main init file. I've tried to give credit where credit is due.
|
2021-03-16 16:16:21 +00:00
|
|
|
|
|
2021-03-12 23:20:49 +00:00
|
|
|
|
;;; Code:
|
|
|
|
|
|
|
|
|
|
;;; unpackaged.el: https://github.com/alphapapa/unpackaged.el
|
|
|
|
|
|
|
|
|
|
;;; ORG-RETURN-DWIM
|
|
|
|
|
|
|
|
|
|
(defun unpackaged/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))
|
2021-04-12 22:58:33 +00:00
|
|
|
|
(unpackaged/org-element-descendant-of type parent))))
|
2021-03-12 23:20:49 +00:00
|
|
|
|
|
|
|
|
|
(defun unpackaged/org-return-dwim (&optional default)
|
|
|
|
|
"A helpful replacement for `org-return'. With prefix,
|
|
|
|
|
call `org-return'.
|
|
|
|
|
|
|
|
|
|
On headings, move point to position after entry content. In
|
|
|
|
|
lists, insert a new item or end the list, with checkbox if
|
|
|
|
|
appropriate. In tables, insert a new row or end the table."
|
|
|
|
|
;; Inspired by John Kitchin:
|
|
|
|
|
;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(if default
|
|
|
|
|
(org-return)
|
|
|
|
|
(cond
|
2021-04-12 22:58:33 +00:00
|
|
|
|
;; Act depending on context around point.
|
|
|
|
|
|
|
|
|
|
;; NOTE: I prefer RET to not follow links, but by uncommenting
|
|
|
|
|
;; this block, links will be followed.
|
|
|
|
|
;; FURTHER NOTE: Ideally, I would follow links unless point
|
|
|
|
|
;; /appeared/ to be at the end of the line (even if it's still
|
|
|
|
|
;; inside the link) -- when it would do `org-return'. That
|
|
|
|
|
;; would take some /doing/, however.
|
|
|
|
|
|
|
|
|
|
;; ((eq 'link (car (org-element-context)))
|
|
|
|
|
;; ;; Link: Open it.
|
|
|
|
|
;; (org-open-at-point-global))
|
|
|
|
|
|
|
|
|
|
((org-at-heading-p)
|
|
|
|
|
;; Heading: Move to position after entry content. NOTE: This is
|
|
|
|
|
;; probably the most interesting feature of this function.
|
|
|
|
|
(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; add newline after
|
|
|
|
|
(end-of-line)
|
|
|
|
|
(insert "\n\n"))
|
|
|
|
|
(t
|
|
|
|
|
;; Entry ends after its heading; back up
|
|
|
|
|
(forward-line -1)
|
|
|
|
|
(end-of-line)
|
|
|
|
|
(when (org-at-heading-p)
|
|
|
|
|
;; At the same heading
|
|
|
|
|
(forward-line)
|
|
|
|
|
(insert "\n")
|
|
|
|
|
(forward-line -1))
|
|
|
|
|
;; FIXME: looking-back is supposed to be called with
|
|
|
|
|
;; more arguments.
|
|
|
|
|
(while (not (looking-back (rx
|
|
|
|
|
(repeat 3
|
|
|
|
|
(seq (optional blank)
|
|
|
|
|
"\n")))
|
|
|
|
|
nil))
|
|
|
|
|
(insert "\n"))
|
|
|
|
|
(forward-line -1)))))
|
|
|
|
|
|
|
|
|
|
((org-at-item-checkbox-p)
|
|
|
|
|
;; Checkbox: Insert new item with checkbox.
|
|
|
|
|
(org-insert-todo-heading nil))
|
|
|
|
|
|
|
|
|
|
((org-in-item-p)
|
|
|
|
|
;; Plain list. Yes, this gets a little complicated...
|
|
|
|
|
(let ((context (org-element-context)))
|
|
|
|
|
(if (or (eq 'plain-list (car context)) ; First item in list
|
|
|
|
|
(and (eq 'item (car context))
|
|
|
|
|
(not (eq (org-element-property
|
|
|
|
|
:contents-begin context)
|
|
|
|
|
(org-element-property
|
|
|
|
|
:contents-end context))))
|
|
|
|
|
;; Element in list item, e.g. a link
|
|
|
|
|
(unpackaged/org-element-descendant-of 'item context))
|
|
|
|
|
;; Non-empty item: Add new item.
|
|
|
|
|
(org-insert-item)
|
|
|
|
|
;; Empty item: Close the list.
|
|
|
|
|
;; TODO: Do this with org functions rather than operating
|
|
|
|
|
;; on the text. Can't seem to find the right function.
|
|
|
|
|
(delete-region (line-beginning-position) (line-end-position))
|
|
|
|
|
(insert "\n"))))
|
|
|
|
|
|
|
|
|
|
((when (fboundp 'org-inlinetask-in-task-p)
|
|
|
|
|
(org-inlinetask-in-task-p))
|
|
|
|
|
;; Inline task: Don't insert a new heading.
|
|
|
|
|
(org-return))
|
|
|
|
|
|
|
|
|
|
((org-at-table-p)
|
|
|
|
|
(cond ((save-excursion
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
;; See `org-table-next-field'.
|
|
|
|
|
(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: call `org-return'.
|
|
|
|
|
(org-return))))
|
|
|
|
|
(t
|
|
|
|
|
;; All other cases: call `org-return'.
|
|
|
|
|
(org-return)))))
|
2021-03-12 23:20:49 +00:00
|
|
|
|
|
|
|
|
|
;;; ORG-FIX-BLANK-LINES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
|
|
|
|
(defun unpackaged/org-fix-blank-lines (&optional prefix)
|
|
|
|
|
"Ensure that blank lines exist between headings and
|
|
|
|
|
between headings and their contents. With prefix, operate on
|
|
|
|
|
whole buffer. Ensures that blank lines exist after each
|
|
|
|
|
headings's drawers."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(org-map-entries (lambda ()
|
2021-04-12 22:58:33 +00:00
|
|
|
|
(org-with-wide-buffer
|
|
|
|
|
;; `org-map-entries' narrows the buffer, which
|
|
|
|
|
;; prevents us from seeing newlines before the
|
|
|
|
|
;; current heading, so we do this part widened.
|
|
|
|
|
(while (not (looking-back "\n\n" nil))
|
|
|
|
|
;; Insert blank lines before heading.
|
|
|
|
|
(insert "\n")))
|
|
|
|
|
(let ((end (org-entry-end-position)))
|
|
|
|
|
;; Insert blank lines before entry content
|
|
|
|
|
(forward-line)
|
|
|
|
|
(while (and (org-at-planning-p)
|
|
|
|
|
(< (point) (point-max)))
|
|
|
|
|
;; Skip planning lines
|
|
|
|
|
(forward-line))
|
|
|
|
|
(while (re-search-forward
|
|
|
|
|
org-drawer-regexp end t)
|
|
|
|
|
;; Skip drawers. You might think that
|
|
|
|
|
;; `org-at-drawer-p' would suffice, but for
|
|
|
|
|
;; some reason it doesn't work correctly when
|
|
|
|
|
;; operating on hidden text. This works, taken
|
|
|
|
|
;; from `org-agenda-get-some-entry-text'.
|
|
|
|
|
(re-search-forward "^[ \t]*:END:.*\n?" end t)
|
|
|
|
|
(goto-char (match-end 0)))
|
|
|
|
|
(unless (or (= (point) (point-max))
|
|
|
|
|
(org-at-heading-p)
|
|
|
|
|
(looking-at-p "\n"))
|
|
|
|
|
(insert "\n"))))
|
|
|
|
|
t (if prefix
|
|
|
|
|
nil
|
|
|
|
|
'tree)))
|
2021-03-12 23:20:49 +00:00
|
|
|
|
|
|
|
|
|
(defun acdw/hook--org-mode-fix-blank-lines ()
|
|
|
|
|
(when (eq major-mode 'org-mode)
|
|
|
|
|
(let ((current-prefix-arg 4))
|
|
|
|
|
(call-interactively #'unpackaged/org-fix-blank-lines))))
|
|
|
|
|
|
2021-04-13 22:43:39 +00:00
|
|
|
|
|
|
|
|
|
;;; Generate custom IDs:
|
|
|
|
|
;; https://amitp.blogspot.com/2021/04/automatically-generate-ids-for-emacs.html
|
|
|
|
|
|
|
|
|
|
(defun acdw-org/generate-custom-ids ()
|
|
|
|
|
"Generate CUSTOM_ID for any headings that are missing one."
|
|
|
|
|
(let ((existing-ids (org-map-entries (lambda ()
|
|
|
|
|
(org-entry-get nil "CUSTOM_ID")))))
|
|
|
|
|
(org-map-entries
|
|
|
|
|
(lambda ()
|
|
|
|
|
(let* ((custom-id (org-entry-get nil "CUSTOM_ID"))
|
|
|
|
|
(heading (org-heading-components))
|
|
|
|
|
(level (nth 0 heading))
|
|
|
|
|
(todo (nth 2 heading))
|
|
|
|
|
(headline (nth 4 heading))
|
|
|
|
|
(slug (acdw-org/title-to-filename headline))
|
|
|
|
|
(duplicate-id (member slug existing-ids)))
|
|
|
|
|
(when (and (not custom-id)
|
|
|
|
|
(< level 4)
|
|
|
|
|
(not todo)
|
|
|
|
|
(not duplicate-id))
|
|
|
|
|
(message "Adding entry '%s' to '%s'" slug headline)
|
|
|
|
|
(org-entry-put nil "CUSTOM_ID" slug)))))))
|
|
|
|
|
|
|
|
|
|
(defun acdw-org/title-to-filename (title)
|
|
|
|
|
"Convert TITLE to a reasonable filename."
|
|
|
|
|
;; Based on the slug logic in `org-roam', but `org-roam' also uses a
|
|
|
|
|
;; timestamp, and I only use the slug.
|
|
|
|
|
(setq title (s-downcase title))
|
|
|
|
|
(setq title (s-replace-regexp "[^a-zA-Z0-9]+" "-" title))
|
|
|
|
|
(setq title (s-replace-regexp "-+" "-" title))
|
|
|
|
|
(setq title (s-replace-regexp "^-" "" title))
|
|
|
|
|
(setq title (s-replace-regexp "-$" "" title))
|
|
|
|
|
title)
|
|
|
|
|
|
|
|
|
|
|
2021-04-12 22:58:33 +00:00
|
|
|
|
;;; ADVICE
|
|
|
|
|
|
|
|
|
|
;; Correct `org-delete-backward-char' to use `backward-delete-char-untabify'
|
|
|
|
|
(defun acdw-org/delete-backward-char (N)
|
|
|
|
|
"Like `delete-backward-char-untabify', insert whitespace at field end in tables.
|
|
|
|
|
When deleting backwards, in tables this function will insert
|
|
|
|
|
whitespace in front of the next \"|\" separator, to keep the
|
|
|
|
|
table aligned. The table will still be marked for re-alignment
|
|
|
|
|
if the field did fill the entire column, because, in this case
|
|
|
|
|
the deletion might narrow the column."
|
|
|
|
|
(interactive "p")
|
|
|
|
|
(save-match-data
|
|
|
|
|
(org-check-before-invisible-edit 'delete-backward)
|
|
|
|
|
(if (and (= N 1)
|
|
|
|
|
(not overwrite-mode)
|
|
|
|
|
(not (org-region-active-p))
|
|
|
|
|
(not (eq (char-before) ?|))
|
|
|
|
|
(save-excursion (skip-chars-backward " \t") (not (bolp)))
|
|
|
|
|
(looking-at-p ".*?|")
|
|
|
|
|
(org-at-table-p))
|
|
|
|
|
(progn (forward-char -1) (org-delete-char 1))
|
|
|
|
|
(backward-delete-char-untabify N)
|
|
|
|
|
(org-fix-tags-on-the-fly))))
|
|
|
|
|
|
2021-03-12 23:20:49 +00:00
|
|
|
|
(provide 'acdw-org)
|