From c918211dcd9cb0d8c8cb30274c9b81004e6d8315 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Fri, 12 Mar 2021 17:20:49 -0600 Subject: Configure `org-mode'. --- lisp/acdw-org.el | 187 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 187 insertions(+) create mode 100644 lisp/acdw-org.el (limited to 'lisp') diff --git a/lisp/acdw-org.el b/lisp/acdw-org.el new file mode 100644 index 0000000..1522f78 --- /dev/null +++ b/lisp/acdw-org.el @@ -0,0 +1,187 @@ +;;; 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) -- cgit 1.4.1-21-gabe81