Merge branch 'main' of https://tildegit.org/acdw/emacs

1 files changed, 77 insertions, 48 deletions

@@ -17,49 +17,42 @@
 
 ;;; Code:
 
+
 ;;; unpackaged.el: https://github.com/alphapapa/unpackaged.el
 
-;;; ORG-RETURN-DWIM
-
 (defun unpackaged/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'."
+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))
         (unpackaged/org-element-descendant-of type parent))))
 
+;;;###autoload
 (defun unpackaged/org-return-dwim (&optional default)
-  "A helpful replacement for `org-return'.  With prefix,
-call `org-return'.
+  "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")
   (if default
       (org-return)
     (cond
      ;; Act depending on context around point.
 
-     ;; NOTE: I prefer RET to not follow links, but by uncommenting
-     ;; this block, links will be followed.
-     ;; FURTHER NOTE: Ideally, I would follow links unless point
-     ;; /appeared/ to be at the end of the line (even if it's still
-     ;; inside the link) -- when it would do `org-return'.  That
-     ;; would take some /doing/, however.
+     ;; NOTE: I prefer RET to not follow links, but by uncommenting this block, links will be
+     ;; followed.
 
      ;; ((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.
+      ;; 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)
@@ -76,13 +69,8 @@ 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")))
-                                         nil))
+               ;; FIXME: looking-back is supposed to be called with more arguments.
+               (while (not (looking-back (rx (repeat 3 (seq (optional blank) "\n")))))
                  (insert "\n"))
                (forward-line -1)))))
 
@@ -91,23 +79,33 @@ appropriate.  In tables, insert a new row or end the table."
       (org-insert-todo-heading nil))
 
      ((org-in-item-p)
-      ;; Plain list.  Yes, this gets a little complicated...
-      (let ((context (org-element-context)))
-        (if (or (eq 'plain-list (car context))  ; First item in list
-                (and (eq 'item (car context))
-                     (not (eq (org-element-property
-                               :contents-begin context)
-                              (org-element-property
-                               :contents-end context))))
-                ;; Element in list item, e.g. a link
-                (unpackaged/org-element-descendant-of 'item context))
-            ;; Non-empty item: Add new item.
-            (org-insert-item)
-          ;; Empty item: Close the list.
-          ;; TODO: Do this with org functions rather than operating
-          ;; on the text. Can't seem to find the right function.
-          (delete-region (line-beginning-position) (line-end-position))
-          (insert "\n"))))
+      ;; 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
+              (unpackaged/org-element-descendant-of 'item context)))
+        (message "(or %S (and %S %S) %S)"
+                 first-item-p
+                 itemp (not emptyp)
+                 item-child-p)
+        ;; 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))
+               (newline 2))
+              ((or first-item-p
+                   (and itemp (not emptyp))
+                   item-child-p)
+               (org-insert-item))
+              (t (delete-region (line-beginning-position) (line-end-position))
+                 (newline)))))
 
      ((when (fboundp 'org-inlinetask-in-task-p)
         (org-inlinetask-in-task-p))
@@ -120,14 +118,11 @@ appropriate.  In tables, insert a new row or end the table."
                ;; 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))
+                        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))
+             (delete-region (line-beginning-position) (line-end-position))
              (org-return))
             (t
              ;; Non-empty row: call `org-return'.
@@ -136,8 +131,6 @@ appropriate.  In tables, insert a new row or end the table."
       ;; All other cases: call `org-return'.
       (org-return)))))
 
-;;; ORG-FIX-BLANK-LINES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
 (defun unpackaged/org-fix-blank-lines (&optional prefix)
   "Ensure that blank lines exist between headings and
  between headings and their contents.  With prefix, operate on
@@ -181,6 +174,42 @@ appropriate.  In tables, insert a new row or end the table."
     (let ((current-prefix-arg 4))
       (call-interactively #'unpackaged/org-fix-blank-lines))))
 
+
+;;; 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 (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))
+  title)
+
+
 ;;; ADVICE
 
 ;; Correct `org-delete-backward-char' to use `backward-delete-char-untabify'