mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-12-23 10:34:17 +00:00
org-list: rewrite of insert-item code.
* org-list.el (org-list-separating-blank-lines-number): use new accessors. (org-list-insert-item-generic): use list structures to insert a new item. (org-list-exchange-items): refactor and comment code. Now return new struct instead of modifying it, as list sorting would sometimes eat first item. (org-move-item-down,org-move-item-up): reflect changes to `org-list-exchange-items'. (org-insert-item): as `org-in-item-p' also computes item beginning when applicable, reuse the result. * org-timer.el (org-timer-item): as `org-in-item-p' also computes item beginning when applicable, reuse the result.
This commit is contained in:
parent
e865ce445a
commit
ddcd5d480f
339
lisp/org-list.el
339
lisp/org-list.el
@ -461,12 +461,9 @@ Arguments REGEXP, BOUND and NOERROR are similar to those used in
|
||||
(goto-char (match-end 0)))
|
||||
(looking-at regexp))))
|
||||
|
||||
(defun org-list-separating-blank-lines-number (pos top bottom)
|
||||
(defun org-list-separating-blank-lines-number (pos struct prevs)
|
||||
"Return number of blank lines that should separate items in list.
|
||||
POS is the position of point to be considered.
|
||||
|
||||
TOP and BOTTOM are respectively position of list beginning and
|
||||
list ending.
|
||||
POS is the position at item beginning to be considered.
|
||||
|
||||
Assume point is at item's beginning. If the item is alone, apply
|
||||
some heuristics to guess the result."
|
||||
@ -483,16 +480,16 @@ some heuristics to guess the result."
|
||||
((eq insert-blank-p t) 1)
|
||||
;; plain-list-item is 'auto. Count blank lines separating
|
||||
;; neighbours items in list.
|
||||
(t (let ((next-p (org-get-next-item (point) bottom)))
|
||||
(t (let ((next-p (org-list-get-next-item (point) struct prevs)))
|
||||
(cond
|
||||
;; Is there a next item?
|
||||
(next-p (goto-char next-p)
|
||||
(org-back-over-empty-lines))
|
||||
;; Is there a previous item?
|
||||
((org-get-previous-item (point) top)
|
||||
((org-list-get-prev-item (point) struct prevs)
|
||||
(org-back-over-empty-lines))
|
||||
;; User inserted blank lines, trust him
|
||||
((and (> pos (org-end-of-item-before-blank bottom))
|
||||
((and (> pos (org-list-get-item-end-before-blank pos struct))
|
||||
(> (save-excursion
|
||||
(goto-char pos)
|
||||
(skip-chars-backward " \t")
|
||||
@ -501,7 +498,8 @@ some heuristics to guess the result."
|
||||
;; Are there blank lines inside the item ?
|
||||
((save-excursion
|
||||
(org-search-forward-unenclosed
|
||||
"^[ \t]*$" (org-end-of-item-before-blank bottom) t)) 1)
|
||||
"^[ \t]*$" (org-list-get-item-end-before-blank pos struct) t))
|
||||
1)
|
||||
;; No parent: no blank line.
|
||||
(t 0))))))))
|
||||
|
||||
@ -513,83 +511,136 @@ new item will be created before the current one.
|
||||
Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET
|
||||
after the bullet. Cursor will be after this text once the
|
||||
function ends."
|
||||
(goto-char pos)
|
||||
;; Is point in a special block?
|
||||
(when (org-in-regexps-block-p
|
||||
"^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)"
|
||||
'(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2)))
|
||||
(if (not (cdr (assq 'insert org-list-automatic-rules)))
|
||||
;; Rule in `org-list-automatic-rules' forbids insertion.
|
||||
(error "Cannot insert item inside a block")
|
||||
;; Else, move before it prior to add a new item.
|
||||
(end-of-line)
|
||||
(re-search-backward "^[ \t]*#\\+\\(begin\\|BEGIN\\)_" nil t)
|
||||
(end-of-line 0)))
|
||||
(let* ((true-pos (point))
|
||||
(top (org-list-top-point))
|
||||
(bottom (copy-marker (org-list-bottom-point)))
|
||||
(bullet (and (goto-char (org-list-get-item-begin))
|
||||
(org-list-bullet-string (org-get-bullet))))
|
||||
(ind (org-get-indentation))
|
||||
(before-p (progn
|
||||
;; Description item: text starts after colons.
|
||||
(or (org-at-item-description-p)
|
||||
;; At a checkbox: text starts after it.
|
||||
(org-at-item-checkbox-p)
|
||||
;; Otherwise, text starts after bullet.
|
||||
(org-at-item-p))
|
||||
(<= true-pos (match-end 0))))
|
||||
(blank-lines-nb (org-list-separating-blank-lines-number
|
||||
true-pos top bottom))
|
||||
(insert-fun
|
||||
(lambda (text)
|
||||
;; insert bullet above item in order to avoid bothering
|
||||
;; with possible blank lines ending last item.
|
||||
(goto-char (org-list-get-item-begin))
|
||||
(org-indent-to-column ind)
|
||||
(insert (concat bullet (when checkbox "[ ] ") after-bullet))
|
||||
;; Stay between after-bullet and before text.
|
||||
(save-excursion
|
||||
(insert (concat text (make-string (1+ blank-lines-nb) ?\n))))
|
||||
(unless before-p
|
||||
;; store bottom: exchanging items doesn't change list
|
||||
;; bottom point but will modify marker anyway
|
||||
(setq bottom (marker-position bottom))
|
||||
(let ((col (current-column)))
|
||||
(org-list-exchange-items
|
||||
(org-list-get-item-begin) (org-get-next-item (point) bottom)
|
||||
bottom)
|
||||
;; recompute next-item: last sexp modified list
|
||||
(goto-char (org-get-next-item (point) bottom))
|
||||
(org-move-to-column col)))
|
||||
;; checkbox update might modify bottom point, so use a
|
||||
;; marker here
|
||||
(setq bottom (copy-marker bottom))
|
||||
(when checkbox (org-update-checkbox-count-maybe))
|
||||
(org-list-repair nil))))
|
||||
(goto-char true-pos)
|
||||
(cond
|
||||
(before-p (funcall insert-fun nil) t)
|
||||
;; Can't split item: insert bullet at the end of item.
|
||||
((not (org-get-alist-option org-M-RET-may-split-line 'item))
|
||||
(funcall insert-fun nil) t)
|
||||
;; else, insert a new bullet along with everything from point
|
||||
;; down to last non-blank line of item.
|
||||
(t
|
||||
(delete-horizontal-space)
|
||||
;; Get pos again in case previous command modified line.
|
||||
(let* ((pos (point))
|
||||
(end-before-blank (org-end-of-item-before-blank bottom))
|
||||
(after-text
|
||||
(when (< pos end-before-blank)
|
||||
(prog1
|
||||
(delete-and-extract-region pos end-before-blank)
|
||||
;; delete any blank line at and before point.
|
||||
(beginning-of-line)
|
||||
(while (looking-at "^[ \t]*$")
|
||||
(delete-region (point-at-bol) (1+ (point-at-eol)))
|
||||
(beginning-of-line 0))))))
|
||||
(funcall insert-fun after-text) t)))))
|
||||
(let ((case-fold-search t))
|
||||
(goto-char pos)
|
||||
;; 1. Check if a new item can be inserted at point: are we in an
|
||||
;; invalid block ? Move outside it if `org-list-automatic'
|
||||
;; rules says so.
|
||||
(when (or (eq (nth 2 (org-list-context)) 'invalid)
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(or (looking-at "^[ \t]*#\\+\\(begin\\|end\\)_")
|
||||
(looking-at (concat
|
||||
"\\("
|
||||
org-drawer-regexp
|
||||
"\\|^[ \t]*:END:[ \t]*$\\)"))
|
||||
(and (featurep 'org-inlinetask)
|
||||
(looking-at (org-inlinetask-outline-regexp))))))
|
||||
(if (not (cdr (assq 'insert org-list-automatic-rules)))
|
||||
(error "Cannot insert item inside a block")
|
||||
(end-of-line)
|
||||
(if (string-match "^\\*+[ \t]+" (match-string 0))
|
||||
(org-inlinetask-goto-beginning)
|
||||
(let ((block-start (if (string-match "#\\+" (match-string 0))
|
||||
"^[ \t]*#\\+begin_"
|
||||
org-drawer-regexp)))
|
||||
(re-search-backward block-start nil t)))
|
||||
(end-of-line 0)))
|
||||
;; 2. Get information about list: structure, usual helper
|
||||
;; functions, position of point with regards to item start
|
||||
;; (BEFOREP), blank lines number separating items (BLANK-NB),
|
||||
;; position of split (POS) if we're allowed to (SPLIT-LINE-P).
|
||||
(let* ((pos (point))
|
||||
(item (goto-char (org-get-item-beginning)))
|
||||
(struct (org-list-struct))
|
||||
(prevs (org-list-struct-prev-alist struct))
|
||||
(item-end (org-list-get-item-end item struct))
|
||||
(item-end-no-blank (org-list-get-item-end-before-blank item struct))
|
||||
(beforep (and (or (org-at-item-description-p)
|
||||
(looking-at org-list-full-item-re))
|
||||
(<= pos (match-end 0))))
|
||||
(split-line-p (org-get-alist-option org-M-RET-may-split-line 'item))
|
||||
(blank-nb (org-list-separating-blank-lines-number
|
||||
item struct prevs))
|
||||
;; 3. Build the new item to be created. Concatenate same
|
||||
;; bullet as item, checkbox, text AFTER-BULLET if
|
||||
;; provided, and text cut from point to end of item
|
||||
;; (TEXT-CUT) to form item's BODY. TEXT-CUT depends on
|
||||
;; BEFOREP and SPLIT-LINE-P. The difference of size
|
||||
;; between what was cut and what was inserted in buffer
|
||||
;; is stored in SIZE-OFFSET.
|
||||
(ind (org-list-get-ind item struct))
|
||||
(bullet (org-list-bullet-string (org-list-get-bullet item struct)))
|
||||
(box (when checkbox "[ ]"))
|
||||
(text-cut
|
||||
(and (not beforep) split-line-p
|
||||
(progn
|
||||
(goto-char pos)
|
||||
(skip-chars-backward " \r\t\n")
|
||||
(setq pos (point))
|
||||
(delete-and-extract-region pos item-end-no-blank))))
|
||||
(body (concat bullet (when box (concat box " ")) after-bullet
|
||||
(or (and text-cut
|
||||
(if (string-match "\\`[ \t]+" text-cut)
|
||||
(replace-match "" t t text-cut)
|
||||
text-cut))
|
||||
"")))
|
||||
(item-sep (make-string (1+ blank-nb) ?\n))
|
||||
(item-size (+ ind (length body) (length item-sep)))
|
||||
(size-offset (- item-size (length text-cut))))
|
||||
;; 4. Insert effectively item into buffer
|
||||
(goto-char item)
|
||||
(org-indent-to-column ind)
|
||||
(insert body)
|
||||
(insert item-sep)
|
||||
;; 5. Add new item to STRUCT.
|
||||
(mapc (lambda (e)
|
||||
(let ((p (car e))
|
||||
(end (nth 5 e)))
|
||||
(cond
|
||||
;; Before inserted item, positions don't change but
|
||||
;; an item ending after insertion has its end shifted
|
||||
;; by SIZE-OFFSET.
|
||||
((< p item)
|
||||
(when (> end item) (setcar (nthcdr 5 e) (+ end size-offset))))
|
||||
;; Trivial cases where current item isn't split in
|
||||
;; two. Just shift every item after new one by
|
||||
;; ITEM-SIZE.
|
||||
((or beforep (not split-line-p))
|
||||
(setcar e (+ p item-size))
|
||||
(setcar (nthcdr 5 e) (+ end item-size)))
|
||||
;; Item is split in two: elements before POS are just
|
||||
;; shifted by ITEM-SIZE. In the case item would end
|
||||
;; after split POS, ending is only shifted by
|
||||
;; SIZE-OFFSET.
|
||||
((< p pos)
|
||||
(setcar e (+ p item-size))
|
||||
(if (< end pos)
|
||||
(setcar (nthcdr 5 e) (+ end item-size))
|
||||
(setcar (nthcdr 5 e) (+ end size-offset))))
|
||||
;; Elements after POS are moved into new item. Length
|
||||
;; of ITEM-SEP has to be removed as ITEM-SEP
|
||||
;; doesn't appear in buffer yet.
|
||||
((< p item-end)
|
||||
(setcar e (+ p size-offset (- item pos (length item-sep))))
|
||||
(if (= end item-end)
|
||||
(setcar (nthcdr 5 e) (+ item item-size))
|
||||
(setcar (nthcdr 5 e)
|
||||
(+ end size-offset
|
||||
(- item pos (length item-sep))))))
|
||||
;; Elements at ITEM-END or after are only shifted by
|
||||
;; SIZE-OFFSET.
|
||||
(t (setcar e (+ p size-offset))
|
||||
(setcar (nthcdr 5 e) (+ end size-offset))))))
|
||||
struct)
|
||||
(setq struct (sort
|
||||
(cons (list item ind bullet nil box (+ item item-size))
|
||||
struct)
|
||||
(lambda (e1 e2) (< (car e1) (car e2)))))
|
||||
;; 6. If not BEFOREP, new item must appear after ITEM, so
|
||||
;; exchange ITEM with the next item in list. Position cursor
|
||||
;; after bullet, counter, checkbox, and label.
|
||||
(if beforep
|
||||
(goto-char item)
|
||||
(setq struct (org-list-exchange-items item (+ item item-size) struct))
|
||||
(goto-char (org-list-get-next-item
|
||||
item struct (org-list-struct-prev-alist struct))))
|
||||
(org-list-struct-fix-struct struct (org-list-struct-parent-alist struct))
|
||||
(when checkbox (org-update-checkbox-count-maybe))
|
||||
(or (org-at-item-description-p)
|
||||
(looking-at org-list-full-item-re))
|
||||
(goto-char (match-end 0))
|
||||
t)))
|
||||
|
||||
(defvar org-last-indent-begin-marker (make-marker))
|
||||
(defvar org-last-indent-end-marker (make-marker))
|
||||
@ -839,38 +890,58 @@ in a plain list, or if this is the last item in the list."
|
||||
|
||||
(defun org-list-exchange-items (beg-A beg-B struct)
|
||||
"Swap item starting at BEG-A with item starting at BEG-B in STRUCT.
|
||||
Blank lines at the end of items are left in place.
|
||||
Blank lines at the end of items are left in place. Return the new
|
||||
structure after the changes.
|
||||
|
||||
Assume BEG-A is lesser than BEG-B and that BEG-A and BEG-B
|
||||
belong to the same sub-list.
|
||||
Assume BEG-A is lesser than BEG-B and that BEG-A and BEG-B belong
|
||||
to the same sub-list.
|
||||
|
||||
This function modifies STRUCT."
|
||||
(save-excursion
|
||||
(let* ((end-of-item-no-blank
|
||||
(lambda (pos)
|
||||
(goto-char (org-list-get-item-end-before-blank pos struct))))
|
||||
(end-A-no-blank (funcall end-of-item-no-blank beg-A))
|
||||
(end-B-no-blank (funcall end-of-item-no-blank beg-B))
|
||||
(let* ((end-A-no-blank (org-list-get-item-end-before-blank beg-A struct))
|
||||
(end-B-no-blank (org-list-get-item-end-before-blank beg-B struct))
|
||||
(end-A (org-list-get-item-end beg-A struct))
|
||||
(end-B (org-list-get-item-end beg-B struct))
|
||||
(size-A (- end-A-no-blank beg-A))
|
||||
(size-B (- end-B-no-blank beg-B))
|
||||
(body-A (buffer-substring beg-A end-A-no-blank))
|
||||
(body-B (buffer-substring beg-B end-B-no-blank))
|
||||
(between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B)))
|
||||
(between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B))
|
||||
(sub-A (cons beg-A (org-list-get-subtree beg-A struct)))
|
||||
(sub-B (cons beg-B (org-list-get-subtree beg-B struct))))
|
||||
;; 1. Move effectively items in buffer.
|
||||
(goto-char beg-A)
|
||||
(delete-region beg-A end-B-no-blank)
|
||||
(insert (concat body-B between-A-no-blank-and-B body-A))
|
||||
;; Now modify struct. No need to re-read the list, the
|
||||
;; transformation is just a shift of positions
|
||||
(let* ((sub-A (cons beg-A (org-list-get-subtree beg-A struct)))
|
||||
(sub-B (cons beg-B (org-list-get-subtree beg-B struct)))
|
||||
(end-A (org-list-get-item-end beg-A struct))
|
||||
(end-B (org-list-get-item-end beg-B struct))
|
||||
(inter-A-B (- beg-B end-A))
|
||||
(size-A (- end-A beg-A))
|
||||
(size-B (- end-B beg-B)))
|
||||
(mapc (lambda (e) (org-list-set-pos e struct (+ e size-B inter-A-B)))
|
||||
sub-A)
|
||||
(mapc (lambda (e) (org-list-set-pos e struct (- e size-A inter-A-B)))
|
||||
sub-B)
|
||||
(sort struct (lambda (e1 e2) (< (car e1) (car e2))))))))
|
||||
;; 2. Now modify struct. No need to re-read the list, the
|
||||
;; transformation is just a shift of positions. Some special
|
||||
;; attention is required for items ending at END-A and END-B
|
||||
;; as empty spaces are not moved there. In others words, item
|
||||
;; BEG-A will end with whitespaces that were at the end of
|
||||
;; BEG-B and the same applies to BEG-B.
|
||||
(mapc (lambda (e)
|
||||
(let ((pos (car e)))
|
||||
(cond
|
||||
((< pos beg-A))
|
||||
((memq pos sub-A)
|
||||
(let ((end-e (nth 5 e)))
|
||||
(setcar e (+ pos (- end-B-no-blank end-A-no-blank)))
|
||||
(setcar (nthcdr 5 e)
|
||||
(+ end-e (- end-B-no-blank end-A-no-blank)))
|
||||
(when (= end-e end-A) (setcar (nthcdr 5 e) end-B))))
|
||||
((memq pos sub-B)
|
||||
(let ((end-e (nth 5 e)))
|
||||
(setcar e (- (+ pos beg-A) beg-B))
|
||||
(setcar (nthcdr 5 e) (+ end-e (- beg-A beg-B)))
|
||||
(when (= end-e end-B)
|
||||
(setcar (nthcdr 5 e)
|
||||
(+ beg-A size-B (- end-A end-A-no-blank))))))
|
||||
((< pos beg-B)
|
||||
(let ((end-e (nth 5 e)))
|
||||
(setcar e (+ pos (- size-B size-A)))
|
||||
(setcar (nthcdr 5 e) (+ end-e (- size-B size-A))))))))
|
||||
struct)
|
||||
(sort struct (lambda (e1 e2) (< (car e1) (car e2)))))))
|
||||
|
||||
(defun org-move-item-down ()
|
||||
"Move the plain list item at point down, i.e. swap with following item.
|
||||
@ -888,7 +959,8 @@ so this really moves item trees."
|
||||
(progn
|
||||
(goto-char pos)
|
||||
(error "Cannot move this item further down"))
|
||||
(org-list-exchange-items actual-item next-item struct)
|
||||
(setq struct
|
||||
(org-list-exchange-items actual-item next-item struct))
|
||||
;; Use a short variation of `org-list-struct-fix-struct' as
|
||||
;; there's no need to go through all the steps.
|
||||
(let ((old-struct (mapcar (lambda (e) (copy-alist e)) struct))
|
||||
@ -916,7 +988,8 @@ so this really moves item trees."
|
||||
(progn
|
||||
(goto-char pos)
|
||||
(error "Cannot move this item further up"))
|
||||
(org-list-exchange-items prev-item actual-item struct)
|
||||
(setq struct
|
||||
(org-list-exchange-items prev-item actual-item struct))
|
||||
;; Use a short variation of `org-list-struct-fix-struct' as
|
||||
;; there's no need to go through all the steps.
|
||||
(let ((old-struct (mapcar (lambda (e) (copy-alist e)) struct))
|
||||
@ -936,27 +1009,29 @@ If CHECKBOX is non-nil, add a checkbox next to the bullet.
|
||||
|
||||
Return t when things worked, nil when we are not in an item, or
|
||||
item is invisible."
|
||||
(unless (or (not (org-in-item-p))
|
||||
(save-excursion
|
||||
(goto-char (org-get-item-beginning))
|
||||
(outline-invisible-p)))
|
||||
(if (save-excursion
|
||||
(goto-char (org-list-get-item-begin))
|
||||
(org-at-item-timer-p))
|
||||
;; Timer list: delegate to `org-timer-item'.
|
||||
(progn (org-timer-item) t)
|
||||
;; if we're in a description list, ask for the new term.
|
||||
(let ((desc-text (when (save-excursion
|
||||
(and (goto-char (org-list-get-item-begin))
|
||||
(org-at-item-description-p)))
|
||||
(concat (read-string "Term: ") " :: "))))
|
||||
;; Don't insert a checkbox if checkbox rule is applied and it
|
||||
;; is a description item.
|
||||
(org-list-insert-item-generic
|
||||
(point) (and checkbox
|
||||
(or (not desc-text)
|
||||
(not (cdr (assq 'checkbox org-list-automatic-rules)))))
|
||||
desc-text)))))
|
||||
(let ((itemp (org-in-item-p)))
|
||||
(unless (or (not itemp)
|
||||
(save-excursion
|
||||
(goto-char itemp)
|
||||
(org-invisible-p)))
|
||||
(if (save-excursion
|
||||
(goto-char itemp)
|
||||
(org-at-item-timer-p))
|
||||
;; Timer list: delegate to `org-timer-item'.
|
||||
(progn (org-timer-item) t)
|
||||
;; if we're in a description list, ask for the new term.
|
||||
(let ((desc-text (when (save-excursion
|
||||
(and (goto-char itemp)
|
||||
(org-at-item-description-p)))
|
||||
(concat (read-string "Term: ") " :: "))))
|
||||
;; Don't insert a checkbox if checkbox rule is applied and it
|
||||
;; is a description item.
|
||||
(org-list-insert-item-generic
|
||||
(point) (and checkbox
|
||||
(or (not desc-text)
|
||||
(not (cdr (assq 'checkbox org-list-automatic-rules)))))
|
||||
desc-text))))))
|
||||
|
||||
|
||||
;;; Structures
|
||||
|
||||
|
@ -207,22 +207,22 @@ it in the buffer."
|
||||
(defun org-timer-item (&optional arg)
|
||||
"Insert a description-type item with the current timer value."
|
||||
(interactive "P")
|
||||
(cond
|
||||
;; In a timer list, insert with `org-list-insert-item-generic'.
|
||||
((and (org-in-item-p)
|
||||
(save-excursion (org-beginning-of-item) (org-at-item-timer-p)))
|
||||
(org-list-insert-item-generic
|
||||
(point) nil (concat (org-timer (when arg '(4)) t) ":: ")))
|
||||
;; In a list of another type, don't break anything: throw an error.
|
||||
((org-in-item-p)
|
||||
(error "This is not a timer list"))
|
||||
;; Else, insert the timer correctly indented at bol.
|
||||
(t
|
||||
(beginning-of-line)
|
||||
(org-indent-line-function)
|
||||
(insert "- ")
|
||||
(org-timer (when arg '(4)))
|
||||
(insert ":: "))))
|
||||
(let ((itemp (org-in-item-p)))
|
||||
(cond
|
||||
;; In a timer list, insert with `org-list-insert-item-generic'.
|
||||
((and itemp
|
||||
(save-excursion (goto-char itemp) (org-at-item-timer-p)))
|
||||
(org-list-insert-item-generic
|
||||
(point) nil (concat (org-timer (when arg '(4)) t) ":: ")))
|
||||
;; In a list of another type, don't break anything: throw an error.
|
||||
(itemp (error "This is not a timer list"))
|
||||
;; Else, insert the timer correctly indented at bol.
|
||||
(t
|
||||
(beginning-of-line)
|
||||
(org-indent-line-function)
|
||||
(insert "- ")
|
||||
(org-timer (when arg '(4)))
|
||||
(insert ":: ")))))
|
||||
|
||||
(defun org-timer-fix-incomplete (hms)
|
||||
"If hms is a H:MM:SS string with missing hour or hour and minute, fix it."
|
||||
|
Loading…
Reference in New Issue
Block a user