From 29bbc0faa64bbeecc4423f17a12111405a28b63c Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Tue, 13 Apr 2021 17:43:39 -0500 Subject: Add a generate custom ids function for headings From amitp.blogspot.com. --- lisp/acdw-org.el | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) (limited to 'lisp') diff --git a/lisp/acdw-org.el b/lisp/acdw-org.el index 47e8eb2..48760a2 100644 --- a/lisp/acdw-org.el +++ b/lisp/acdw-org.el @@ -181,6 +181,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' -- cgit 1.4.1-21-gabe81 From 758048eb5798429a4f925e54fdb758e992d7fd06 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Tue, 13 Apr 2021 17:44:52 -0500 Subject: Formatting etc. This keeps happening :/ --- lisp/acdw-org.el | 45 ++++++++++++++------------------------------- 1 file changed, 14 insertions(+), 31 deletions(-) (limited to 'lisp') diff --git a/lisp/acdw-org.el b/lisp/acdw-org.el index 48760a2..7e9fecd 100644 --- a/lisp/acdw-org.el +++ b/lisp/acdw-org.el @@ -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))))) @@ -120,14 +108,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 +121,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 -- cgit 1.4.1-21-gabe81 From a64c5ff86998fa3efbff02364376ffd165caba21 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Tue, 13 Apr 2021 17:45:11 -0500 Subject: `org-return-dwim': work in nested lists `org-return-dwim' now ends a list on an empty nested list item. See the comment for details. --- lisp/acdw-org.el | 44 +++++++++++++++++++++++++++----------------- 1 file changed, 27 insertions(+), 17 deletions(-) (limited to 'lisp') diff --git a/lisp/acdw-org.el b/lisp/acdw-org.el index 7e9fecd..dc85015 100644 --- a/lisp/acdw-org.el +++ b/lisp/acdw-org.el @@ -79,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)) + (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)) -- cgit 1.4.1-21-gabe81 From 2632c854942f7872405c5c3c84c548806a7be8a2 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Tue, 13 Apr 2021 18:00:01 -0500 Subject: Change (insert "\n\n") -> (newline) --- lisp/acdw-org.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/acdw-org.el b/lisp/acdw-org.el index dc85015..06803d3 100644 --- a/lisp/acdw-org.el +++ b/lisp/acdw-org.el @@ -99,13 +99,13 @@ appropriate. In tables, insert a new row or end the table." ;; for now, it works well enough. (cond ((and itemp emptyp) (delete-region (line-beginning-position) (line-end-position)) - (insert "\n\n")) + (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)) - (insert "\n"))))) + (newline))))) ((when (fboundp 'org-inlinetask-in-task-p) (org-inlinetask-in-task-p)) -- cgit 1.4.1-21-gabe81