185 lines
6.2 KiB
EmacsLisp
185 lines
6.2 KiB
EmacsLisp
;;; acdw-org.el -*- lexical-binding: t; coding: utf-8-unix -*-
|
|
;; Author: Various
|
|
;; URL: https://tildegit.org/acdw/emacs
|
|
|
|
;; This file is NOT part of GNU Emacs.
|
|
|
|
;;; 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.
|
|
|
|
;;; 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.
|
|
|
|
;;; 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))
|
|
(unpackaged/org-element-descendant-of type parent))))
|
|
|
|
(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
|
|
;; 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)))))
|
|
|
|
;;; 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 ()
|
|
(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)))
|
|
|
|
(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))))
|
|
|
|
(provide 'acdw-org)
|