I DECLARE BANKRUPTCY ... 8

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

1 files changed, 0 insertions, 517 deletions

@@ -1,517 +0,0 @@
-;;; acdw-org.el --- org extras -*- 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.
-
-;; 2021-09-13 Hi readers of "Emacs News!"  I just saw that Sacha decided to
-;; include this in her weekly newsletter.  Thanks for the gold kind stranger,
-;; etc.  If you're looking for stuff in here that /isn't/ just ripped
-;; wholesale from something else on the internet, you'll want the following
-;; (updated as I write more/remember to update them):
-
-;; `acdw-org/fix-blank-lines-in-buffer'
-;; `acdw-org/count-words-stupidly'
-;; `acdw/org-next-heading-widen'
-;; `acdw/org-previous-heading-widen'
-;; `acdw-org/work-month-headings'
-
-;; To be honest, I could easily (and probably should) extract some of these out
-;; into their own /real/ libraries.
-
-;; Until then, just require this file /after/ you require org -- i.e.,
-;; (with-eval-after-load 'org (require 'acdw-org)) -- or else it'll load every
-;; time you start up Emacs.
-
-;;; Code:
-
-(require 'dom)
-(require 'org)
-(require 'org-element)
-(require 'ox)
-(require 'subr-x)
-(require 'calendar)
-
-
-;;; unpackaged.el: https://github.com/alphapapa/unpackaged.el
-
-(defun acdw-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))
-        (acdw-org/element-descendant-of type parent))))
-
-(defun acdw-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."
-  ;; Inspired by John Kitchin:
-  ;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/
-  (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
-              (acdw-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 acdw-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)))
-
-
-;;; 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 (downcase title))
-  (setq title (replace-regexp-in-string "[^a-zA-Z0-9]+" "-" title))
-  (setq title (replace-regexp-in-string "-+" "-" title))
-  (setq title (replace-regexp-in-string "^-" "" title))
-  (setq title (replace-regexp-in-string "-$" "" title))
-  title)
-
-
-;;; ADVICE AND TWEAKS
-
-;; I definitely got this from somewhere.
-;; Correct `org-delete-backward-char' to use `backward-delete-char-untabify'
-(defun acdw-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))))
-
-;; Same here.
-(defun acdw-org/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)
-    (acdw-org/return-dwim n)))
-
-;; This isn't the best code, but it'll do.
-(defun acdw-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"
-                  (acdw-org/count-words-stupidly (region-beginning)
-                                                 (region-end))))
-        (t
-         (message "%d words in buffer"
-                  (acdw-org/count-words-stupidly (point-min)
-                                                 (point-max))))))
-
-
-;;; Zero-width spaces
-;; https://blog.tecosaur.com/tmio/2021-05-31-async.html#easy-zero-width
-
-(defun insert-zero-width-space ()
-  "Insert a zero-width space."
-  (interactive)
-  (insert "\u200b"))
-
-(defun org-export-remove-zero-width-spaces (text _backend _info)
-  "Remove zero-width spaces from TEXT."
-  (unless (org-export-derived-backend-p 'org)
-    (replace-regexp-in-string "\u200b" "" text)))
-
-
-;;; Insert links .. 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)))))
-
-
-;;; Next and previous heading, with widening
-(defun acdw/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 acdw/org-previous-heading-widen (arg)
-  "Find the ARGth previous org heading, widening if necessary."
-  (interactive "p")
-  (acdw/org-next-heading-widen (- arg)))
-
-
-;;; Add headings for every day of the work month
-;; Gets rid of weekends.
-
-(defun acdw-org/work-month-headings (&optional month year)
-  "Create headings for every workday in MONTH and YEAR, or this month.
-Workdays are Monday through Friday.  This function inserts a new
-heading with an inactive timestamp for each workday of MONTH in YEAR.
-
-I use this function to attempt to organize my work month.  I'll
-probably abandon it at some point for a better solution (see:
-`org-agenda')."
-  (interactive (list
-                (read-number "Month: " (car (calendar-current-date)))
-                (read-number "Year: " (nth 2 (calendar-current-date)))))
-  (let ((month (or month
-                   (car (calendar-current-date))))
-        (year (or year
-                  (car (last (calendar-current-date))))))
-    (dotimes (day (calendar-last-day-of-month month year))
-      (let* ((day (1+ day))
-             (day-of-week (calendar-day-of-week (list month day year))))
-        (unless (memq day-of-week '(0 6))           ; weekend
-          (end-of-line)
-          (org-insert-heading nil t t)
-          (insert (concat "[" (mapconcat (lambda (n)
-                                           (format "%02d" n))
-                                         (list year month day)
-                                         "-")
-                          " "
-                          (nth day-of-week '("Sun" "Mon" "Tue" "Wed" "Thu"
-                                             "Fri" "Sat"))
-                          "]")))))))
-
-;;; Org task stuff
-
-(defun org-narrow-to-task ()
-  "Narrow buffer to the nearest task and its subtree."
-  (interactive)
-  (save-excursion
-    (save-match-data
-      (widen)
-      (while (not (or (org-entry-is-todo-p)
-                      (org-entry-is-done-p)))
-        ;; TODO: need a better error message
-        (org-previous-visible-heading 1))
-      (org-narrow-to-subtree))))
-
-
-;;; Hide everything but the current headline
-;; https://stackoverflow.com/questions/25161792/
-
-(defun acdw-org/show-next-heading-tidily ()
-  "Show next entry, keeping other entries closed."
-  (interactive)
-  (if (save-excursion (end-of-line) (outline-invisible-p))
-      (progn (org-show-entry) (outline-show-children))
-    (outline-next-heading)
-    (unless (and (bolp) (org-at-heading-p))
-      (org-up-heading-safe)
-      (outline-hide-subtree)
-      (error "Boundary reached"))
-    (org-overview)
-    (org-reveal t)
-    (org-show-entry)
-    (recenter-top-bottom)
-    (outline-show-children)
-    (recenter-top-bottom)))
-
-(defun acdw-org/show-previous-heading-tidily ()
-  "Show previous entry, keeping other entries closed."
-  (interactive)
-  (let ((pos (point)))
-    (outline-previous-heading)
-    (unless (and (< (point) pos) (bolp) (org-at-heading-p))
-      (goto-char pos)
-      (outline-hide-subtree)
-      (error "Boundary reached"))
-    (org-overview)
-    (org-reveal t)
-    (org-show-entry)
-    (recenter-top-bottom)
-    (outline-show-children)
-    (recenter-top-bottom)))
-
-
-(provide 'acdw-org)
-;;; acdw-org.el ends here
-
-;; Local Variables:
-;; flymake-inhibit: t
-;; End: