1 ;;; org-list.el --- Plain lists for Org-mode
3 ;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
5 ;; Author: Carsten Dominik <carsten at orgmode dot org>
6 ;; Bastien Guerry <bzg AT altern DOT org>
7 ;; Keywords: outlines, hypermedia, calendar, wp
8 ;; Homepage: http://orgmode.org
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
29 ;; This file contains the code dealing with plain lists in Org-mode.
38 (defvar org-blank-before-new-entry
)
39 (defvar org-M-RET-may-split-line
)
40 (defvar org-complex-heading-regexp
)
41 (defvar org-odd-levels-only
)
42 (defvar org-outline-regexp
)
43 (defvar org-ts-regexp
)
44 (defvar org-ts-regexp-both
)
46 (declare-function org-invisible-p
"org" ())
47 (declare-function org-on-heading-p
"org" (&optional invisible-ok
))
48 (declare-function outline-next-heading
"outline" ())
49 (declare-function org-back-to-heading
"org" (&optional invisible-ok
))
50 (declare-function org-back-over-empty-lines
"org" ())
51 (declare-function org-trim
"org" (s))
52 (declare-function org-get-indentation
"org" (&optional line
))
53 (declare-function org-timer-item
"org-timer" (&optional arg
))
54 (declare-function org-timer-hms-to-secs
"org-timer" (hms))
55 (declare-function org-combine-plists
"org" (&rest plists
))
56 (declare-function org-entry-get
"org"
57 (pom property
&optional inherit literal-nil
))
58 (declare-function org-narrow-to-subtree
"org" ())
59 (declare-function org-show-subtree
"org" ())
60 (declare-function org-in-regexps-block-p
"org"
61 (start-re end-re
&optional bound
))
62 (declare-function org-level-increment
"org" ())
63 (declare-function org-at-heading-p
"org" (&optional ignored
))
64 (declare-function outline-previous-heading
"outline" ())
65 (declare-function org-icompleting-read
"org" (&rest args
))
66 (declare-function org-time-string-to-seconds
"org" (s))
68 (defgroup org-plain-lists nil
69 "Options concerning plain lists in Org-mode."
70 :tag
"Org Plain lists"
71 :group
'org-structure
)
73 (defcustom org-cycle-include-plain-lists t
74 "When t, make TAB cycle visibility on plain list items.
75 Cycling plain lists works only when the cursor is on a plain list
76 item. When the cursor is on an outline heading, plain lists are
77 treated as text. This is the most stable way of handling this,
78 which is why it is the default.
80 When this is the symbol `integrate', then during cycling, plain
81 list items will *temporarily* be interpreted as outline headlines
82 with a level given by 1000+i where i is the indentation of the
83 bullet. This setting can lead to strange effects when switching
84 visibility to `children', because the first \"child\" in a
85 subtree decides what children should be listed. If that first
86 \"child\" is a plain list item with an implied large level
87 number, all true children and grand children of the outline
88 heading will be exposed in a children' view."
89 :group
'org-plain-lists
91 (const :tag
"Never" nil
)
92 (const :tag
"With cursor in plain list (recommended)" t
)
93 (const :tag
"As children of outline headings" integrate
)))
95 (defcustom org-list-demote-modify-bullet nil
96 "Default bullet type installed when demoting an item.
97 This is an association list, for each bullet type, this alist will point
98 to the bullet that should be used when this item is demoted.
101 (setq org-list-demote-modify-bullet
102 '((\"+\" . \"-\") (\"-\" . \"+\") (\"*\" . \"+\")))
107 + Silence of the Lambs
110 + The Hunt for Red October
116 - Silence of the Lambs
119 - The Hunt for Red October
121 :group
'org-plain-lists
124 (choice :tag
"If the current bullet is "
130 (choice :tag
"demotion will change it to"
137 (defcustom org-plain-list-ordered-item-terminator t
138 "The character that makes a line with leading number an ordered list item.
139 Valid values are ?. and ?\). To get both terminators, use t. While
140 ?. may look nicer, it creates the danger that a line with leading
141 number may be incorrectly interpreted as an item. ?\) therefore is
143 :group
'org-plain-lists
144 :type
'(choice (const :tag
"dot like in \"2.\"" ?.
)
145 (const :tag
"paren like in \"2)\"" ?\
))
146 (const :tab
"both" t
)))
148 (defcustom org-list-two-spaces-after-bullet-regexp nil
149 "A regular expression matching bullets that should have 2 spaces after them.
150 When nil, no bullet will have two spaces after them.
151 When a string, it will be used as a regular expression. When the
152 bullet type of a list is changed, the new bullet type will be
153 matched against this regexp. If it matches, there will be two
154 spaces instead of one after the bullet in each item of the list."
155 :group
'org-plain-lists
157 (const :tag
"never" nil
)
160 (defcustom org-list-ending-method
'both
161 "Determine where plain lists should end.
162 Valid values are: `regexp', `indent' or `both'.
164 When set to `regexp', Org will look into two variables,
165 `org-empty-line-terminates-plain-lists' and the more general
166 `org-list-end-regexp', to determine what will end lists. This is
169 When set to `indent', a list will end whenever a line following
170 an item, but not starting one, is less or equally indented than
173 When set to `both', each of the preceding methods is applied to
174 determine lists endings. This is the default method."
175 :group
'org-plain-lists
177 (const :tag
"With a regexp defining ending" regexp
)
178 (const :tag
"With indentation of regular (no bullet) text" indent
)
179 (const :tag
"With both methods" both
)))
181 (defcustom org-empty-line-terminates-plain-lists nil
182 "Non-nil means an empty line ends all plain list levels.
183 This variable only makes sense if `org-list-ending-method' is set
184 to `regexp' or `both'. This is then equivalent to set
185 `org-list-end-regexp' to \"^[ \\t]*$\"."
186 :group
'org-plain-lists
189 (defcustom org-list-end-regexp
"^[ \t]*\n[ \t]*\n"
190 "Regexp matching the end of all plain list levels.
191 It must start with \"^\" and end with \"\\n\". It defaults to 2
192 blank lines. `org-empty-line-terminates-plain-lists' has
194 :group
'org-plain-lists
197 (defcustom org-list-automatic-rules
'((bullet . t
)
201 "Non-nil means apply set of rules when acting on lists.
202 By default, automatic actions are taken when using
203 \\[org-meta-return], \\[org-metaright], \\[org-metaleft],
204 \\[org-shiftmetaright], \\[org-shiftmetaleft],
205 \\[org-ctrl-c-minus], \\[org-toggle-checkbox] or
206 \\[org-insert-todo-heading]. You can disable individually these
207 rules by setting them to nil. Valid rules are:
209 bullet when non-nil, cycling bullet do not allow lists at
210 column 0 to have * as a bullet and descriptions lists
212 checkbox when non-nil, checkbox statistics is updated each time
213 you either insert a new checkbox or toggle a checkbox.
214 It also prevents from inserting a checkbox in a
216 indent when non-nil, indenting or outdenting list top-item
217 with its subtree will move the whole list and
218 outdenting a list whose bullet is * to column 0 will
219 change that bullet to -
220 insert when non-nil, trying to insert an item inside a block
221 will insert it right before the block instead of
223 :group
'org-plain-lists
224 :type
'(alist :tag
"Sets of rules"
227 (const :tag
"Bullet" bullet
)
228 (const :tag
"Checkbox" checkbox
)
229 (const :tag
"Indent" indent
)
230 (const :tag
"Insert" insert
))
232 (boolean :tag
"Activate" :value t
)))
234 (defcustom org-hierarchical-checkbox-statistics t
235 "Non-nil means checkbox statistics counts only the state of direct children.
236 When nil, all boxes below the cookie are counted.
237 This can be set to nil on a per-node basis using a COOKIE_DATA property
238 with the word \"recursive\" in the value."
239 :group
'org-plain-lists
242 (defcustom org-description-max-indent
20
243 "Maximum indentation for the second line of a description list.
244 When the indentation would be larger than this, it will become
245 5 characters instead."
246 :group
'org-plain-lists
249 (defcustom org-list-radio-list-templates
250 '((latex-mode "% BEGIN RECEIVE ORGLST %n
251 % END RECEIVE ORGLST %n
253 #+ORGLST: SEND %n org-list-to-latex
256 (texinfo-mode "@c BEGIN RECEIVE ORGLST %n
257 @c END RECEIVE ORGLST %n
259 #+ORGLST: SEND %n org-list-to-texinfo
262 (html-mode "<!-- BEGIN RECEIVE ORGLST %n -->
263 <!-- END RECEIVE ORGLST %n -->
265 #+ORGLST: SEND %n org-list-to-html
268 "Templates for radio lists in different major modes.
269 All occurrences of %n in a template will be replaced with the name of the
270 list, obtained by prompting the user."
271 :group
'org-plain-lists
273 (list (symbol :tag
"Major mode")
274 (string :tag
"Format"))))
276 ;;; Internal functions
278 (defun org-list-end-re ()
279 "Return the regex corresponding to the end of a list.
280 It depends on `org-empty-line-terminates-plain-lists'."
281 (if org-empty-line-terminates-plain-lists
283 org-list-end-regexp
))
285 (defun org-item-re (&optional general
)
286 "Return the correct regular expression for plain lists.
287 If GENERAL is non-nil, return the general regexp independent of the value
288 of `org-plain-list-ordered-item-terminator'."
290 ((or general
(eq org-plain-list-ordered-item-terminator t
))
291 "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")
292 ((= org-plain-list-ordered-item-terminator ?.
)
293 "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")
294 ((= org-plain-list-ordered-item-terminator ?\
))
295 "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")
296 (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))))
298 (defconst org-item-beginning-re
(concat "^" (org-item-re))
299 "Regexp matching the beginning of a plain list item.")
301 (defun org-list-ending-between (min max
&optional firstp
)
302 "Find the position of a list ending between MIN and MAX, or nil.
303 This function looks for `org-list-end-re' outside a block.
305 If FIRSTP in non-nil, return the point at the beginning of the
306 nearest valid terminator from MIN. Otherwise, return the point at
307 the end of the nearest terminator from MAX."
309 (let* ((start (if firstp min max
))
310 (end (if firstp max min
))
311 (search-fun (if firstp
312 #'org-search-forward-unenclosed
313 #'org-search-backward-unenclosed
))
316 (funcall search-fun
(org-list-end-re) end t
))))
317 ;; Is there a valid list ending somewhere ?
319 ;; we want to be on the first line of the list ender
320 (match-beginning 0)))))
322 (defun org-list-maybe-skip-block (search limit
)
323 "Return non-nil value if point is in a block, skipping it on the way.
324 It looks for the boundary of the block in SEARCH direction,
327 (let ((case-fold-search t
)
328 (boundary (if (eq search
're-search-forward
) 3 5)))
329 (when (save-excursion
330 (and (funcall search
"^[ \t]*#\\+\\(begin\\|end\\)_" limit t
)
331 (= (length (match-string 1)) boundary
)))
332 ;; We're in a block: get out of it
333 (goto-char (match-beginning 0))))))
335 (defun org-list-search-unenclosed-generic (search re bound noerr
)
336 "Search a string outside blocks and protected places.
337 Arguments SEARCH, RE, BOUND and NOERR are similar to those in
338 `search-forward', `search-backward', `re-search-forward' and
339 `re-search-backward'."
341 (let ((origin (point)))
343 ;; 1. No match: return to origin or bound, depending on NOERR.
344 (unless (funcall search re bound noerr
)
345 (throw 'exit
(and (goto-char (if (memq noerr
'(t nil
)) origin bound
))
347 ;; 2. Match not in block or protected: return point. Else
348 ;; skip the block and carry on.
349 (unless (or (get-text-property (match-beginning 0) 'org-protected
)
350 (org-list-maybe-skip-block search bound
))
351 (throw 'exit
(point)))))))
353 (defun org-search-backward-unenclosed (regexp &optional bound noerror
)
354 "Like `re-search-backward' but don't stop inside blocks or protected places.
355 Arguments REGEXP, BOUND and NOERROR are similar to those used in
356 `re-search-backward'."
357 (org-list-search-unenclosed-generic
358 #'re-search-backward regexp
(or bound
(point-min)) noerror
))
360 (defun org-search-forward-unenclosed (regexp &optional bound noerror
)
361 "Like `re-search-forward' but don't stop inside blocks or protected places.
362 Arguments REGEXP, BOUND and NOERROR are similar to those used in
363 `re-search-forward'."
364 (org-list-search-unenclosed-generic
365 #'re-search-forward regexp
(or bound
(point-max)) noerror
))
367 (defun org-list-in-item-p-with-indent (limit)
368 "Is the cursor inside a plain list?
369 Plain lists are considered ending when a non-blank line is less
370 indented than the previous item within LIMIT."
374 ;; do not start searching inside a block...
375 ((org-list-maybe-skip-block #'re-search-backward limit
))
376 ;; ... or at a blank line
377 ((looking-at "^[ \t]*$")
378 (skip-chars-backward " \r\t\n")
379 (beginning-of-line)))
382 (let* ((case-fold-search t
)
383 (ind-ref (org-get-indentation))
384 ;; Ensure there is at least an item above
385 (up-item-p (save-excursion
386 (org-search-backward-unenclosed
387 org-item-beginning-re limit t
))))
393 (throw 'exit
(< (org-get-indentation) ind-ref
)))
394 ((looking-at "^[ \t]*$")
395 (skip-chars-backward " \r\t\n")
397 ((looking-at "^[ \t]*#\\+end_")
398 (re-search-backward "^[ \t]*#\\+begin_"))
400 (setq ind-ref
(min (org-get-indentation) ind-ref
))
401 (forward-line -
1))))))))))
403 (defun org-list-in-item-p-with-regexp (limit)
404 "Is the cursor inside a plain list?
405 Plain lists end when `org-list-end-regexp' is matched, or at a
406 blank line if `org-empty-line-terminates-plain-lists' is true.
408 Argument LIMIT specifies the upper-bound of the search."
410 (let* ((actual-pos (goto-char (point-at-eol)))
411 ;; Moved to eol so current line can be matched by
413 (last-item-start (save-excursion
414 (org-search-backward-unenclosed
415 org-item-beginning-re limit t
)))
416 (list-ender (org-list-ending-between
417 last-item-start actual-pos
)))
418 ;; We are in a list when we are on an item line or when we can
419 ;; find an item before point and there is no valid list ender
420 ;; between it and the point.
421 (and last-item-start
(not list-ender
)))))
423 (defun org-list-top-point-with-regexp (limit)
424 "Return point at the top level item in a list.
425 Argument LIMIT specifies the upper-bound of the search.
427 List ending is determined by regexp. See
428 `org-list-ending-method'. for more information."
430 (let ((pos (point-at-eol)))
431 ;; Is there some list above this one ? If so, go to its ending.
432 ;; Otherwise, go back to the heading above or bob.
433 (goto-char (or (org-list-ending-between limit pos
) limit
))
434 ;; From there, search down our list.
435 (org-search-forward-unenclosed org-item-beginning-re pos t
)
438 (defun org-list-bottom-point-with-regexp (limit)
439 "Return point just before list ending.
440 Argument LIMIT specifies the lower-bound of the search.
442 List ending is determined by regexp. See
443 `org-list-ending-method'. for more information."
445 (let ((pos (org-get-item-beginning)))
446 ;; The list ending is either first point matching
447 ;; `org-list-end-re', point at first white-line before next
449 (or (org-list-ending-between (min pos limit
) limit t
) limit
))))
451 (defun org-list-top-point-with-indent (limit)
452 "Return point at the top level in a list.
453 Argument LIMIT specifies the upper-bound of the search.
455 List ending is determined by indentation of text. See
456 `org-list-ending-method'. for more information."
458 (let ((case-fold-search t
))
459 (let ((item-ref (goto-char (org-get-item-beginning)))
464 (let ((ind (+ (or (get-text-property (point) 'original-indentation
) 0)
465 (org-get-indentation))))
467 ((looking-at "^[ \t]*:END:")
468 (throw 'exit item-ref
))
471 (if (and (org-at-item-p) (< ind ind-ref
))
474 ((looking-at "^[ \t]*$")
475 (skip-chars-backward " \r\t\n")
477 ((looking-at "^[ \t]*#\\+end_")
478 (re-search-backward "^[ \t]*#\\+begin_"))
479 ((not (org-at-item-p))
480 (setq ind-ref
(min ind ind-ref
))
483 (throw 'exit item-ref
))
485 (setq item-ref
(point-at-bol) ind-ref
10000)
486 (forward-line -
1))))))))))
488 (defun org-list-bottom-point-with-indent (limit)
489 "Return point just before list ending or nil if not in a list.
490 Argument LIMIT specifies the lower-bound of the search.
492 List ending is determined by the indentation of text. See
493 `org-list-ending-method' for more information."
495 (let ((ind-ref (progn
496 (goto-char (org-get-item-beginning))
497 (org-get-indentation)))
498 (case-fold-search t
))
499 ;; do not start inside a block
500 (org-list-maybe-skip-block #'re-search-forward limit
)
504 (skip-chars-forward " \t")
505 (let ((ind (+ (or (get-text-property (point) 'original-indentation
) 0)
506 (org-get-indentation))))
508 ((or (>= (point) limit
)
509 (looking-at ":END:"))
511 ;; Ensure bottom is just after a
513 (skip-chars-backward " \r\t\n")
514 (min (point-max) (1+ (point-at-eol))))))
515 ((= (point) (point-at-eol))
516 (skip-chars-forward " \r\t\n")
523 ;; Again, ensure bottom is just after a
525 (skip-chars-backward " \r\t\n")
526 (min (point-max) (1+ (point-at-eol))))))
527 ((looking-at "#\\+begin_")
528 (re-search-forward "[ \t]*#\\+end_")
530 (t (forward-line 1)))))))))
532 (defun org-list-at-regexp-after-bullet-p (regexp)
533 "Is point at a list item with REGEXP after bullet?"
536 (goto-char (match-end 0))
537 ;; Ignore counter if any
538 (when (looking-at "\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?")
539 (goto-char (match-end 0)))
540 (looking-at regexp
))))
542 (defun org-list-get-item-same-level (search-fun pos limit pre-move
)
543 "Return point at the beginning of next item at the same level.
544 Search items using function SEARCH-FUN, from POS to LIMIT. It
545 uses PRE-MOVE before search. Return nil if no item was found."
548 (let* ((start (org-get-item-beginning))
549 (ind (progn (goto-char start
) (org-get-indentation))))
550 ;; We don't want to match the current line.
552 ;; Skip any sublist on the way
553 (while (and (funcall search-fun org-item-beginning-re limit t
)
554 (> (org-get-indentation) ind
)))
555 (when (and (/= (point-at-bol) start
) ; Have we moved ?
556 (= (org-get-indentation) ind
))
559 (defun org-list-separating-blank-lines-number (pos top bottom
)
560 "Return number of blank lines that should separate items in list.
561 POS is the position of point to be considered.
563 TOP and BOTTOM are respectively position of list beginning and
566 Assume point is at item's beginning. If the item is alone, apply
567 some heuristics to guess the result."
569 (let ((insert-blank-p
570 (cdr (assq 'plain-list-item org-blank-before-new-entry
)))
573 ;; Trivial cases where there should be none.
574 ((or (and (not (eq org-list-ending-method
'indent
))
575 org-empty-line-terminates-plain-lists
)
576 (not insert-blank-p
)) 0)
577 ;; When `org-blank-before-new-entry' says so, it is 1.
578 ((eq insert-blank-p t
) 1)
579 ;; plain-list-item is 'auto. Count blank lines separating
580 ;; neighbours items in list.
581 (t (let ((next-p (org-get-next-item (point) bottom
)))
583 ;; Is there a next item?
584 (next-p (goto-char next-p
)
585 (org-back-over-empty-lines))
586 ;; Is there a previous item?
587 ((org-get-previous-item (point) top
)
588 (org-back-over-empty-lines))
589 ;; User inserted blank lines, trust him
590 ((and (> pos
(org-end-of-item-before-blank bottom
))
593 (skip-chars-backward " \t")
594 (setq usr-blank
(org-back-over-empty-lines))) 0))
596 ;; Are there blank lines inside the item ?
598 (org-search-forward-unenclosed
599 "^[ \t]*$" (org-end-of-item-before-blank bottom
) t
)) 1)
600 ;; No parent: no blank line.
603 (defun org-list-insert-item-generic (pos &optional checkbox after-bullet
)
604 "Insert a new list item at POS.
605 If POS is before first character after bullet of the item, the
606 new item will be created before the current one.
608 Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET
609 after the bullet. Cursor will be after this text once the
612 ;; Is point in a special block?
613 (when (org-in-regexps-block-p
614 "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)"
615 '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2)))
616 (if (not (cdr (assq 'insert org-list-automatic-rules
)))
617 ;; Rule in `org-list-automatic-rules' forbids insertion.
618 (error "Cannot insert item inside a block")
619 ;; Else, move before it prior to add a new item.
621 (re-search-backward "^[ \t]*#\\+\\(begin\\|BEGIN\\)_" nil t
)
623 (let* ((true-pos (point))
624 (top (org-list-top-point))
625 (bottom (copy-marker (org-list-bottom-point)))
626 (bullet (and (goto-char (org-get-item-beginning))
627 (org-list-bullet-string (org-get-bullet))))
628 (ind (org-get-indentation))
630 ;; Description item: text starts after colons.
631 (or (org-at-item-description-p)
632 ;; At a checkbox: text starts after it.
633 (org-at-item-checkbox-p)
634 ;; Otherwise, text starts after bullet.
636 (<= true-pos
(match-end 0))))
637 (blank-lines-nb (org-list-separating-blank-lines-number
638 true-pos top bottom
))
641 ;; insert bullet above item in order to avoid bothering
642 ;; with possible blank lines ending last item.
643 (goto-char (org-get-item-beginning))
644 (org-indent-to-column ind
)
645 (insert (concat bullet
(when checkbox
"[ ] ") after-bullet
))
646 ;; Stay between after-bullet and before text.
648 (insert (concat text
(make-string (1+ blank-lines-nb
) ?
\n))))
650 ;; store bottom: exchanging items doesn't change list
651 ;; bottom point but will modify marker anyway
652 (setq bottom
(marker-position bottom
))
653 (let ((col (current-column)))
654 (org-list-exchange-items
655 (org-get-item-beginning) (org-get-next-item (point) bottom
)
657 ;; recompute next-item: last sexp modified list
658 (goto-char (org-get-next-item (point) bottom
))
659 (org-move-to-column col
)))
660 ;; checkbox update might modify bottom point, so use a
662 (setq bottom
(copy-marker bottom
))
663 (when checkbox
(org-update-checkbox-count-maybe))
664 (org-list-repair nil top bottom
))))
667 (before-p (funcall insert-fun nil
) t
)
668 ;; Can't split item: insert bullet at the end of item.
669 ((not (org-get-alist-option org-M-RET-may-split-line
'item
))
670 (funcall insert-fun nil
) t
)
671 ;; else, insert a new bullet along with everything from point
672 ;; down to last non-blank line of item.
674 (delete-horizontal-space)
675 ;; Get pos again in case previous command modified line.
677 (end-before-blank (org-end-of-item-before-blank bottom
))
679 (when (< pos end-before-blank
)
681 (delete-and-extract-region pos end-before-blank
)
682 ;; delete any blank line at and before point.
684 (while (looking-at "^[ \t]*$")
685 (delete-region (point-at-bol) (1+ (point-at-eol)))
686 (beginning-of-line 0))))))
687 (funcall insert-fun after-text
) t
)))))
689 (defvar org-last-indent-begin-marker
(make-marker))
690 (defvar org-last-indent-end-marker
(make-marker))
692 (defun org-list-indent-item-generic (arg no-subtree top bottom
)
693 "Indent a local list item including its children.
694 When number ARG is a negative, item will be outdented, otherwise
697 If a region is active, all items inside will be moved.
699 If NO-SUBTREE is non-nil, only indent the item itself, not its
702 TOP and BOTTOM are respectively position at item beginning and at
705 Return t if successful."
706 (let* ((regionp (org-region-active-p))
707 (rbeg (and regionp
(region-beginning)))
708 (rend (and regionp
(region-end))))
712 (not (org-search-forward-unenclosed org-item-beginning-re rend t
)))
713 (error "No item in region"))
714 ((not (org-at-item-p))
715 (error "Not on an item"))
717 ;; Are we going to move the whole list?
718 (let* ((specialp (and (cdr (assq 'indent org-list-automatic-rules
))
720 (= top
(point-at-bol)))))
721 ;; Determine begin and end points of zone to indent. If moving
722 ;; more than one item, ensure we keep them on subsequent moves.
723 (unless (and (memq last-command
'(org-shiftmetaright org-shiftmetaleft
))
724 (memq this-command
'(org-shiftmetaright org-shiftmetaleft
)))
727 (set-marker org-last-indent-begin-marker rbeg
)
728 (set-marker org-last-indent-end-marker rend
))
729 (set-marker org-last-indent-begin-marker
(point-at-bol))
730 (set-marker org-last-indent-end-marker
734 (no-subtree (org-end-of-item-or-at-child bottom
))
735 (t (org-get-end-of-item bottom
)))))))
736 ;; Get everything ready
737 (let* ((beg (marker-position org-last-indent-begin-marker
))
738 (end (marker-position org-last-indent-end-marker
))
739 (struct (org-list-struct
740 beg end top
(if specialp end bottom
) (< arg
0)))
741 (origins (org-list-struct-origins struct
))
742 (beg-item (assq beg struct
)))
744 ;; Special case: moving top-item with indent rule
746 (let* ((level-skip (org-level-increment))
747 (offset (if (< arg
0) (- level-skip
) level-skip
))
748 (top-ind (nth 1 beg-item
)))
749 (if (< (+ top-ind offset
) 0)
750 (error "Cannot outdent beyond margin")
751 ;; Change bullet if necessary
752 (when (and (= (+ top-ind offset
) 0)
753 (string-match "*" (nth 2 beg-item
)))
754 (setcdr beg-item
(list (nth 1 beg-item
)
755 (org-list-bullet-string "-"))))
757 (let ((anc (car struct
)))
758 (setcdr anc
(list (+ (nth 1 anc
) offset
) "" nil
)))
759 (org-list-struct-fix-struct struct origins
)
760 (org-list-struct-apply-struct struct end
))))
765 (org-list-struct-get-child beg-item struct
))
766 (let ((last-item (save-excursion
768 (skip-chars-backward " \r\t\n")
769 (goto-char (org-get-item-beginning))
770 (org-list-struct-assoc-at-point))))
771 (org-list-struct-get-child last-item struct
))))
772 (error "Cannot outdent an item without its children"))
775 (let* ((shifted-ori (if (< arg
0)
776 (org-list-struct-outdent beg end origins
)
777 (org-list-struct-indent beg end origins struct
))))
778 (org-list-struct-fix-struct struct shifted-ori
)
779 (org-list-struct-apply-struct struct bottom
))))))))))
783 (defun org-in-item-p ()
784 "Is the cursor inside a plain list?
785 This checks `org-list-ending-method'."
786 (unless (let ((outline-regexp org-outline-regexp
)) (org-at-heading-p))
787 (let* ((prev-head (save-excursion (outline-previous-heading)))
790 (let ((case-fold-search t
))
791 (re-search-backward "^[ \t]*:END:" prev-head t
)))
795 ((eq org-list-ending-method
'regexp
)
796 (org-list-in-item-p-with-regexp bound
))
797 ((eq org-list-ending-method
'indent
)
798 (org-list-in-item-p-with-indent bound
))
799 (t (and (org-list-in-item-p-with-regexp bound
)
800 (org-list-in-item-p-with-indent bound
)))))))
802 (defun org-list-first-item-p (top)
803 "Is this item the first item in a plain list?
804 Assume point is at an item.
806 TOP is the position of list's top-item."
809 (let ((ind (org-get-indentation)))
810 (or (not (org-search-backward-unenclosed org-item-beginning-re top t
))
811 (< (org-get-indentation) ind
)))))
813 (defun org-at-item-p ()
814 "Is point in a line starting a hand-formatted item?"
816 (beginning-of-line) (looking-at org-item-beginning-re
)))
818 (defun org-at-item-bullet-p ()
819 "Is point at the bullet of a plain list item?"
821 (not (member (char-after) '(?\ ?
\t)))
822 (< (point) (match-end 0))))
824 (defun org-at-item-timer-p ()
825 "Is point at a line starting a plain list item with a timer?"
826 (org-list-at-regexp-after-bullet-p
827 "\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+::[ \t]+"))
829 (defun org-at-item-description-p ()
830 "Is point at a description list item?"
831 (org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::[ \t]+"))
833 (defun org-at-item-checkbox-p ()
834 "Is point at a line starting a plain-list item with a checklet?"
835 (org-list-at-regexp-after-bullet-p "\\(\\[[- X]\\]\\)[ \t]+"))
837 (defun org-checkbox-blocked-p ()
838 "Is the current checkbox blocked from for being checked now?
839 A checkbox is blocked if all of the following conditions are fulfilled:
841 1. The checkbox is not checked already.
842 2. The current entry has the ORDERED property set.
843 3. There is an unchecked checkbox in this entry before the current line."
847 (unless (org-at-item-checkbox-p) (throw 'exit nil
))
848 (when (equal (match-string 1) "[X]")
849 ;; the box is already checked!
851 (let ((end (point-at-bol)))
852 (condition-case nil
(org-back-to-heading t
)
853 (error (throw 'exit nil
)))
854 (unless (org-entry-get nil
"ORDERED") (throw 'exit nil
))
855 (when (org-search-forward-unenclosed
856 "^[ \t]*[-+*0-9.)]+[ \t]+\\(\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\[[- ]\\]" end t
)
857 (org-current-line)))))))
861 ;; Every interactive navigation function is derived from a
862 ;; non-interactive one, which doesn't move point, assumes point is
863 ;; already in a list and doesn't compute list boundaries.
865 ;; If you plan to use more than one org-list function is some code,
866 ;; you should therefore first check if point is in a list with
867 ;; `org-in-item-p' or `org-at-item-p', then compute list boundaries
868 ;; with `org-list-top-point' and `org-list-bottom-point', and make use
869 ;; of non-interactive forms.
871 (defun org-list-top-point ()
872 "Return point at the top level in a list.
873 Assume point is in a list."
874 (let* ((prev-head (save-excursion (outline-previous-heading)))
877 (let ((case-fold-search t
))
878 (re-search-backward "^[ \t]*:END:" prev-head t
)))
882 ((eq org-list-ending-method
'regexp
)
883 (org-list-top-point-with-regexp bound
))
884 ((eq org-list-ending-method
'indent
)
885 (org-list-top-point-with-indent bound
))
886 (t (let ((top-re (org-list-top-point-with-regexp bound
)))
887 (org-list-top-point-with-indent (or top-re bound
)))))))
889 (defun org-list-bottom-point ()
890 "Return point just before list ending.
891 Assume point is in a list."
892 (let* ((next-head (save-excursion
893 (and (let ((outline-regexp org-outline-regexp
))
894 ;; Use default regexp because folding
895 ;; changes OUTLINE-REGEXP.
896 (outline-next-heading)))))
897 (limit (or (save-excursion
898 (and (re-search-forward "^[ \t]*:END:" next-head t
)
903 ((eq org-list-ending-method
'regexp
)
904 (org-list-bottom-point-with-regexp limit
))
905 ((eq org-list-ending-method
'indent
)
906 (org-list-bottom-point-with-indent limit
))
907 (t (let ((bottom-re (org-list-bottom-point-with-regexp limit
)))
908 (org-list-bottom-point-with-indent (or bottom-re limit
)))))))
910 (defun org-get-item-beginning ()
911 "Return position of current item beginning."
913 ;; possibly match current line
915 (org-search-backward-unenclosed org-item-beginning-re nil t
)
918 (defun org-beginning-of-item ()
919 "Go to the beginning of the current hand-formatted item.
920 If the cursor is not in an item, throw an error."
923 (goto-char (org-get-item-beginning))
924 (error "Not in an item")))
926 (defun org-get-beginning-of-list (top)
927 "Return position of the first item of the current list or sublist.
928 TOP is the position at list beginning."
931 (while (setq prev-p
(org-get-previous-item (point) top
))
935 (defun org-beginning-of-item-list ()
936 "Go to the beginning item of the current list or sublist.
937 Return an error if not in a list."
940 (goto-char (org-get-beginning-of-list (org-list-top-point)))
941 (error "Not in an item")))
943 (defun org-get-end-of-list (bottom)
944 "Return position at the end of the current list or sublist.
945 BOTTOM is the position at list ending."
947 (goto-char (org-get-item-beginning))
948 (let ((ind (org-get-indentation)))
949 (while (and (/= (point) bottom
)
950 (>= (org-get-indentation) ind
))
951 (org-search-forward-unenclosed org-item-beginning-re bottom
'move
))
952 (if (= (point) bottom
) bottom
(point-at-bol)))))
954 (defun org-end-of-item-list ()
955 "Go to the end of the current list or sublist.
956 If the cursor in not in an item, throw an error."
959 (goto-char (org-get-end-of-list (org-list-bottom-point)))
960 (error "Not in an item")))
962 (defun org-get-end-of-item (bottom)
963 "Return position at the end of the current item.
964 BOTTOM is the position at list ending."
965 (or (org-get-next-item (point) bottom
)
966 (org-get-end-of-list bottom
)))
968 (defun org-end-of-item ()
969 "Go to the end of the current hand-formatted item.
970 If the cursor is not in an item, throw an error."
973 (goto-char (org-get-end-of-item (org-list-bottom-point)))
974 (error "Not in an item")))
976 (defun org-end-of-item-or-at-child (bottom)
977 "Move to the end of the item, stops before the first child if any.
978 BOTTOM is the position at list ending."
981 (if (org-search-forward-unenclosed org-item-beginning-re bottom t
)
983 (org-get-end-of-item bottom
))))
985 (defun org-end-of-item-before-blank (bottom)
986 "Return point at end of item, before any blank line.
987 Point returned is at eol.
989 BOTTOM is the position at list ending."
991 (goto-char (org-get-end-of-item bottom
))
992 (skip-chars-backward " \r\t\n")
995 (defun org-get-previous-item (pos limit
)
996 "Return point of the previous item at the same level as POS.
997 Stop searching at LIMIT. Return nil if no item is found."
998 (org-list-get-item-same-level
999 #'org-search-backward-unenclosed pos limit
#'beginning-of-line
))
1001 (defun org-previous-item ()
1002 "Move to the beginning of the previous item.
1003 Item is at the same level in the current plain list. Error if not
1004 in a plain list, or if this is the first item in the list."
1006 (if (not (org-in-item-p))
1007 (error "Not in an item")
1008 (let ((prev-p (org-get-previous-item (point) (org-list-top-point))))
1009 (if prev-p
(goto-char prev-p
) (error "On first item")))))
1011 (defun org-get-next-item (pos limit
)
1012 "Return point of the next item at the same level as POS.
1013 Stop searching at LIMIT. Return nil if no item is found."
1014 (org-list-get-item-same-level
1015 #'org-search-forward-unenclosed pos limit
#'end-of-line
))
1017 (defun org-next-item ()
1018 "Move to the beginning of the next item.
1019 Item is at the same level in the current plain list. Error if not
1020 in a plain list, or if this is the last item in the list."
1022 (if (not (org-in-item-p))
1023 (error "Not in an item")
1024 (let ((next-p (org-get-next-item (point) (org-list-bottom-point))))
1025 (if next-p
(goto-char next-p
) (error "On last item")))))
1029 (defun org-list-exchange-items (beg-A beg-B bottom
)
1030 "Swap item starting at BEG-A with item starting at BEG-B.
1031 Blank lines at the end of items are left in place. Assume BEG-A
1032 is lesser than BEG-B.
1034 BOTTOM is the position at list ending."
1036 (let* ((end-of-item-no-blank
1039 (goto-char (org-end-of-item-before-blank bottom
))))
1040 (end-A-no-blank (funcall end-of-item-no-blank beg-A
))
1041 (end-B-no-blank (funcall end-of-item-no-blank beg-B
))
1042 (body-A (buffer-substring beg-A end-A-no-blank
))
1043 (body-B (buffer-substring beg-B end-B-no-blank
))
1044 (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B
)))
1046 (delete-region beg-A end-B-no-blank
)
1047 (insert (concat body-B between-A-no-blank-and-B body-A
)))))
1049 (defun org-move-item-down ()
1050 "Move the plain list item at point down, i.e. swap with following item.
1051 Subitems (items with larger indentation) are considered part of the item,
1052 so this really moves item trees."
1054 (if (not (org-at-item-p))
1055 (error "Not at an item")
1056 (let* ((pos (point))
1057 (col (current-column))
1058 (bottom (org-list-bottom-point))
1059 (actual-item (goto-char (org-get-item-beginning)))
1060 (next-item (org-get-next-item (point) bottom
)))
1064 (error "Cannot move this item further down"))
1065 (org-list-exchange-items actual-item next-item bottom
)
1066 (org-list-repair nil nil bottom
)
1067 (goto-char (org-get-next-item (point) bottom
))
1068 (org-move-to-column col
)))))
1070 (defun org-move-item-up ()
1071 "Move the plain list item at point up, i.e. swap with previous item.
1072 Subitems (items with larger indentation) are considered part of the item,
1073 so this really moves item trees."
1075 (if (not (org-at-item-p))
1076 (error "Not at an item")
1077 (let* ((pos (point))
1078 (col (current-column))
1079 (top (org-list-top-point))
1080 (bottom (org-list-bottom-point))
1081 (actual-item (goto-char (org-get-item-beginning)))
1082 (prev-item (org-get-previous-item (point) top
)))
1086 (error "Cannot move this item further up"))
1087 (org-list-exchange-items prev-item actual-item bottom
)
1088 (org-list-repair nil top bottom
)
1089 (org-move-to-column col
)))))
1091 (defun org-insert-item (&optional checkbox
)
1092 "Insert a new item at the current level.
1093 If cursor is before first character after bullet of the item, the
1094 new item will be created before the current one.
1096 If CHECKBOX is non-nil, add a checkbox next to the bullet.
1098 Return t when things worked, nil when we are not in an item, or
1100 (unless (or (not (org-in-item-p))
1102 (goto-char (org-get-item-beginning))
1105 (goto-char (org-get-item-beginning))
1106 (org-at-item-timer-p))
1107 ;; Timer list: delegate to `org-timer-item'.
1108 (progn (org-timer-item) t
)
1109 ;; if we're in a description list, ask for the new term.
1110 (let ((desc-text (when (save-excursion
1111 (and (goto-char (org-get-item-beginning))
1112 (org-at-item-description-p)))
1113 (concat (read-string "Term: ") " :: "))))
1114 ;; Don't insert a checkbox if checkbox rule is applied and it
1115 ;; is a description item.
1116 (org-list-insert-item-generic
1117 (point) (and checkbox
1119 (not (cdr (assq 'checkbox org-list-automatic-rules
)))))
1124 ;; The idea behind structures is to avoid moving back and forth in the
1125 ;; buffer on costly operations like indenting or fixing bullets.
1127 ;; It achieves this by taking a snapshot of an interesting part of the
1128 ;; list, in the shape of an alist, using `org-list-struct'.
1130 ;; It then proceeds to changes directly on the alist, with the help of
1131 ;; and `org-list-struct-origins'. When those are done,
1132 ;; `org-list-struct-apply-struct' applies the changes to the buffer.
1134 (defun org-list-struct-assoc-at-point ()
1135 "Return the structure association at point.
1136 It is a cons-cell whose key is point and values are indentation,
1137 bullet string and bullet counter, if any."
1140 (list (point-at-bol)
1141 (org-get-indentation)
1143 (looking-at "^[ \t]*\\([-+*0-9.)]+[ \t]+\\)")
1146 (goto-char (match-end 0))
1147 (and (looking-at "\\[@\\(?:start:\\)?\\([0-9]+\\)\\]")
1148 (match-string 1))))))
1150 (defun org-list-struct (begin end top bottom
&optional outdent
)
1151 "Return the structure containing the list between BEGIN and END.
1152 A structure is an alist where key is point of item and values
1153 are, in that order, indentation, bullet string and value of
1154 counter, if any. A structure contains every list and sublist that
1155 has items between BEGIN and END along with their common ancestor.
1156 If no such ancestor can be found, the function will add a virtual
1157 ancestor at position 0.
1159 TOP and BOTTOM are respectively the position of list beginning
1162 If OUTDENT is non-nil, it will also grab all of the parent list
1163 and the grand-parent. Setting OUTDENT to t is mandatory when next
1164 change is an outdent."
1169 (let* ((ind-min (apply 'min
(mapcar 'cadr struct
)))
1170 (begin (caar struct
))
1171 (end (caar (last struct
)))
1174 ;; Find beginning of most outdented list (min list)
1175 (while (and (org-search-backward-unenclosed
1176 org-item-beginning-re top t
)
1177 (>= (org-get-indentation) ind-min
))
1178 (setq pre-list
(cons (org-list-struct-assoc-at-point)
1180 ;; Now get the parent. If none, add a virtual ancestor
1181 (if (< (org-get-indentation) ind-min
)
1182 (setq pre-list
(cons (org-list-struct-assoc-at-point)
1184 (setq pre-list
(cons (list 0 (org-get-indentation) "" nil
)
1186 ;; Find end of min list
1189 (while (and (org-search-forward-unenclosed
1190 org-item-beginning-re bottom
'move
)
1191 (>= (org-get-indentation) ind-min
))
1192 (setq post-list
(cons (org-list-struct-assoc-at-point)
1194 ;; Is list is malformed? If some items are less
1195 ;; indented that top-item, add them anyhow.
1196 (when (and (= (caar pre-list
) 0) (< (point) bottom
))
1198 (while (org-search-forward-unenclosed
1199 org-item-beginning-re bottom t
)
1200 (setq post-list
(cons (org-list-struct-assoc-at-point)
1202 (append pre-list struct
(reverse post-list
))))))
1203 ;; Here we start: first get the core zone...
1205 (while (org-search-backward-unenclosed org-item-beginning-re begin t
)
1206 (setq struct
(cons (org-list-struct-assoc-at-point) struct
)))
1207 ;; ... then, extend it to make it a structure...
1208 (let ((extended (funcall extend struct
)))
1209 ;; ... twice when OUTDENT is non-nil and struct still can be
1211 (if (and outdent
(> (caar extended
) 0))
1212 (funcall extend extended
)
1215 (defun org-list-struct-origins (struct)
1216 "Return an alist where key is item's position and value parent's.
1217 STRUCT is the list's structure looked up."
1218 (let* ((struct-rev (reverse struct
))
1219 (acc (list (cons (nth 1 (car struct
)) 0)))
1220 (prev-item (lambda (item)
1221 (car (nth 1 (member (assq item struct
) struct-rev
)))))
1224 (let* ((item-pos (car item
))
1226 (prev-ind (caar acc
)))
1230 (let ((current-origin (or (member (assq ind acc
) acc
)
1231 ;; needed if top-point is
1232 ;; not the most outdented
1234 (setq acc current-origin
)
1235 (cons item-pos
(cdar acc
))))
1238 (let ((origin (funcall prev-item item-pos
)))
1239 (setq acc
(cons (cons ind origin
) acc
))
1240 (cons item-pos origin
)))
1241 ;; Current list going on
1242 (t (cons item-pos
(cdar acc
))))))))
1243 (cons '(0 .
0) (mapcar get-origins
(cdr struct
)))))
1245 (defun org-list-struct-get-parent (item struct origins
)
1246 "Return parent association of ITEM in STRUCT or nil.
1247 ORIGINS is the alist of parents. See `org-list-struct-origins'."
1248 (let* ((parent-pos (cdr (assq (car item
) origins
))))
1249 (when (> parent-pos
0) (assq parent-pos struct
))))
1251 (defun org-list-struct-get-child (item struct
)
1252 "Return child association of ITEM in STRUCT or nil."
1253 (let ((ind (nth 1 item
))
1254 (next-item (cadr (member item struct
))))
1255 (when (and next-item
(> (nth 1 next-item
) ind
)) next-item
)))
1257 (defun org-list-struct-fix-bul (struct origins
)
1258 "Verify and correct bullets for every association in STRUCT.
1259 ORIGINS is the alist of parents. See `org-list-struct-origins'.
1261 This function modifies STRUCT."
1263 (init-bul (lambda (item)
1264 (let ((counter (nth 3 item
))
1265 (bullet (org-list-bullet-string (nth 2 item
))))
1267 ((and (string-match "[0-9]+" bullet
) counter
)
1268 (replace-match counter nil nil bullet
))
1269 ((string-match "[0-9]+" bullet
)
1270 (replace-match "1" nil nil bullet
))
1272 (set-bul (lambda (item bullet
)
1273 (setcdr item
(list (nth 1 item
) bullet
(nth 3 item
)))))
1274 (get-bul (lambda (item bullet
)
1275 (let* ((counter (nth 3 item
)))
1276 (if (and counter
(string-match "[0-9]+" bullet
))
1277 (replace-match counter nil nil bullet
)
1280 (lambda (item) struct
1281 (let* ((parent (cdr (assq (car item
) origins
)))
1282 (orig-ref (assq parent acc
)))
1284 ;; Continuing previous list
1285 (let* ((prev-bul (cdr orig-ref
))
1286 (new-bul (funcall get-bul item prev-bul
)))
1287 (setcdr orig-ref
(org-list-inc-bullet-maybe new-bul
))
1288 (funcall set-bul item new-bul
))
1289 ;; A new list is starting
1290 (let ((new-bul (funcall init-bul item
)))
1291 (funcall set-bul item new-bul
)
1292 (setq acc
(cons (cons parent
1293 (org-list-inc-bullet-maybe new-bul
))
1295 (mapc fix-bul
(cdr struct
))))
1297 (defun org-list-struct-fix-ind (struct origins
)
1298 "Verify and correct indentation for every association in STRUCT.
1299 ORIGINS is the alist of parents. See `org-list-struct-origins'.
1301 This function modifies STRUCT."
1302 (let* ((headless (cdr struct
))
1303 (ancestor (car struct
))
1304 (top-ind (+ (nth 1 ancestor
) (length (nth 2 ancestor
))))
1307 (let* ((parent (org-list-struct-get-parent item headless origins
)))
1309 ;; Indent like parent + length of parent's bullet
1310 (setcdr item
(cons (+ (length (nth 2 parent
)) (nth 1 parent
))
1312 ;; If no parent, indent like top-point
1313 (setcdr item
(cons top-ind
(cddr item
))))))))
1314 (mapc new-ind headless
)))
1316 (defun org-list-struct-fix-struct (struct origins
)
1317 "Return STRUCT with correct bullets and indentation.
1318 ORIGINS is the alist of parents. See `org-list-struct-origins'.
1320 Only elements of STRUCT that have changed are returned."
1321 (let ((old (copy-alist struct
)))
1322 (org-list-struct-fix-bul struct origins
)
1323 (org-list-struct-fix-ind struct origins
)
1324 (delq nil
(mapcar (lambda (e) (when (not (equal (pop old
) e
)) e
)) struct
))))
1326 (defun org-list-struct-outdent (start end origins
)
1327 "Outdent items in a structure.
1328 Items are indented when their key is between START, included, and
1331 ORIGINS is the alist of parents. See `org-list-struct-origins'.
1333 STRUCT is the concerned structure."
1336 (let* ((item (car cell
))
1337 (parent (cdr cell
)))
1339 ;; Item not yet in zone: keep association
1340 ((< item start
) cell
)
1341 ;; Item out of zone: follow associations in acc
1343 (let ((convert (assq parent acc
)))
1344 (if convert
(cons item
(cdr convert
)) cell
)))
1345 ;; Item has no parent: error
1347 (error "Cannot outdent top-level items"))
1348 ;; Parent is outdented: keep association
1350 (setq acc
(cons (cons parent item
) acc
)) cell
)
1352 ;; Parent isn't outdented: reparent to grand-parent
1353 (let ((grand-parent (cdr (assq parent origins
))))
1354 (setq acc
(cons (cons parent item
) acc
))
1355 (cons item grand-parent
))))))))
1356 (mapcar out origins
)))
1358 (defun org-list-struct-indent (start end origins struct
)
1359 "Indent items in a structure.
1360 Items are indented when their key is between START, included, and
1363 ORIGINS is the alist of parents. See `org-list-struct-origins'.
1365 STRUCT is the concerned structure. It may be modified if
1366 `org-list-demote-modify-bullet' matches bullets between START and
1369 (orig-rev (reverse origins
))
1371 (lambda (cell parent
)
1372 (car (rassq parent
(cdr (memq cell orig-rev
))))))
1375 (setq acc
(cons cell acc
)) cell
))
1376 (change-bullet-maybe
1378 (let* ((full-item (assq item struct
))
1379 (item-bul (org-trim (nth 2 full-item
)))
1380 (new-bul-p (cdr (assoc item-bul org-list-demote-modify-bullet
))))
1382 ;; new bullet is stored without space to ensure item
1385 (list (nth 1 full-item
)
1387 (nth 3 full-item
)))))))
1390 (let* ((item (car cell
))
1391 (parent (cdr cell
)))
1393 ;; Item not yet in zone: keep association
1394 ((< item start
) cell
)
1396 ;; Item out of zone: follow associations in acc
1397 (let ((convert (assq parent acc
)))
1398 (if convert
(cons item
(cdr convert
)) cell
)))
1400 ;; Item is in zone...
1401 (let ((prev (funcall get-prev-item cell parent
)))
1402 ;; Check if bullet needs to be changed
1403 (funcall change-bullet-maybe item
)
1405 ;; First item indented but not parent: error
1406 ((and (or (not prev
) (= prev
0)) (< parent start
))
1407 (error "Cannot indent the first item of a list"))
1408 ;; First item and parent indented: keep same parent
1409 ((or (not prev
) (= prev
0))
1410 (funcall set-assoc cell
))
1411 ;; Previous item not indented: reparent to it
1413 (funcall set-assoc
(cons item prev
)))
1414 ;; Previous item indented: reparent like it
1416 (funcall set-assoc
(cons item
1417 (cdr (assq prev acc
)))))))))))))
1418 (mapcar ind origins
)))
1420 (defun org-list-struct-apply-struct (struct bottom
)
1421 "Apply modifications to list so it mirrors STRUCT.
1422 BOTTOM is position at list ending.
1424 Initial position is restored after the changes."
1425 (let* ((pos (copy-marker (point)))
1426 (ancestor (caar struct
))
1429 (goto-char (car item
))
1430 (let* ((new-ind (nth 1 item
))
1431 (new-bul (org-list-bullet-string (nth 2 item
)))
1432 (old-ind (org-get-indentation))
1434 (looking-at "[ \t]*\\(\\S-+[ \t]*\\)")
1436 (old-body-ind (+ (length old-bul
) old-ind
))
1437 (new-body-ind (+ (length new-bul
) new-ind
)))
1438 ;; 1. Shift item's body
1439 (unless (= old-body-ind new-body-ind
)
1440 (org-shift-item-indentation
1441 (- new-body-ind old-body-ind
) bottom
))
1442 ;; 2. Replace bullet
1443 (unless (equal new-bul old-bul
)
1445 (looking-at "[ \t]*\\(\\S-+[ \t]*\\)")
1446 (replace-match new-bul nil nil nil
1)))
1447 ;; 3. Indent item to appropriate column
1448 (unless (= new-ind old-ind
)
1449 (delete-region (point-at-bol)
1451 (skip-chars-forward " \t")
1453 (indent-to new-ind
)))))
1454 ;; Remove ancestor if it is left.
1455 (struct-to-apply (if (or (not ancestor
) (= 0 ancestor
))
1458 ;; Apply changes from bottom to top
1459 (mapc modify
(nreverse struct-to-apply
))
1464 (defun org-get-string-indentation (s)
1465 "What indentation has S due to SPACE and TAB at the beginning of the string?"
1466 (let ((n -
1) (i 0) (w tab-width
) c
)
1468 (while (< (setq n
(1+ n
)) (length s
))
1470 (cond ((= c ?\
) (setq i
(1+ i
)))
1471 ((= c ?
\t) (setq i
(* (/ (+ w i
) w
) w
)))
1472 (t (throw 'exit t
)))))
1475 (defun org-shift-item-indentation (delta bottom
)
1476 "Shift the indentation in current item by DELTA.
1477 Sub-items are not moved.
1479 BOTTOM is position at list ending."
1481 (let ((beg (point-at-bol))
1482 (end (org-end-of-item-or-at-child bottom
)))
1483 (beginning-of-line (unless (eolp) 0))
1484 (while (> (point) beg
)
1485 (when (looking-at "[ \t]*\\S-")
1486 ;; this is not an empty line
1487 (let ((i (org-get-indentation)))
1488 (when (and (> i
0) (> (+ i delta
) 0))
1489 (org-indent-line-to (+ i delta
)))))
1490 (beginning-of-line 0)))))
1492 (defun org-outdent-item ()
1493 "Outdent a local list item, but not its children.
1494 If a region is active, all items inside will be moved."
1496 (org-list-indent-item-generic
1497 -
1 t
(org-list-top-point) (org-list-bottom-point)))
1499 (defun org-indent-item ()
1500 "Indent a local list item, but not its children.
1501 If a region is active, all items inside will be moved."
1503 (org-list-indent-item-generic
1504 1 t
(org-list-top-point) (org-list-bottom-point)))
1506 (defun org-outdent-item-tree ()
1507 "Outdent a local list item including its children.
1508 If a region is active, all items inside will be moved."
1510 (org-list-indent-item-generic
1511 -
1 nil
(org-list-top-point) (org-list-bottom-point)))
1513 (defun org-indent-item-tree ()
1514 "Indent a local list item including its children.
1515 If a region is active, all items inside will be moved."
1517 (org-list-indent-item-generic
1518 1 nil
(org-list-top-point) (org-list-bottom-point)))
1520 (defvar org-tab-ind-state
)
1521 (defun org-cycle-item-indentation ()
1522 "Cycle levels of indentation of an empty item.
1523 The first run indent the item, if applicable. Subsequents runs
1524 outdent it at meaningful levels in the list. When done, item is
1525 put back at its original position with its original bullet.
1527 Return t at each successful move."
1528 (let ((org-adapt-indentation nil
)
1529 (ind (org-get-indentation))
1530 (bottom (and (org-at-item-p) (org-list-bottom-point))))
1531 (when (and (or (org-at-item-description-p)
1532 (org-at-item-checkbox-p)
1534 ;; Check that item is really empty
1535 (>= (match-end 0) (save-excursion
1536 (org-end-of-item-or-at-child bottom
)
1537 (skip-chars-backward " \r\t\n")
1539 (setq this-command
'org-cycle-item-indentation
)
1540 (let ((top (org-list-top-point)))
1541 ;; When in the middle of the cycle, try to outdent first. If it
1542 ;; fails, and point is still at initial position, indent. Else,
1543 ;; go back to original position.
1544 (if (eq last-command
'org-cycle-item-indentation
)
1546 ((ignore-errors (org-list-indent-item-generic -
1 t top bottom
)))
1547 ((and (= (org-get-indentation) (car org-tab-ind-state
))
1549 (org-list-indent-item-generic 1 t top bottom
))))
1550 (t (back-to-indentation)
1551 (org-indent-to-column (car org-tab-ind-state
))
1553 (org-list-repair (cdr org-tab-ind-state
))
1555 (setq this-command
'identity
)))
1556 ;; If a cycle is starting, remember indentation and bullet,
1557 ;; then try to indent. If it fails, try to outdent.
1558 (setq org-tab-ind-state
(cons ind
(org-get-bullet)))
1560 ((ignore-errors (org-list-indent-item-generic 1 t top bottom
)))
1561 ((ignore-errors (org-list-indent-item-generic -
1 t top bottom
)))
1562 (t (error "Cannot move item")))))
1567 (defun org-get-bullet ()
1568 "Return the bullet of the item at point.
1569 Assume cursor is at an item."
1572 (and (looking-at "[ \t]*\\(\\S-+\\)") (match-string 1))))
1574 (defun org-list-bullet-string (bullet)
1575 "Return BULLET with the correct number of whitespaces.
1576 It determines the number of whitespaces to append by looking at
1577 `org-list-two-spaces-after-bullet-regexp'."
1579 (string-match "\\S-+\\([ \t]*\\)" bullet
)
1584 ;; Do we need to concat another white space ?
1585 (when (and org-list-two-spaces-after-bullet-regexp
1586 (string-match org-list-two-spaces-after-bullet-regexp bullet
))
1590 (defun org-list-inc-bullet-maybe (bullet)
1591 "Increment BULLET if applicable."
1592 (if (string-match "[0-9]+" bullet
)
1594 (number-to-string (1+ (string-to-number (match-string 0 bullet
))))
1598 (defun org-list-repair (&optional force-bullet top bottom
)
1599 "Make sure all items are correctly indented, with the right bullet.
1600 This function scans the list at point, along with any sublist.
1602 If FORCE-BULLET is a string, ensure all items in list share this
1603 bullet, or a logical successor in the case of an ordered list.
1605 When non-nil, TOP and BOTTOM specify respectively position of
1606 list beginning and list ending.
1608 Item's body is not indented, only shifted with the bullet."
1610 (unless (org-at-item-p) (error "This is not a list"))
1611 (let* ((bottom (or bottom
(org-list-bottom-point)))
1612 (struct (org-list-struct
1613 (point-at-bol) (point-at-eol)
1614 (or top
(org-list-top-point)) bottom
))
1615 (origins (org-list-struct-origins struct
))
1617 (if (stringp force-bullet
)
1618 (let ((begin (nth 1 struct
)))
1619 (setcdr begin
(list (nth 1 begin
)
1620 (org-list-bullet-string force-bullet
)
1623 (cons begin
(org-list-struct-fix-struct struct origins
))))
1624 (setq fixed-struct
(org-list-struct-fix-struct struct origins
)))
1625 (org-list-struct-apply-struct fixed-struct bottom
)))
1627 (defun org-cycle-list-bullet (&optional which
)
1628 "Cycle through the different itemize/enumerate bullets.
1629 This cycle the entire list level through the sequence:
1631 `-' -> `+' -> `*' -> `1.' -> `1)'
1633 If WHICH is a valid string, use that as the new bullet. If WHICH
1634 is an integer, 0 means `-', 1 means `+' etc. If WHICH is
1635 'previous, cycle backwards."
1638 (let* ((top (org-list-top-point))
1640 (goto-char (org-get-beginning-of-list top
))
1643 ((string-match "\\." bullet
) "1.")
1644 ((string-match ")" bullet
) "1)")
1646 (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules
)))
1647 (bullet-list (append '("-" "+" )
1648 ;; *-bullets are not allowed at column 0
1649 (unless (and bullet-rule-p
1650 (looking-at "\\S-")) '("*"))
1651 ;; Description items cannot be numbered
1652 (unless (and bullet-rule-p
1653 (or (eq org-plain-list-ordered-item-terminator ?\
))
1654 (org-at-item-description-p))) '("1."))
1655 (unless (and bullet-rule-p
1656 (or (eq org-plain-list-ordered-item-terminator ?.
)
1657 (org-at-item-description-p))) '("1)"))))
1658 (len (length bullet-list
))
1659 (item-index (- len
(length (member current bullet-list
))))
1660 (get-value (lambda (index) (nth (mod index len
) bullet-list
)))
1662 ((member which bullet-list
) which
)
1663 ((numberp which
) (funcall get-value which
))
1664 ((eq 'previous which
) (funcall get-value
(1- item-index
)))
1665 (t (funcall get-value
(1+ item-index
))))))
1666 (org-list-repair new top
))))
1670 (defun org-toggle-checkbox (&optional toggle-presence
)
1671 "Toggle the checkbox in the current line.
1672 With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. With
1673 double prefix, set checkbox to [-].
1675 When there is an active region, toggle status or presence of the
1676 first checkbox there, and make every item inside have the
1677 same status or presence, respectively.
1679 If the cursor is in a headline, apply this to all checkbox items
1680 in the text below the heading, taking as reference the first item
1681 in subtree, ignoring drawers."
1683 ;; Bounds is a list of type (beg end single-p) where single-p is t
1684 ;; when `org-toggle-checkbox' is applied to a single item. Only
1685 ;; toggles on single items will return errors.
1688 ((org-region-active-p)
1689 (let ((rbeg (region-beginning))
1690 (rend (region-end)))
1693 (if (org-search-forward-unenclosed org-item-beginning-re rend
'move
)
1694 (list (point-at-bol) rend nil
)
1695 (error "No item in region")))))
1697 ;; In this case, reference line is the first item in
1698 ;; subtree outside drawers
1700 (limit (save-excursion (outline-next-heading) (point))))
1703 (org-search-backward-unenclosed ":END:" pos
'move
)
1704 (org-search-forward-unenclosed
1705 org-item-beginning-re limit
'move
)
1706 (list (point) limit nil
))))
1708 (list (point-at-bol) (1+ (point-at-eol)) t
))
1709 (t (error "Not at an item or heading, and no active region"))))
1711 ;; marker is needed because deleting or inserting checkboxes
1712 ;; will change bottom point
1713 (end (copy-marker (nth 1 bounds
)))
1714 (single-p (nth 2 bounds
))
1715 (ref-presence (save-excursion
1717 (org-at-item-checkbox-p)))
1718 (ref-status (equal (match-string 1) "[X]"))
1720 (lambda (ref-pres ref-stat
)
1721 (if (equal toggle-presence
'(4))
1723 ((and ref-pres
(org-at-item-checkbox-p))
1725 ((and (not ref-pres
)
1726 (not (org-at-item-checkbox-p))
1728 (goto-char (match-end 0))
1729 ;; Ignore counter, if any
1730 (when (looking-at "\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?")
1731 (goto-char (match-end 0)))
1732 (let ((desc-p (and (org-at-item-description-p)
1733 (cdr (assq 'checkbox org-list-automatic-rules
)))))
1735 ((and single-p desc-p
)
1736 (error "Cannot add a checkbox in a description list"))
1737 ((not desc-p
) (insert "[ ] "))))))
1738 (let ((blocked (org-checkbox-blocked-p)))
1740 ((and blocked single-p
)
1741 (error "Checkbox blocked because of unchecked box in line %d" blocked
))
1743 ((org-at-item-checkbox-p)
1745 (cond ((equal toggle-presence
'(16)) "[-]")
1751 (while (< (point) end
)
1752 (funcall act-on-item ref-presence ref-status
)
1753 (org-search-forward-unenclosed org-item-beginning-re end
'move
)))
1754 (org-update-checkbox-count-maybe)))
1756 (defun org-reset-checkbox-state-subtree ()
1757 "Reset all checkboxes in an entry subtree."
1761 (org-narrow-to-subtree)
1763 (goto-char (point-min))
1764 (let ((end (point-max)))
1765 (while (< (point) end
)
1766 (when (org-at-item-checkbox-p)
1767 (replace-match "[ ]" t t nil
1))
1768 (beginning-of-line 2))))
1769 (org-update-checkbox-count-maybe)))
1771 (defvar org-checkbox-statistics-hook nil
1772 "Hook that is run whenever Org thinks checkbox statistics should be updated.
1773 This hook runs even if checkbox rule in
1774 `org-list-automatic-rules' does not apply, so it can be used to
1775 implement alternative ways of collecting statistics
1778 (defun org-update-checkbox-count-maybe ()
1779 "Update checkbox statistics unless turned off by user."
1780 (when (cdr (assq 'checkbox org-list-automatic-rules
))
1781 (org-update-checkbox-count))
1782 (run-hooks 'org-checkbox-statistics-hook
))
1784 (defun org-update-checkbox-count (&optional all
)
1785 "Update the checkbox statistics in the current section.
1786 This will find all statistic cookies like [57%] and [6/12] and update them
1787 with the current numbers. With optional prefix argument ALL, do this for
1794 (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21
1795 (beg (condition-case nil
1796 (progn (org-back-to-heading) (point))
1797 (error (point-min))))
1798 (end (copy-marker (save-excursion
1799 (outline-next-heading) (point))))
1800 (re-cookie "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
1801 (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)")
1802 beg-cookie end-cookie is-percent c-on c-off lim new
1803 curr-ind next-ind continue-from startsearch list-beg list-end
1805 (or (not org-hierarchical-checkbox-statistics
)
1806 (string-match "\\<recursive\\>"
1808 (org-entry-get nil
"COOKIE_DATA"))
1811 ;; find each statistics cookie
1812 (while (and (org-search-backward-unenclosed re-cookie beg
'move
)
1813 (not (save-match-data
1814 (and (org-on-heading-p)
1815 (string-match "\\<todo\\>"
1820 (setq beg-cookie
(match-beginning 1)
1821 end-cookie
(match-end 1)
1822 cstat
(+ cstat
(if end-cookie
1 0))
1823 startsearch
(point-at-eol)
1824 continue-from
(match-beginning 0)
1825 is-percent
(match-beginning 2)
1827 ((org-on-heading-p) (outline-next-heading) (point))
1828 ;; Ensure many cookies in the same list won't imply
1829 ;; computing list boundaries as many times.
1831 (unless (and list-beg
(>= (point) list-beg
))
1832 (setq list-beg
(org-list-top-point)
1833 list-end
(copy-marker
1834 (org-list-bottom-point))))
1835 (org-get-end-of-item list-end
))
1840 ;; find first checkbox for this cookie and gather
1841 ;; statistics from all that are at this indentation level
1842 (goto-char startsearch
)
1843 (if (org-search-forward-unenclosed re-box lim t
)
1846 (setq curr-ind
(org-get-indentation))
1847 (setq next-ind curr-ind
)
1848 (while (and (bolp) (org-at-item-p)
1850 (<= curr-ind next-ind
)
1851 (= curr-ind next-ind
)))
1852 (when (org-at-item-checkbox-p)
1853 (if (member (match-string 1) '("[ ]" "[-]"))
1854 (setq c-off
(1+ c-off
))
1855 (setq c-on
(1+ c-on
))))
1857 ;; org-get-next-item goes through list-enders
1858 ;; with proper limit.
1859 (goto-char (or (org-get-next-item (point) lim
) lim
))
1861 (when (org-search-forward-unenclosed
1862 org-item-beginning-re lim t
)
1863 (beginning-of-line)))
1864 (setq next-ind
(org-get-indentation)))))
1865 (goto-char continue-from
)
1868 (setq new
(if is-percent
1869 (format "[%d%%]" (/ (* 100 c-on
)
1870 (max 1 (+ c-on c-off
))))
1871 (format "[%d/%d]" c-on
(+ c-on c-off
))))
1872 (goto-char beg-cookie
)
1874 (delete-region (point) (+ (point) (- end-cookie beg-cookie
))))
1875 ;; update items checkbox if it has one
1876 (when (and (org-at-item-checkbox-p)
1877 (> (+ c-on c-off
) 0))
1878 (setq beg-cookie
(match-beginning 1)
1879 end-cookie
(match-end 1))
1880 (delete-region beg-cookie end-cookie
)
1881 (goto-char beg-cookie
)
1882 (cond ((= c-off
0) (insert "[X]"))
1883 ((= c-on
0) (insert "[ ]"))
1884 (t (insert "[-]")))))
1885 (goto-char continue-from
)))
1886 (unless (and all
(outline-next-heading)) (throw 'exit nil
))))
1887 (when (interactive-p)
1888 (message "Checkbox statistics updated %s (%d places)"
1889 (if all
"in entire file" "in current outline entry") cstat
)))))
1891 (defun org-get-checkbox-statistics-face ()
1892 "Select the face for checkbox statistics.
1893 The face will be `org-done' when all relevant boxes are checked.
1894 Otherwise it will be `org-todo'."
1896 (if (equal (match-string 1) "100%")
1897 'org-checkbox-statistics-done
1898 'org-checkbox-statistics-todo
)
1899 (if (and (> (match-end 2) (match-beginning 2))
1900 (equal (match-string 2) (match-string 3)))
1901 'org-checkbox-statistics-done
1902 'org-checkbox-statistics-todo
)))
1906 (defun org-apply-on-list (function init-value
&rest args
)
1907 "Call FUNCTION on each item of the list at point.
1908 FUNCTION must be called with at least one argument: INIT-VALUE,
1909 that will contain the value returned by the function at the
1910 previous item, plus ARGS extra arguments.
1912 As an example, (org-apply-on-list (lambda (result) (1+ result)) 0)
1913 will return the number of items in the current list.
1915 Sublists of the list are skipped. Cursor is always at the
1916 beginning of the item."
1917 (let* ((pos (copy-marker (point)))
1918 (end (copy-marker (org-list-bottom-point)))
1919 (next-p (copy-marker (org-get-beginning-of-list (org-list-top-point))))
1921 (while (< next-p end
)
1923 (set-marker next-p
(or (org-get-next-item (point) end
) end
))
1924 (setq value
(apply function value args
)))
1928 (defun org-sort-list (&optional with-case sorting-type getkey-func compare-func
)
1929 "Sort plain list items.
1930 The cursor may be at any item of the list that should be sorted.
1931 Sublists are not sorted. Checkboxes, if any, are ignored.
1933 Sorting can be alphabetically, numerically, by date/time as given by
1934 a time stamp, by a property or by priority.
1936 Comparing entries ignores case by default. However, with an
1937 optional argument WITH-CASE, the sorting considers case as well.
1939 The command prompts for the sorting type unless it has been given
1940 to the function through the SORTING-TYPE argument, which needs to
1941 be a character, \(?n ?N ?a ?A ?t ?T ?f ?F). Here is the precise
1942 meaning of each character:
1944 n Numerically, by converting the beginning of the item to a number.
1945 a Alphabetically. Only the first line of item is checked.
1946 t By date/time, either the first active time stamp in the entry, if
1947 any, or by the first inactive one. In a timer list, sort the timers.
1949 Capital letters will reverse the sort order.
1951 If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a
1952 function to be called with point at the beginning of the record.
1953 It must return either a string or a number that should serve as
1954 the sorting key for that record. It will then use COMPARE-FUNC to
1957 (let* ((case-func (if with-case
'identity
'downcase
))
1958 (top (org-list-top-point))
1959 (bottom (org-list-bottom-point))
1960 (start (org-get-beginning-of-list top
))
1961 (end (org-get-end-of-list bottom
))
1965 "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:")
1966 (read-char-exclusive)))
1967 (getkey-func (and (= (downcase sorting-type
) ?f
)
1968 (org-icompleting-read "Sort using function: "
1969 obarray
'fboundp t nil nil
)
1970 (intern getkey-func
))))
1971 (message "Sorting items...")
1973 (narrow-to-region start end
)
1974 (goto-char (point-min))
1975 (let* ((dcst (downcase sorting-type
))
1976 (case-fold-search nil
)
1977 (now (current-time))
1979 ((= dcst ?a
) 'string
<)
1980 ((= dcst ?f
) compare-func
)
1983 (begin-record (lambda ()
1984 (skip-chars-forward " \r\t\n")
1985 (beginning-of-line)))
1986 (end-record (lambda ()
1987 (goto-char (org-end-of-item-before-blank end
))))
1990 (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+")
1993 (string-to-number (buffer-substring (match-end 0)
1996 (buffer-substring (match-end 0) (point-at-eol)))
1999 ;; If it is a timer list, convert timer to seconds
2000 ((org-at-item-timer-p)
2001 (org-timer-hms-to-secs (match-string 1)))
2002 ((or (org-search-forward-unenclosed org-ts-regexp
2004 (org-search-forward-unenclosed org-ts-regexp-both
2006 (org-time-string-to-seconds (match-string 0)))
2007 (t (org-float-time now
))))
2010 (let ((value (funcall getkey-func
)))
2012 (funcall case-func value
)
2014 (error "Invalid key function `%s'" getkey-func
)))
2015 (t (error "Invalid sorting type `%c'" sorting-type
)))))))
2016 (sort-subr (/= dcst sorting-type
)
2022 (org-list-repair nil top bottom
)
2023 (run-hooks 'org-after-sorting-entries-or-items-hook
)
2024 (message "Sorting items...done")))))
2026 ;;; Send and receive lists
2028 (defun org-list-parse-list (&optional delete
)
2029 "Parse the list at point and maybe DELETE it.
2030 Return a list containing first level items as strings and
2031 sublevels as a list of strings."
2032 (let* ((start (goto-char (org-list-top-point)))
2033 (end (org-list-bottom-point))
2034 output itemsep ltype
)
2035 (while (org-search-forward-unenclosed org-item-beginning-re end t
)
2038 (setq ltype
(cond ((org-looking-at-p "^[ \t]*[0-9]") 'ordered
)
2039 ((org-at-item-description-p) 'descriptive
)
2041 (let* ((indent1 (org-get-indentation))
2042 (nextitem (or (org-get-next-item (point) end
) end
))
2043 (item (org-trim (buffer-substring (point)
2044 (org-end-of-item-or-at-child end
))))
2045 (nextindent (if (= (point) end
) 0 (org-get-indentation)))
2046 (item (if (string-match
2047 "^\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\[\\([xX ]\\)\\]"
2049 (replace-match (if (equal (match-string 1 item
) " ")
2055 (when (> nextindent indent1
)
2057 (narrow-to-region (point) nextitem
)
2058 (push (org-list-parse-list) output
)))))
2060 (delete-region start end
)
2062 (when (and (not (eq org-list-ending-method
'indent
))
2063 (looking-at (org-list-end-re)))
2064 (replace-match "\n"))))
2065 (setq output
(nreverse output
))
2066 (push ltype output
)))
2068 (defun org-list-make-subtree ()
2069 "Convert the plain list at point into a subtree."
2071 (if (not (org-in-item-p))
2072 (error "Not in a list")
2073 (let ((list (org-list-parse-list t
)) nstars
)
2076 (org-back-to-heading))
2077 (progn (looking-at org-complex-heading-regexp
)
2078 (setq nstars
(length (match-string 1))))
2080 (org-list-make-subtrees list
(1+ nstars
)))))
2082 (defun org-list-make-subtrees (list level
)
2083 "Convert LIST into subtrees starting at LEVEL."
2084 (if (symbolp (car list
))
2085 (org-list-make-subtrees (cdr list
) level
)
2086 (mapcar (lambda (item)
2088 (insert (make-string
2089 (if org-odd-levels-only
2090 (1- (* 2 level
)) level
) ?
*) " " item
"\n")
2091 (org-list-make-subtrees item
(1+ level
))))
2094 (defun org-list-insert-radio-list ()
2095 "Insert a radio list template appropriate for this major mode."
2097 (let* ((e (assq major-mode org-list-radio-list-templates
))
2100 (unless e
(error "No radio list setup defined for %s" major-mode
))
2101 (setq name
(read-string "List name: "))
2102 (while (string-match "%n" txt
)
2103 (setq txt
(replace-match name t t txt
)))
2104 (or (bolp) (insert "\n"))
2109 (defun org-list-send-list (&optional maybe
)
2110 "Send a transformed version of this list to the receiver position.
2111 With argument MAYBE, fail quietly if no transformation is defined for
2115 (unless (org-at-item-p) (error "Not at a list item"))
2117 (re-search-backward "#\\+ORGLST" nil t
)
2118 (unless (looking-at "[ \t]*#\\+ORGLST[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?")
2121 (error "Don't know how to transform this list"))))
2122 (let* ((name (match-string 1))
2123 (transform (intern (match-string 2)))
2127 "\\(\\\\end{comment}\\|@end ignore\\|-->\\)" nil t
)
2128 (match-beginning 0)))
2131 (re-search-backward "#\\+ORGLST" nil t
)
2132 (re-search-forward org-item-beginning-re bottom-point t
)
2133 (match-beginning 0)))
2134 (list (save-restriction
2135 (narrow-to-region top-point bottom-point
)
2136 (org-list-parse-list)))
2138 (unless (fboundp transform
)
2139 (error "No such transformation function %s" transform
))
2140 (let ((txt (funcall transform list
)))
2141 ;; Find the insertion place
2143 (goto-char (point-min))
2144 (unless (re-search-forward
2145 (concat "BEGIN RECEIVE ORGLST +"
2147 "\\([ \t]\\|$\\)") nil t
)
2148 (error "Don't know where to insert translated list"))
2149 (goto-char (match-beginning 0))
2150 (beginning-of-line 2)
2152 (unless (re-search-forward (concat "END RECEIVE ORGLST +" name
) nil t
)
2153 (error "Cannot find end of insertion region"))
2154 (delete-region beg
(point-at-bol))
2157 (message "List converted and installed at receiver location"))))
2159 (defun org-list-to-generic (list params
)
2160 "Convert a LIST parsed through `org-list-parse-list' to other formats.
2161 Valid parameters PARAMS are
2163 :ustart String to start an unordered list
2164 :uend String to end an unordered list
2166 :ostart String to start an ordered list
2167 :oend String to end an ordered list
2169 :dstart String to start a descriptive list
2170 :dend String to end a descriptive list
2171 :dtstart String to start a descriptive term
2172 :dtend String to end a descriptive term
2173 :ddstart String to start a description
2174 :ddend String to end a description
2176 :splice When set to t, return only list body lines, don't wrap
2177 them into :[u/o]start and :[u/o]end. Default is nil.
2179 :istart String to start a list item
2180 :iend String to end a list item
2181 :isep String to separate items
2182 :lsep String to separate sublists
2184 :cboff String to insert for an unchecked checkbox
2185 :cbon String to insert for a checked checkbox"
2187 (let* ((p params
) sublist
2188 (splicep (plist-get p
:splice
))
2189 (ostart (plist-get p
:ostart
))
2190 (oend (plist-get p
:oend
))
2191 (ustart (plist-get p
:ustart
))
2192 (uend (plist-get p
:uend
))
2193 (dstart (plist-get p
:dstart
))
2194 (dend (plist-get p
:dend
))
2195 (dtstart (plist-get p
:dtstart
))
2196 (dtend (plist-get p
:dtend
))
2197 (ddstart (plist-get p
:ddstart
))
2198 (ddend (plist-get p
:ddend
))
2199 (istart (plist-get p
:istart
))
2200 (iend (plist-get p
:iend
))
2201 (isep (plist-get p
:isep
))
2202 (lsep (plist-get p
:lsep
))
2203 (cbon (plist-get p
:cbon
))
2204 (cboff (plist-get p
:cboff
)))
2206 (cond ((eq (car list
) 'ordered
)
2207 (concat ostart
"\n%s" oend
"\n"))
2208 ((eq (car list
) 'unordered
)
2209 (concat ustart
"\n%s" uend
"\n"))
2210 ((eq (car list
) 'descriptive
)
2211 (concat dstart
"\n%s" dend
"\n"))))
2212 rtn term defstart defend
)
2213 (while (setq sublist
(pop list
))
2214 (cond ((symbolp sublist
) nil
)
2216 (when (string-match "^\\(.*\\)[ \t]+::" sublist
)
2217 (setq term
(org-trim (format (concat dtstart
"%s" dtend
)
2218 (match-string 1 sublist
))))
2219 (setq sublist
(concat ddstart
2220 (org-trim (substring sublist
2223 (if (string-match "\\[CBON\\]" sublist
)
2224 (setq sublist
(replace-match cbon t t sublist
)))
2225 (if (string-match "\\[CBOFF\\]" sublist
)
2226 (setq sublist
(replace-match cboff t t sublist
)))
2227 (if (string-match "\\[-\\]" sublist
)
2228 (setq sublist
(replace-match "$\\boxminus$" t t sublist
)))
2229 (setq rtn
(concat rtn istart term sublist iend isep
)))
2230 (t (setq rtn
(concat rtn
;; previous list
2231 lsep
;; list separator
2232 (org-list-to-generic sublist p
)
2233 lsep
;; list separator
2235 (format wrapper rtn
))))
2237 (defun org-list-to-latex (list &optional params
)
2238 "Convert LIST into a LaTeX list.
2239 LIST is as returned by `org-list-parse-list'. PARAMS is a property list
2240 with overruling parameters for `org-list-to-generic'."
2241 (org-list-to-generic
2244 '(:splicep nil
:ostart
"\\begin{enumerate}" :oend
"\\end{enumerate}"
2245 :ustart
"\\begin{itemize}" :uend
"\\end{itemize}"
2246 :dstart
"\\begin{description}" :dend
"\\end{description}"
2247 :dtstart
"[" :dtend
"]"
2248 :ddstart
"" :ddend
""
2249 :istart
"\\item " :iend
""
2250 :isep
"\n" :lsep
"\n"
2251 :cbon
"\\texttt{[X]}" :cboff
"\\texttt{[ ]}")
2254 (defun org-list-to-html (list &optional params
)
2255 "Convert LIST into a HTML list.
2256 LIST is as returned by `org-list-parse-list'. PARAMS is a property list
2257 with overruling parameters for `org-list-to-generic'."
2258 (org-list-to-generic
2261 '(:splicep nil
:ostart
"<ol>" :oend
"</ol>"
2262 :ustart
"<ul>" :uend
"</ul>"
2263 :dstart
"<dl>" :dend
"</dl>"
2264 :dtstart
"<dt>" :dtend
"</dt>"
2265 :ddstart
"<dd>" :ddend
"</dd>"
2266 :istart
"<li>" :iend
"</li>"
2267 :isep
"\n" :lsep
"\n"
2268 :cbon
"<code>[X]</code>" :cboff
"<code>[ ]</code>")
2271 (defun org-list-to-texinfo (list &optional params
)
2272 "Convert LIST into a Texinfo list.
2273 LIST is as returned by `org-list-parse-list'. PARAMS is a property list
2274 with overruling parameters for `org-list-to-generic'."
2275 (org-list-to-generic
2278 '(:splicep nil
:ostart
"@itemize @minus" :oend
"@end itemize"
2279 :ustart
"@enumerate" :uend
"@end enumerate"
2280 :dstart
"@table" :dend
"@end table"
2281 :dtstart
"@item " :dtend
"\n"
2282 :ddstart
"" :ddend
""
2283 :istart
"@item\n" :iend
""
2284 :isep
"\n" :lsep
"\n"
2285 :cbon
"@code{[X]}" :cboff
"@code{[ ]}")
2290 ;;; org-list.el ends here
HCoop / bpt / emacs.git / blob