acdw/emacs
acdw
/
emacs
1
2
Fork 0
Code Issues 4 Pull Requests Releases Activity

Make acdw-org.el "Emacs News"-worthy 

Hi sachac!
This commit is contained in:
Case Duckworth 2021-09-13 22:09:56 -05:00
parent dbaaecd454
commit 47f1bffa23
1 changed files with 75 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

110
lisp/acdw-org.el
View File

@ -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: