342 lines
14 KiB
EmacsLisp
342 lines
14 KiB
EmacsLisp
;;; +org.el -*- lexical-binding: t; -*-
|
|
|
|
;;; Code:
|
|
|
|
(require 'org)
|
|
(require 'org-element)
|
|
(require 'ox)
|
|
|
|
;;; org-return-dwim - https://github.com/alphapapa/unpackaged.el
|
|
;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/
|
|
|
|
(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'.
|
|
|
|
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."
|
|
(interactive "P")
|
|
;; Auto-fill if enabled
|
|
(when auto-fill-function
|
|
(if (listp auto-fill-function)
|
|
(dolist (func auto-fill-function)
|
|
(funcall func))
|
|
(funcall auto-fill-function)))
|
|
(if prefix
|
|
;; Handle prefix args
|
|
(pcase prefix
|
|
('(4) (newline))
|
|
('(16) (newline 2))
|
|
;; this is ... not ideal. but whatever.
|
|
(_ (newline prefix)))
|
|
(cond
|
|
;; Act depending on context around point.
|
|
((and org-return-follows-link
|
|
(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))
|
|
(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
|
|
(let* ((context (org-element-context))
|
|
(first-item-p (eq 'plain-list (car context)))
|
|
(itemp (eq 'item (car context)))
|
|
(emptyp (eq (org-element-property :contents-begin context)
|
|
(org-element-property :contents-end context)))
|
|
(item-child-p
|
|
(+org-element-descendant-of 'item context)))
|
|
;; The original function from unpackaged just tested the (or ...) test
|
|
;; in this cond, in an if. However, that doesn't auto-end nested
|
|
;; lists. So I made this form a cond and added the (and...) test in
|
|
;; the first position, which is clunky (the delete-region... stuff
|
|
;; comes twice) and might not be needed. More testing, obviously, but
|
|
;; for now, it works well enough.
|
|
(cond ((and itemp emptyp)
|
|
(delete-region (line-beginning-position) (line-end-position))
|
|
(insert "\n\n"))
|
|
((or first-item-p
|
|
(and itemp (not emptyp))
|
|
item-child-p)
|
|
(org-insert-item))
|
|
(t (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)))))
|
|
|
|
(defun +org-table-copy-down (n)
|
|
"Call `org-table-copy-down', or `org-return' outside of a table.
|
|
N is passed to the functions."
|
|
(interactive "p")
|
|
(if (org-table-check-inside-data-field 'noerror)
|
|
(org-table-copy-down n)
|
|
(+org-return-dwim n)))
|
|
|
|
;;; org-fix-blank-lines - unpackaged.el
|
|
|
|
(defun +org-fix-blank-lines (&optional prefix)
|
|
"Ensure blank lines around headings.
|
|
Optional PREFIX argument operates on the entire buffer.
|
|
Drawers are included with their headings."
|
|
(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)))
|
|
|
|
;;; org-count-words
|
|
|
|
(defun +org-count-words-stupidly (start end &optional limit)
|
|
"Count words between START and END, ignoring a lot.
|
|
|
|
Since this function is, for some reason, pricy, the optional
|
|
parameter LIMIT sets a word limit at which to stop counting.
|
|
Once the function hits that number, it'll return -LIMIT
|
|
instead of the true count."
|
|
(interactive (list nil nil))
|
|
(cond ((not (called-interactively-p 'any))
|
|
(let ((words 0)
|
|
(continue t))
|
|
(save-excursion
|
|
(save-restriction
|
|
(narrow-to-region start end)
|
|
(goto-char (point-min))
|
|
(while (and continue
|
|
(< (point) (point-max)))
|
|
(cond
|
|
;; Ignore comments
|
|
((or (org-at-comment-p)
|
|
(org-in-commented-heading-p))
|
|
(forward-line))
|
|
;; Ignore headings
|
|
((or (org-at-heading-p))
|
|
(forward-line))
|
|
;; Ignore property and log drawers
|
|
((or (looking-at org-drawer-regexp)
|
|
(looking-at org-clock-drawer-re))
|
|
(search-forward ":END:" nil :noerror)
|
|
(forward-line))
|
|
;; Ignore DEADLINE and SCHEDULED keywords
|
|
((or (looking-at org-deadline-regexp)
|
|
(looking-at org-scheduled-regexp)
|
|
(looking-at org-closed-time-regexp))
|
|
(forward-line))
|
|
;; Ignore tables
|
|
((org-at-table-p) (forward-line))
|
|
;; Ignore hyperlinks, but count the descriptions
|
|
((looking-at org-link-bracket-re)
|
|
(when-let ((desc (match-string-no-properties 5)))
|
|
(save-match-data
|
|
(setq words (+ words
|
|
(length (remove ""
|
|
(org-split-string
|
|
desc "\\W")))))))
|
|
(goto-char (match-end 0)))
|
|
;; Ignore source blocks
|
|
((org-in-src-block-p) (forward-line))
|
|
;; Ignore blank lines
|
|
((looking-at "^$")
|
|
(forward-line))
|
|
;; Count everything else
|
|
(t
|
|
;; ... unless it's in a few weird contexts
|
|
(let ((contexts (org-context)))
|
|
(cond ((or (assoc :todo-keyword contexts)
|
|
(assoc :priority contexts)
|
|
(assoc :keyword contexts)
|
|
(assoc :checkbox contexts))
|
|
(forward-word-strictly))
|
|
|
|
(t (setq words (1+ words))
|
|
(if (and limit
|
|
(> words limit))
|
|
(setq words (- limit)
|
|
continue nil))
|
|
(forward-word-strictly)))))))))
|
|
words))
|
|
((use-region-p)
|
|
(message "%d words in region"
|
|
(+org-count-words-stupidly (region-beginning)
|
|
(region-end))))
|
|
(t
|
|
(message "%d words in buffer"
|
|
(+org-count-words-stupidly (point-min)
|
|
(point-max))))))
|
|
|
|
;;; org-insert-link-dwim - https://xenodium.com/emacs-dwim-do-what-i-mean/
|
|
|
|
(defun +org-insert-link-dwim ()
|
|
"Like `org-insert-link' but with personal dwim preferences."
|
|
(interactive)
|
|
(let* ((point-in-link (org-in-regexp org-link-any-re 1))
|
|
(clipboard-url (when (string-match-p
|
|
(rx (sequence bos
|
|
(or "http"
|
|
"gemini"
|
|
"gopher")))
|
|
(current-kill 0))
|
|
(current-kill 0)))
|
|
(region-content (when (region-active-p)
|
|
(buffer-substring-no-properties (region-beginning)
|
|
(region-end)))))
|
|
(cond ((and region-content clipboard-url (not point-in-link))
|
|
(delete-region (region-beginning) (region-end))
|
|
(insert (org-link-make-string clipboard-url region-content)))
|
|
((and clipboard-url (not point-in-link))
|
|
(insert (org-link-make-string
|
|
clipboard-url
|
|
(read-string "title: "
|
|
(with-current-buffer
|
|
(url-retrieve-synchronously
|
|
clipboard-url)
|
|
(dom-text
|
|
(car
|
|
(dom-by-tag (libxml-parse-html-region
|
|
(point-min)
|
|
(point-max))
|
|
'title))))))))
|
|
(t
|
|
(call-interactively 'org-insert-link)))))
|
|
|
|
;;; Navigate headings with widening
|
|
|
|
(defun +org-next-heading-widen (arg)
|
|
"Find the ARGth next org heading, widening if necessary."
|
|
(interactive "p")
|
|
(let ((current-point (point))
|
|
(point-target (if (> arg 0) (point-max) (point-min))))
|
|
(org-next-visible-heading arg)
|
|
(when (and (buffer-narrowed-p)
|
|
(= (point) point-target)
|
|
(or (and (> arg 0))
|
|
(and (< arg 0)
|
|
(= (point) current-point))))
|
|
(widen)
|
|
(org-next-visible-heading arg))))
|
|
|
|
(defun +org-previous-heading-widen (arg)
|
|
"Find the ARGth previous org heading, widening if necessary."
|
|
(interactive "p")
|
|
(+org-next-heading-widen (- arg)))
|
|
|
|
;;; Hooks & Advice
|
|
|
|
(defun +org-before-save@prettify-buffer ()
|
|
(save-mark-and-excursion
|
|
(mark-whole-buffer)
|
|
;;(org-fill-paragraph nil t)
|
|
(+org-fix-blank-lines t)
|
|
(org-align-tags t)))
|
|
|
|
(defun +org-delete-backward-char (N)
|
|
"Keep tables aligned while deleting N characters backward.
|
|
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))))
|
|
|
|
(provide '+org)
|
|
;;; +org.el ends here
|