From 47f1bffa23c5e1f4302dc1ec3d9a92a864d9b792 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Mon, 13 Sep 2021 22:09:56 -0500 Subject: Make acdw-org.el "Emacs News"-worthy Hi sachac! --- lisp/acdw-org.el | 110 +++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 75 insertions(+), 35 deletions(-) diff --git a/lisp/acdw-org.el b/lisp/acdw-org.el index 63f6516..f210301 100644 --- a/lisp/acdw-org.el +++ b/lisp/acdw-org.el @@ -1,10 +1,11 @@ -;;; acdw-org.el -*- lexical-binding: t; coding: utf-8-unix -*- +;;; 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: @@ -12,11 +13,38 @@ ;; - 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 @@ -29,13 +57,14 @@ ELEMENT should be a list like that returned by `org-element-context'." (or (eq type (car parent)) (acdw-org/element-descendant-of type parent)))) -(defun acdw-org/return-dwim (&optional default) - "A helpful replacement for `org-return'. With prefix, call `org-return'. +(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/ + ;; 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 @@ -43,13 +72,13 @@ appropriate. In tables, insert a new row or end the table." (dolist (func auto-fill-function) (funcall func)) (funcall auto-fill-function))) - (if default + (if prefix ;; Handle prefix args - (pcase default + (pcase prefix ('(4) (newline)) ('(16) (newline 2)) ;; this is ... not ideal. but whatever. - (_ (newline default))) + (_ (newline prefix))) (cond ;; Act depending on context around point. ((and org-return-follows-link @@ -76,8 +105,10 @@ appropriate. In tables, insert a new row or end the table." (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"))))) + (while (not + (looking-back + (rx (repeat 3 (seq (optional blank) "\n"))) + nil)) (insert "\n")) (forward-line -1))))) @@ -135,10 +166,9 @@ appropriate. In tables, insert a new row or end the table." (org-return))))) (defun acdw-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." + "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 @@ -168,14 +198,10 @@ appropriate. In tables, insert a new row or end the table." (org-at-heading-p) (looking-at-p "\n")) (insert "\n")))) - t (if prefix - nil - 'tree))) - -(defun acdw-org/fix-blank-lines-in-buffer () - (when (eq major-mode 'org-mode) - (let ((current-prefix-arg 4)) - (call-interactively #'acdw-org/fix-blank-lines)))) + t + (if prefix + nil + 'tree))) ;;; Generate custom IDs: @@ -205,19 +231,20 @@ appropriate. In tables, insert a new row or end the table." "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 (s-downcase title)) - (setq title (s-replace-regexp "[^a-zA-Z0-9]+" "-" title)) - (setq title (s-replace-regexp "-+" "-" title)) - (setq title (s-replace-regexp "^-" "" title)) - (setq title (s-replace-regexp "-$" "" title)) + (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) - "Like `delete-backward-char-untabify', insert whitespace at field end in tables. + "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 @@ -237,9 +264,10 @@ the deletion might narrow the column." (backward-delete-char-untabify N) (org-fix-tags-on-the-fly)))) +;; Same here. (defun acdw-org/org-table-copy-down (n) - "Like `org-table-copy-down', except instead of erroring when - that command makes no sense, just call `org-return'." + "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) @@ -279,7 +307,7 @@ instead of the true count." ;; Ignore tables ((org-at-table-p) (forward-line)) ;; Ignore hyperlinks, but count the descriptions - ((looking-at org-bracket-link-analytic-regexp) + ((looking-at org-link-bracket-re) (when-let ((desc (match-string-no-properties 5))) (save-match-data (setq words (+ words @@ -349,9 +377,9 @@ instead of the true count." (region-end))))) (cond ((and region-content clipboard-url (not point-in-link)) (delete-region (region-beginning) (region-end)) - (insert (org-make-link-string clipboard-url region-content))) + (insert (org-link-make-string clipboard-url region-content))) ((and clipboard-url (not point-in-link)) - (insert (org-make-link-string + (insert (org-link-make-string clipboard-url (read-string "title: " (with-current-buffer @@ -369,6 +397,7 @@ instead of the true count." ;;; 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)))) @@ -382,6 +411,7 @@ instead of the true count." (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))) @@ -390,11 +420,17 @@ instead of the true count." ;; 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 ((offset 0) - (month (or month + (let ((month (or month (car (calendar-current-date)))) (year (or year (car (last (calendar-current-date)))))) @@ -415,4 +451,8 @@ instead of the true count." (provide 'acdw-org) -;; acdw-org.el ends here +;;; acdw-org.el ends here + +;; Local Variables: +;; flymake-inhibit: t +;; End: -- cgit 1.4.1-21-gabe81