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

Hi sachac!

1 files changed, 75 insertions, 35 deletions

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