I DECLARE BANKRUPTCY ... 8

Didn't think to do this till pretty .. written, so here we are.

1 files changed, 341 insertions, 0 deletions

@@ -0,0 +1,341 @@
+;;; +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