From ddcd5d480f04271e44303bf57ab20e960b233e1e Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Fri, 24 Dec 2010 13:25:37 +0100 Subject: [PATCH] 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. --- lisp/org-list.el | 339 ++++++++++++++++++++++++++++------------------ lisp/org-timer.el | 32 ++--- 2 files changed, 223 insertions(+), 148 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index cc98cad49..22aedd83a 100644 --- a/lisp/org-list.el +++ b/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 diff --git a/lisp/org-timer.el b/lisp/org-timer.el index 908232792..d3b2572f1 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -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."