summary refs log tree commit diff stats
path: root/lisp
diff options
context:
space:
mode:
authorCase Duckworth2021-04-12 17:58:33 -0500
committerCase Duckworth2021-04-12 17:58:33 -0500
commit57e027f753e5f3c77030c97d3de7ad5a7dd61f86 (patch)
tree0de2c9f560aea439c25b0f2f95bc2f9fed365320 /lisp
parentConfigure `company-mode' (diff)
downloademacs-57e027f753e5f3c77030c97d3de7ad5a7dd61f86.tar.gz
emacs-57e027f753e5f3c77030c97d3de7ad5a7dd61f86.zip
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?
Diffstat (limited to 'lisp')
-rw-r--r--lisp/acdw-org.el268
1 files changed, 146 insertions, 122 deletions
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
29 ;; MAYBE: Use `org-element-lineage'. 29 ;; MAYBE: Use `org-element-lineage'.
30 (when-let* ((parent (org-element-property :parent element))) 30 (when-let* ((parent (org-element-property :parent element)))
31 (or (eq type (car parent)) 31 (or (eq type (car parent))
32 (unpackaged/org-element-descendant-of type parent)))) 32 (unpackaged/org-element-descendant-of type parent))))
33 33
34(defun unpackaged/org-return-dwim (&optional default) 34(defun unpackaged/org-return-dwim (&optional default)
35 "A helpful replacement for `org-return'. With prefix, 35 "A helpful replacement for `org-return'. With prefix,
@@ -44,97 +44,97 @@ appropriate. In tables, insert a new row or end the table."
44 (if default 44 (if default
45 (org-return) 45 (org-return)
46 (cond 46 (cond
47 ;; Act depending on context around point. 47 ;; Act depending on context around point.
48 48
49 ;; NOTE: I prefer RET to not follow links, but by uncommenting 49 ;; NOTE: I prefer RET to not follow links, but by uncommenting
50 ;; this block, links will be followed. 50 ;; this block, links will be followed.
51 ;; FURTHER NOTE: Ideally, I would follow links unless point 51 ;; FURTHER NOTE: Ideally, I would follow links unless point
52 ;; /appeared/ to be at the end of the line (even if it's still 52 ;; /appeared/ to be at the end of the line (even if it's still
53 ;; inside the link) -- when it would do `org-return'. That 53 ;; inside the link) -- when it would do `org-return'. That
54 ;; would take some /doing/, however. 54 ;; would take some /doing/, however.
55 55
56 ;; ((eq 'link (car (org-element-context))) 56 ;; ((eq 'link (car (org-element-context)))
57 ;; ;; Link: Open it. 57 ;; ;; Link: Open it.
58 ;; (org-open-at-point-global)) 58 ;; (org-open-at-point-global))
59 59
60 ((org-at-heading-p) 60 ((org-at-heading-p)
61 ;; Heading: Move to position after entry content. NOTE: This is 61 ;; Heading: Move to position after entry content. NOTE: This is
62 ;; probably the most interesting feature of this function. 62 ;; probably the most interesting feature of this function.
63 (let ((heading-start (org-entry-beginning-position))) 63 (let ((heading-start (org-entry-beginning-position)))
64 (goto-char (org-entry-end-position)) 64 (goto-char (org-entry-end-position))
65 (cond ((and (org-at-heading-p) 65 (cond ((and (org-at-heading-p)
66 (= heading-start (org-entry-beginning-position))) 66 (= heading-start (org-entry-beginning-position)))
67 ;; Entry ends on its heading; add newline after 67 ;; Entry ends on its heading; add newline after
68 (end-of-line) 68 (end-of-line)
69 (insert "\n\n")) 69 (insert "\n\n"))
70 (t 70 (t
71 ;; Entry ends after its heading; back up 71 ;; Entry ends after its heading; back up
72 (forward-line -1) 72 (forward-line -1)
73 (end-of-line) 73 (end-of-line)
74 (when (org-at-heading-p) 74 (when (org-at-heading-p)
75 ;; At the same heading 75 ;; At the same heading
76 (forward-line) 76 (forward-line)
77 (insert "\n") 77 (insert "\n")
78 (forward-line -1)) 78 (forward-line -1))
79 ;; FIXME: looking-back is supposed to be called with 79 ;; FIXME: looking-back is supposed to be called with
80 ;; more arguments. 80 ;; more arguments.
81 (while (not (looking-back (rx 81 (while (not (looking-back (rx
82 (repeat 3 82 (repeat 3
83 (seq (optional blank) 83 (seq (optional blank)
84 "\n"))) 84 "\n")))
85 nil)) 85 nil))
86 (insert "\n")) 86 (insert "\n"))
87 (forward-line -1))))) 87 (forward-line -1)))))
88 88
89 ((org-at-item-checkbox-p) 89 ((org-at-item-checkbox-p)
90 ;; Checkbox: Insert new item with checkbox. 90 ;; Checkbox: Insert new item with checkbox.
91 (org-insert-todo-heading nil)) 91 (org-insert-todo-heading nil))
92 92
93 ((org-in-item-p) 93 ((org-in-item-p)
94 ;; Plain list. Yes, this gets a little complicated... 94 ;; Plain list. Yes, this gets a little complicated...
95 (let ((context (org-element-context))) 95 (let ((context (org-element-context)))
96 (if (or (eq 'plain-list (car context)) ; First item in list 96 (if (or (eq 'plain-list (car context)) ; First item in list
97 (and (eq 'item (car context)) 97 (and (eq 'item (car context))
98 (not (eq (org-element-property 98 (not (eq (org-element-property
99 :contents-begin context) 99 :contents-begin context)
100 (org-element-property 100 (org-element-property
101 :contents-end context)))) 101 :contents-end context))))
102 ;; Element in list item, e.g. a link 102 ;; Element in list item, e.g. a link
103 (unpackaged/org-element-descendant-of 'item context)) 103 (unpackaged/org-element-descendant-of 'item context))
104 ;; Non-empty item: Add new item. 104 ;; Non-empty item: Add new item.
105 (org-insert-item) 105 (org-insert-item)
106 ;; Empty item: Close the list. 106 ;; Empty item: Close the list.
107 ;; TODO: Do this with org functions rather than operating 107 ;; TODO: Do this with org functions rather than operating
108 ;; on the text. Can't seem to find the right function. 108 ;; on the text. Can't seem to find the right function.
109 (delete-region (line-beginning-position) (line-end-position)) 109 (delete-region (line-beginning-position) (line-end-position))
110 (insert "\n")))) 110 (insert "\n"))))
111 111
112 ((when (fboundp 'org-inlinetask-in-task-p) 112 ((when (fboundp 'org-inlinetask-in-task-p)
113 (org-inlinetask-in-task-p)) 113 (org-inlinetask-in-task-p))
114 ;; Inline task: Don't insert a new heading. 114 ;; Inline task: Don't insert a new heading.
115 (org-return)) 115 (org-return))
116 116
117 ((org-at-table-p) 117 ((org-at-table-p)
118 (cond ((save-excursion 118 (cond ((save-excursion
119 (beginning-of-line) 119 (beginning-of-line)
120 ;; See `org-table-next-field'. 120 ;; See `org-table-next-field'.
121 (cl-loop with end = (line-end-position) 121 (cl-loop with end = (line-end-position)
122 for cell = (org-element-table-cell-parser) 122 for cell = (org-element-table-cell-parser)
123 always (equal (org-element-property 123 always (equal (org-element-property
124 :contents-begin cell) 124 :contents-begin cell)
125 (org-element-property 125 (org-element-property
126 :contents-end cell)) 126 :contents-end cell))
127 while (re-search-forward "|" end t))) 127 while (re-search-forward "|" end t)))
128 ;; Empty row: end the table. 128 ;; Empty row: end the table.
129 (delete-region (line-beginning-position) 129 (delete-region (line-beginning-position)
130 (line-end-position)) 130 (line-end-position))
131 (org-return)) 131 (org-return))
132 (t 132 (t
133 ;; Non-empty row: call `org-return'. 133 ;; Non-empty row: call `org-return'.
134 (org-return)))) 134 (org-return))))
135 (t 135 (t
136 ;; All other cases: call `org-return'. 136 ;; All other cases: call `org-return'.
137 (org-return))))) 137 (org-return)))))
138 138
139;;; ORG-FIX-BLANK-LINES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 139;;; ORG-FIX-BLANK-LINES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
140 140
@@ -145,40 +145,64 @@ appropriate. In tables, insert a new row or end the table."
145 headings's drawers." 145 headings's drawers."
146 (interactive "P") 146 (interactive "P")
147 (org-map-entries (lambda () 147 (org-map-entries (lambda ()
148 (org-with-wide-buffer 148 (org-with-wide-buffer
149 ;; `org-map-entries' narrows the buffer, which 149 ;; `org-map-entries' narrows the buffer, which
150 ;; prevents us from seeing newlines before the 150 ;; prevents us from seeing newlines before the
151 ;; current heading, so we do this part widened. 151 ;; current heading, so we do this part widened.
152 (while (not (looking-back "\n\n" nil)) 152 (while (not (looking-back "\n\n" nil))
153 ;; Insert blank lines before heading. 153 ;; Insert blank lines before heading.
154 (insert "\n"))) 154 (insert "\n")))
155 (let ((end (org-entry-end-position))) 155 (let ((end (org-entry-end-position)))
156 ;; Insert blank lines before entry content 156 ;; Insert blank lines before entry content
157 (forward-line) 157 (forward-line)
158 (while (and (org-at-planning-p) 158 (while (and (org-at-planning-p)
159 (< (point) (point-max))) 159 (< (point) (point-max)))
160 ;; Skip planning lines 160 ;; Skip planning lines
161 (forward-line)) 161 (forward-line))
162 (while (re-search-forward 162 (while (re-search-forward
163 org-drawer-regexp end t) 163 org-drawer-regexp end t)
164 ;; Skip drawers. You might think that 164 ;; Skip drawers. You might think that
165 ;; `org-at-drawer-p' would suffice, but for 165 ;; `org-at-drawer-p' would suffice, but for
166 ;; some reason it doesn't work correctly when 166 ;; some reason it doesn't work correctly when
167 ;; operating on hidden text. This works, taken 167 ;; operating on hidden text. This works, taken
168 ;; from `org-agenda-get-some-entry-text'. 168 ;; from `org-agenda-get-some-entry-text'.
169 (re-search-forward "^[ \t]*:END:.*\n?" end t) 169 (re-search-forward "^[ \t]*:END:.*\n?" end t)
170 (goto-char (match-end 0))) 170 (goto-char (match-end 0)))
171 (unless (or (= (point) (point-max)) 171 (unless (or (= (point) (point-max))
172 (org-at-heading-p) 172 (org-at-heading-p)
173 (looking-at-p "\n")) 173 (looking-at-p "\n"))
174 (insert "\n")))) 174 (insert "\n"))))
175 t (if prefix 175 t (if prefix
176 nil 176 nil
177 'tree))) 177 'tree)))
178 178
179(defun acdw/hook--org-mode-fix-blank-lines () 179(defun acdw/hook--org-mode-fix-blank-lines ()
180 (when (eq major-mode 'org-mode) 180 (when (eq major-mode 'org-mode)
181 (let ((current-prefix-arg 4)) 181 (let ((current-prefix-arg 4))
182 (call-interactively #'unpackaged/org-fix-blank-lines)))) 182 (call-interactively #'unpackaged/org-fix-blank-lines))))
183 183
184;;; ADVICE
185
186;; Correct `org-delete-backward-char' to use `backward-delete-char-untabify'
187(defun acdw-org/delete-backward-char (N)
188 "Like `delete-backward-char-untabify', insert whitespace at field end in tables.
189When deleting backwards, in tables this function will insert
190whitespace in front of the next \"|\" separator, to keep the
191table aligned. The table will still be marked for re-alignment
192if the field did fill the entire column, because, in this case
193the deletion might narrow the column."
194 (interactive "p")
195 (save-match-data
196 (org-check-before-invisible-edit 'delete-backward)
197 (if (and (= N 1)
198 (not overwrite-mode)
199 (not (org-region-active-p))
200 (not (eq (char-before) ?|))
201 (save-excursion (skip-chars-backward " \t") (not (bolp)))
202 (looking-at-p ".*?|")
203 (org-at-table-p))
204 (progn (forward-char -1) (org-delete-char 1))
205 (backward-delete-char-untabify N)
206 (org-fix-tags-on-the-fly))))
207
184(provide 'acdw-org) 208(provide 'acdw-org)