From 57e027f753e5f3c77030c97d3de7ad5a7dd61f86 Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Mon, 12 Apr 2021 17:58:33 -0500
Subject: Add `acdw-org/delete-backward-char' and advise
The advice I've added untabifies in addition to deleting the character, which
enables the function to look at `delete-backward-char-untabify-method' or
whatev.
Also ... whitespace apparently?
---
lisp/acdw-org.el | 268 ++++++++++++++++++++++++++++++-------------------------
1 file changed, 146 insertions(+), 122 deletions(-)
(limited to 'lisp')
diff --git a/lisp/acdw-org.el b/lisp/acdw-org.el
index 9fa8767..47e8eb2 100644
--- a/lisp/acdw-org.el
+++ b/lisp/acdw-org.el
@@ -29,7 +29,7 @@ ELEMENT should be a list like that returned by
;; 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))))
+ (unpackaged/org-element-descendant-of type parent))))
(defun unpackaged/org-return-dwim (&optional default)
"A helpful replacement for `org-return'. With prefix,
@@ -44,97 +44,97 @@ appropriate. In tables, insert a new row or end the table."
(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.
-
- ;; ((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.
- (let ((heading-start (org-entry-beginning-position)))
- (goto-char (org-entry-end-position))
- (cond ((and (org-at-heading-p)
- (= heading-start (org-entry-beginning-position)))
- ;; Entry ends on its heading; add newline after
- (end-of-line)
- (insert "\n\n"))
- (t
- ;; Entry ends after its heading; back up
- (forward-line -1)
- (end-of-line)
- (when (org-at-heading-p)
- ;; At the same heading
- (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))
- (insert "\n"))
- (forward-line -1)))))
-
- ((org-at-item-checkbox-p)
- ;; Checkbox: Insert new item with checkbox.
- (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"))))
-
- ((when (fboundp 'org-inlinetask-in-task-p)
- (org-inlinetask-in-task-p))
- ;; Inline task: Don't insert a new heading.
- (org-return))
-
- ((org-at-table-p)
- (cond ((save-excursion
- (beginning-of-line)
- ;; 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))
- while (re-search-forward "|" end t)))
- ;; Empty row: end the table.
- (delete-region (line-beginning-position)
- (line-end-position))
- (org-return))
- (t
- ;; Non-empty row: call `org-return'.
- (org-return))))
- (t
- ;; All other cases: call `org-return'.
- (org-return)))))
+ ;; 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.
+
+ ;; ((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.
+ (let ((heading-start (org-entry-beginning-position)))
+ (goto-char (org-entry-end-position))
+ (cond ((and (org-at-heading-p)
+ (= heading-start (org-entry-beginning-position)))
+ ;; Entry ends on its heading; add newline after
+ (end-of-line)
+ (insert "\n\n"))
+ (t
+ ;; Entry ends after its heading; back up
+ (forward-line -1)
+ (end-of-line)
+ (when (org-at-heading-p)
+ ;; At the same heading
+ (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))
+ (insert "\n"))
+ (forward-line -1)))))
+
+ ((org-at-item-checkbox-p)
+ ;; Checkbox: Insert new item with checkbox.
+ (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"))))
+
+ ((when (fboundp 'org-inlinetask-in-task-p)
+ (org-inlinetask-in-task-p))
+ ;; Inline task: Don't insert a new heading.
+ (org-return))
+
+ ((org-at-table-p)
+ (cond ((save-excursion
+ (beginning-of-line)
+ ;; 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))
+ while (re-search-forward "|" end t)))
+ ;; Empty row: end the table.
+ (delete-region (line-beginning-position)
+ (line-end-position))
+ (org-return))
+ (t
+ ;; Non-empty row: call `org-return'.
+ (org-return))))
+ (t
+ ;; All other cases: call `org-return'.
+ (org-return)))))
;;; ORG-FIX-BLANK-LINES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -145,40 +145,64 @@ appropriate. In tables, insert a new row or end the table."
headings's drawers."
(interactive "P")
(org-map-entries (lambda ()
- (org-with-wide-buffer
- ;; `org-map-entries' narrows the buffer, which
- ;; prevents us from seeing newlines before the
- ;; current heading, so we do this part widened.
- (while (not (looking-back "\n\n" nil))
- ;; Insert blank lines before heading.
- (insert "\n")))
- (let ((end (org-entry-end-position)))
- ;; Insert blank lines before entry content
- (forward-line)
- (while (and (org-at-planning-p)
- (< (point) (point-max)))
- ;; Skip planning lines
- (forward-line))
- (while (re-search-forward
- org-drawer-regexp end t)
- ;; Skip drawers. You might think that
- ;; `org-at-drawer-p' would suffice, but for
- ;; some reason it doesn't work correctly when
- ;; operating on hidden text. This works, taken
- ;; from `org-agenda-get-some-entry-text'.
- (re-search-forward "^[ \t]*:END:.*\n?" end t)
- (goto-char (match-end 0)))
- (unless (or (= (point) (point-max))
- (org-at-heading-p)
- (looking-at-p "\n"))
- (insert "\n"))))
- t (if prefix
- nil
- 'tree)))
+ (org-with-wide-buffer
+ ;; `org-map-entries' narrows the buffer, which
+ ;; prevents us from seeing newlines before the
+ ;; current heading, so we do this part widened.
+ (while (not (looking-back "\n\n" nil))
+ ;; Insert blank lines before heading.
+ (insert "\n")))
+ (let ((end (org-entry-end-position)))
+ ;; Insert blank lines before entry content
+ (forward-line)
+ (while (and (org-at-planning-p)
+ (< (point) (point-max)))
+ ;; Skip planning lines
+ (forward-line))
+ (while (re-search-forward
+ org-drawer-regexp end t)
+ ;; Skip drawers. You might think that
+ ;; `org-at-drawer-p' would suffice, but for
+ ;; some reason it doesn't work correctly when
+ ;; operating on hidden text. This works, taken
+ ;; from `org-agenda-get-some-entry-text'.
+ (re-search-forward "^[ \t]*:END:.*\n?" end t)
+ (goto-char (match-end 0)))
+ (unless (or (= (point) (point-max))
+ (org-at-heading-p)
+ (looking-at-p "\n"))
+ (insert "\n"))))
+ t (if prefix
+ nil
+ 'tree)))
(defun acdw/hook--org-mode-fix-blank-lines ()
(when (eq major-mode 'org-mode)
(let ((current-prefix-arg 4))
(call-interactively #'unpackaged/org-fix-blank-lines))))
+;;; ADVICE
+
+;; 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.
+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
+if the field did fill the entire column, because, in this case
+the deletion might narrow the column."
+ (interactive "p")
+ (save-match-data
+ (org-check-before-invisible-edit 'delete-backward)
+ (if (and (= N 1)
+ (not overwrite-mode)
+ (not (org-region-active-p))
+ (not (eq (char-before) ?|))
+ (save-excursion (skip-chars-backward " \t") (not (bolp)))
+ (looking-at-p ".*?|")
+ (org-at-table-p))
+ (progn (forward-char -1) (org-delete-char 1))
+ (backward-delete-char-untabify N)
+ (org-fix-tags-on-the-fly))))
+
(provide 'acdw-org)
--
cgit 1.4.1-21-gabe81