Revise +org--insert-item

Which powers +org/insert-item-below and +org/insert-item-above.
This commit is contained in:
Henrik Lissner 2020-07-26 15:42:50 -04:00
parent e6979166ee
commit 076cee4e89
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395

View file

@ -23,68 +23,56 @@
t))) t)))
(defun +org--insert-item (direction) (defun +org--insert-item (direction)
(let* ((context (let ((context (org-element-lineage
(save-excursion (org-element-context)
(when (bolp) '(table table-row headline inlinetask item plain-list)
(back-to-indentation) t)))
(forward-char)) (pcase (org-element-type context)
(org-element-lineage ;; Add a new list item (carrying over checkboxes if necessary)
(org-element-context) ((or `item `plain-list)
'(table table-row headline inlinetask item plain-list) ;; Position determines where org-insert-todo-heading and org-insert-item
t))) ;; insert the new list item.
(type (org-element-type context))) (if (eq direction 'above)
(cond ((memq type '(item plain-list)) (org-beginning-of-item)
(let ((marker (org-element-property :bullet context)) (org-end-of-item))
(pad (save-excursion (if (org-element-property :checkbox context)
(org-beginning-of-item) (org-insert-todo-heading nil)
(back-to-indentation) (org-insert-item)))
(- (point) (line-beginning-position)))))
(save-match-data
(pcase direction
(`below
(org-end-of-item)
(backward-char)
(end-of-line)
(if (and marker (string-match "\\([0-9]+\\)\\([).] *\\)" marker))
(let ((l (line-number-at-pos)))
(org-insert-item)
(when (= l (line-number-at-pos))
(org-next-item)
(org-end-of-line)))
(insert "\n" (make-string pad 32) (or marker ""))))
(`above
(org-beginning-of-item)
(if (and marker (string-match-p "[0-9]+[).]" marker))
(org-insert-item)
(insert (make-string pad 32) (or marker ""))
(save-excursion (insert "\n")))))))
(when (org-element-property :checkbox context)
(insert "[ ] ")))
((memq type '(table table-row)) ;; Add a new table row
(pcase direction ((or `table `table-row)
('below (save-excursion (org-table-insert-row t)) (pcase direction
(org-table-next-row)) ('below (save-excursion (org-table-insert-row t))
('above (save-excursion (org-shiftmetadown)) (org-table-next-row))
(+org/table-previous-row)))) ('above (save-excursion (org-shiftmetadown))
(+org/table-previous-row))))
((let ((level (or (org-current-level) 1))) ;; Otherwise, add a new heading, carrying over any todo state, if
(pcase direction ;; necessary.
(`below (_
(let (org-insert-heading-respect-content) (let ((level (or (org-current-level) 1)))
(goto-char (line-end-position)) ;; I intentionally avoid `org-insert-heading' and the like because they
(org-end-of-subtree) ;; impose unpredictable whitespace rules depending on the cursor
(insert "\n" (make-string level ?*) " "))) ;; position. It's simpler to express this command's responsibility at a
(`above ;; lower level than work around all the quirks in org's API.
(org-back-to-heading) (pcase direction
(insert (make-string level ?*) " ") (`below
(save-excursion (insert "\n")))) (let (org-insert-heading-respect-content)
(when-let* ((todo-keyword (org-element-property :todo-keyword context)) (goto-char (line-end-position))
(todo-type (org-element-property :todo-type context))) (org-end-of-subtree)
(org-todo (cond ((eq todo-type 'done) (insert "\n" (make-string level ?*) " ")))
(car (+org-get-todo-keywords-for todo-keyword))) (`above
(todo-keyword) (org-back-to-heading)
('todo))))))) (insert (make-string level ?*) " ")
(save-excursion (insert "\n"))))
(when-let* ((todo-keyword (org-element-property :todo-keyword context))
(todo-type (org-element-property :todo-type context)))
(org-todo
(cond ((eq todo-type 'done)
;; Doesn't make sense to create more "DONE" headings
(car (+org-get-todo-keywords-for todo-keyword)))
(todo-keyword)
('todo)))))))
(when (org-invisible-p) (when (org-invisible-p)
(org-show-hidden-entry)) (org-show-hidden-entry))
@ -278,9 +266,9 @@ If on a:
(org-element-property :end context))))))) (org-element-property :end context)))))))
;; I use this instead of `org-insert-item' or `org-insert-heading' which are too ;; I use these instead of `org-insert-item' or `org-insert-heading' because they
;; opinionated and perform this simple task incorrectly (e.g. whitespace in the ;; impose bizarre whitespace rules depending on cursor location and many
;; wrong places). ;; settings. These commands have a much simpler responsibility.
;;;###autoload ;;;###autoload
(defun +org/insert-item-below (count) (defun +org/insert-item-below (count)
"Inserts a new heading, table cell or item below the current one." "Inserts a new heading, table cell or item below the current one."