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?

1 files changed, 146 insertions, 122 deletions

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