Release 7.4
[org-mode/org-tableheadings.git] / lisp / org-list.el
blobbc8e7bddb5b043fd5972c2e5a7a9e3cda596a149
1 ;;; org-list.el --- Plain lists for Org-mode
2 ;;
3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
4 ;; Free Software Foundation, Inc.
5 ;;
6 ;; Author: Carsten Dominik <carsten at orgmode dot org>
7 ;; Bastien Guerry <bzg AT altern DOT org>
8 ;; Keywords: outlines, hypermedia, calendar, wp
9 ;; Homepage: http://orgmode.org
10 ;; Version: 7.4
12 ;; This file is part of GNU Emacs.
14 ;; GNU Emacs is free software: you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 ;;; Commentary:
30 ;; This file contains the code dealing with plain lists in Org-mode.
32 ;;; Code:
34 (eval-when-compile
35 (require 'cl))
36 (require 'org-macs)
37 (require 'org-compat)
39 (defvar org-blank-before-new-entry)
40 (defvar org-M-RET-may-split-line)
41 (defvar org-complex-heading-regexp)
42 (defvar org-odd-levels-only)
43 (defvar org-outline-regexp)
44 (defvar org-ts-regexp)
45 (defvar org-ts-regexp-both)
47 (declare-function org-invisible-p "org" ())
48 (declare-function org-on-heading-p "org" (&optional invisible-ok))
49 (declare-function outline-next-heading "outline" ())
50 (declare-function org-back-to-heading "org" (&optional invisible-ok))
51 (declare-function org-back-over-empty-lines "org" ())
52 (declare-function org-trim "org" (s))
53 (declare-function org-get-indentation "org" (&optional line))
54 (declare-function org-timer-item "org-timer" (&optional arg))
55 (declare-function org-timer-hms-to-secs "org-timer" (hms))
56 (declare-function org-combine-plists "org" (&rest plists))
57 (declare-function org-entry-get "org"
58 (pom property &optional inherit literal-nil))
59 (declare-function org-narrow-to-subtree "org" ())
60 (declare-function org-show-subtree "org" ())
61 (declare-function org-in-regexps-block-p "org"
62 (start-re end-re &optional bound))
63 (declare-function org-level-increment "org" ())
64 (declare-function org-at-heading-p "org" (&optional ignored))
65 (declare-function outline-previous-heading "outline" ())
66 (declare-function org-icompleting-read "org" (&rest args))
67 (declare-function org-time-string-to-seconds "org" (s))
69 (defgroup org-plain-lists nil
70 "Options concerning plain lists in Org-mode."
71 :tag "Org Plain lists"
72 :group 'org-structure)
74 (defcustom org-cycle-include-plain-lists t
75 "When t, make TAB cycle visibility on plain list items.
76 Cycling plain lists works only when the cursor is on a plain list
77 item. When the cursor is on an outline heading, plain lists are
78 treated as text. This is the most stable way of handling this,
79 which is why it is the default.
81 When this is the symbol `integrate', then during cycling, plain
82 list items will *temporarily* be interpreted as outline headlines
83 with a level given by 1000+i where i is the indentation of the
84 bullet. This setting can lead to strange effects when switching
85 visibility to `children', because the first \"child\" in a
86 subtree decides what children should be listed. If that first
87 \"child\" is a plain list item with an implied large level
88 number, all true children and grand children of the outline
89 heading will be exposed in a children' view."
90 :group 'org-plain-lists
91 :type '(choice
92 (const :tag "Never" nil)
93 (const :tag "With cursor in plain list (recommended)" t)
94 (const :tag "As children of outline headings" integrate)))
96 (defcustom org-list-demote-modify-bullet nil
97 "Default bullet type installed when demoting an item.
98 This is an association list, for each bullet type, this alist will point
99 to the bullet that should be used when this item is demoted.
100 For example,
102 (setq org-list-demote-modify-bullet
103 '((\"+\" . \"-\") (\"-\" . \"+\") (\"*\" . \"+\")))
105 will make
107 + Movies
108 + Silence of the Lambs
109 + My Cousin Vinny
110 + Books
111 + The Hunt for Red October
112 + The Road to Omaha
114 into
116 + Movies
117 - Silence of the Lambs
118 - My Cousin Vinny
119 + Books
120 - The Hunt for Red October
121 - The Road to Omaha"
122 :group 'org-plain-lists
123 :type '(repeat
124 (cons
125 (choice :tag "If the current bullet is "
126 (const "-")
127 (const "+")
128 (const "*")
129 (const "1.")
130 (const "1)"))
131 (choice :tag "demotion will change it to"
132 (const "-")
133 (const "+")
134 (const "*")
135 (const "1.")
136 (const "1)")))))
138 (defcustom org-plain-list-ordered-item-terminator t
139 "The character that makes a line with leading number an ordered list item.
140 Valid values are ?. and ?\). To get both terminators, use t. While
141 ?. may look nicer, it creates the danger that a line with leading
142 number may be incorrectly interpreted as an item. ?\) therefore is
143 the safe choice."
144 :group 'org-plain-lists
145 :type '(choice (const :tag "dot like in \"2.\"" ?.)
146 (const :tag "paren like in \"2)\"" ?\))
147 (const :tab "both" t)))
149 (defcustom org-list-two-spaces-after-bullet-regexp nil
150 "A regular expression matching bullets that should have 2 spaces after them.
151 When nil, no bullet will have two spaces after them.
152 When a string, it will be used as a regular expression. When the
153 bullet type of a list is changed, the new bullet type will be
154 matched against this regexp. If it matches, there will be two
155 spaces instead of one after the bullet in each item of the list."
156 :group 'org-plain-lists
157 :type '(choice
158 (const :tag "never" nil)
159 (regexp)))
161 (defcustom org-list-ending-method 'both
162 "Determine where plain lists should end.
163 Valid values are: `regexp', `indent' or `both'.
165 When set to `regexp', Org will look into two variables,
166 `org-empty-line-terminates-plain-lists' and the more general
167 `org-list-end-regexp', to determine what will end lists. This is
168 the fastest method.
170 When set to `indent', a list will end whenever a line following
171 an item, but not starting one, is less or equally indented than
174 When set to `both', each of the preceding methods is applied to
175 determine lists endings. This is the default method."
176 :group 'org-plain-lists
177 :type '(choice
178 (const :tag "With a regexp defining ending" regexp)
179 (const :tag "With indentation of regular (no bullet) text" indent)
180 (const :tag "With both methods" both)))
182 (defcustom org-empty-line-terminates-plain-lists nil
183 "Non-nil means an empty line ends all plain list levels.
184 This variable only makes sense if `org-list-ending-method' is set
185 to `regexp' or `both'. This is then equivalent to set
186 `org-list-end-regexp' to \"^[ \\t]*$\"."
187 :group 'org-plain-lists
188 :type 'boolean)
190 (defcustom org-list-end-regexp "^[ \t]*\n[ \t]*\n"
191 "Regexp matching the end of all plain list levels.
192 It must start with \"^\" and end with \"\\n\". It defaults to 2
193 blank lines. `org-empty-line-terminates-plain-lists' has
194 precedence over it."
195 :group 'org-plain-lists
196 :type 'string)
198 (defcustom org-list-automatic-rules '((bullet . t)
199 (checkbox . t)
200 (indent . t)
201 (insert . t))
202 "Non-nil means apply set of rules when acting on lists.
203 By default, automatic actions are taken when using
204 \\[org-meta-return], \\[org-metaright], \\[org-metaleft],
205 \\[org-shiftmetaright], \\[org-shiftmetaleft],
206 \\[org-ctrl-c-minus], \\[org-toggle-checkbox] or
207 \\[org-insert-todo-heading]. You can disable individually these
208 rules by setting them to nil. Valid rules are:
210 bullet when non-nil, cycling bullet do not allow lists at
211 column 0 to have * as a bullet and descriptions lists
212 to be numbered.
213 checkbox when non-nil, checkbox statistics is updated each time
214 you either insert a new checkbox or toggle a checkbox.
215 It also prevents from inserting a checkbox in a
216 description item.
217 indent when non-nil, indenting or outdenting list top-item
218 with its subtree will move the whole list and
219 outdenting a list whose bullet is * to column 0 will
220 change that bullet to -
221 insert when non-nil, trying to insert an item inside a block
222 will insert it right before the block instead of
223 throwing an error."
224 :group 'org-plain-lists
225 :type '(alist :tag "Sets of rules"
226 :key-type
227 (choice
228 (const :tag "Bullet" bullet)
229 (const :tag "Checkbox" checkbox)
230 (const :tag "Indent" indent)
231 (const :tag "Insert" insert))
232 :value-type
233 (boolean :tag "Activate" :value t)))
235 (defcustom org-hierarchical-checkbox-statistics t
236 "Non-nil means checkbox statistics counts only the state of direct children.
237 When nil, all boxes below the cookie are counted.
238 This can be set to nil on a per-node basis using a COOKIE_DATA property
239 with the word \"recursive\" in the value."
240 :group 'org-plain-lists
241 :type 'boolean)
243 (defcustom org-description-max-indent 20
244 "Maximum indentation for the second line of a description list.
245 When the indentation would be larger than this, it will become
246 5 characters instead."
247 :group 'org-plain-lists
248 :type 'integer)
250 (defcustom org-list-radio-list-templates
251 '((latex-mode "% BEGIN RECEIVE ORGLST %n
252 % END RECEIVE ORGLST %n
253 \\begin{comment}
254 #+ORGLST: SEND %n org-list-to-latex
256 \\end{comment}\n")
257 (texinfo-mode "@c BEGIN RECEIVE ORGLST %n
258 @c END RECEIVE ORGLST %n
259 @ignore
260 #+ORGLST: SEND %n org-list-to-texinfo
262 @end ignore\n")
263 (html-mode "<!-- BEGIN RECEIVE ORGLST %n -->
264 <!-- END RECEIVE ORGLST %n -->
265 <!--
266 #+ORGLST: SEND %n org-list-to-html
268 -->\n"))
269 "Templates for radio lists in different major modes.
270 All occurrences of %n in a template will be replaced with the name of the
271 list, obtained by prompting the user."
272 :group 'org-plain-lists
273 :type '(repeat
274 (list (symbol :tag "Major mode")
275 (string :tag "Format"))))
277 ;;; Internal functions
279 (defun org-list-end-re ()
280 "Return the regex corresponding to the end of a list.
281 It depends on `org-empty-line-terminates-plain-lists'."
282 (if org-empty-line-terminates-plain-lists
283 "^[ \t]*\n"
284 org-list-end-regexp))
286 (defun org-item-re (&optional general)
287 "Return the correct regular expression for plain lists.
288 If GENERAL is non-nil, return the general regexp independent of the value
289 of `org-plain-list-ordered-item-terminator'."
290 (cond
291 ((or general (eq org-plain-list-ordered-item-terminator t))
292 "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")
293 ((= org-plain-list-ordered-item-terminator ?.)
294 "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")
295 ((= org-plain-list-ordered-item-terminator ?\))
296 "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")
297 (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))))
299 (defconst org-item-beginning-re (concat "^" (org-item-re))
300 "Regexp matching the beginning of a plain list item.")
302 (defun org-list-ending-between (min max &optional firstp)
303 "Find the position of a list ending between MIN and MAX, or nil.
304 This function looks for `org-list-end-re' outside a block.
306 If FIRSTP in non-nil, return the point at the beginning of the
307 nearest valid terminator from MIN. Otherwise, return the point at
308 the end of the nearest terminator from MAX."
309 (save-excursion
310 (let* ((start (if firstp min max))
311 (end (if firstp max min))
312 (search-fun (if firstp
313 #'org-search-forward-unenclosed
314 #'org-search-backward-unenclosed))
315 (list-end-p (progn
316 (goto-char start)
317 (funcall search-fun (org-list-end-re) end t))))
318 ;; Is there a valid list ending somewhere ?
319 (and list-end-p
320 ;; we want to be on the first line of the list ender
321 (match-beginning 0)))))
323 (defun org-list-maybe-skip-block (search limit)
324 "Return non-nil value if point is in a block, skipping it on the way.
325 It looks for the boundary of the block in SEARCH direction,
326 stopping at LIMIT."
327 (save-match-data
328 (let ((case-fold-search t)
329 (boundary (if (eq search 're-search-forward) 3 5)))
330 (when (save-excursion
331 (and (funcall search "^[ \t]*#\\+\\(begin\\|end\\)_" limit t)
332 (= (length (match-string 1)) boundary)))
333 ;; We're in a block: get out of it
334 (goto-char (match-beginning 0))))))
336 (defun org-list-search-unenclosed-generic (search re bound noerr)
337 "Search a string outside blocks and protected places.
338 Arguments SEARCH, RE, BOUND and NOERR are similar to those in
339 `search-forward', `search-backward', `re-search-forward' and
340 `re-search-backward'."
341 (catch 'exit
342 (let ((origin (point)))
343 (while t
344 ;; 1. No match: return to origin or bound, depending on NOERR.
345 (unless (funcall search re bound noerr)
346 (throw 'exit (and (goto-char (if (memq noerr '(t nil)) origin bound))
347 nil)))
348 ;; 2. Match not in block or protected: return point. Else
349 ;; skip the block and carry on.
350 (unless (or (get-text-property (match-beginning 0) 'org-protected)
351 (org-list-maybe-skip-block search bound))
352 (throw 'exit (point)))))))
354 (defun org-search-backward-unenclosed (regexp &optional bound noerror)
355 "Like `re-search-backward' but don't stop inside blocks or protected places.
356 Arguments REGEXP, BOUND and NOERROR are similar to those used in
357 `re-search-backward'."
358 (org-list-search-unenclosed-generic
359 #'re-search-backward regexp (or bound (point-min)) noerror))
361 (defun org-search-forward-unenclosed (regexp &optional bound noerror)
362 "Like `re-search-forward' but don't stop inside blocks or protected places.
363 Arguments REGEXP, BOUND and NOERROR are similar to those used in
364 `re-search-forward'."
365 (org-list-search-unenclosed-generic
366 #'re-search-forward regexp (or bound (point-max)) noerror))
368 (defun org-list-in-item-p-with-indent (limit)
369 "Is the cursor inside a plain list?
370 Plain lists are considered ending when a non-blank line is less
371 indented than the previous item within LIMIT."
372 (save-excursion
373 (beginning-of-line)
374 (cond
375 ;; do not start searching inside a block...
376 ((org-list-maybe-skip-block #'re-search-backward limit))
377 ;; ... or at a blank line
378 ((looking-at "^[ \t]*$")
379 (skip-chars-backward " \r\t\n")
380 (beginning-of-line)))
381 (beginning-of-line)
382 (or (org-at-item-p)
383 (let* ((case-fold-search t)
384 (ind-ref (org-get-indentation))
385 ;; Ensure there is at least an item above
386 (up-item-p (save-excursion
387 (org-search-backward-unenclosed
388 org-item-beginning-re limit t))))
389 (and up-item-p
390 (catch 'exit
391 (while t
392 (cond
393 ((org-at-item-p)
394 (throw 'exit (< (org-get-indentation) ind-ref)))
395 ((looking-at "^[ \t]*$")
396 (skip-chars-backward " \r\t\n")
397 (beginning-of-line))
398 ((looking-at "^[ \t]*#\\+end_")
399 (re-search-backward "^[ \t]*#\\+begin_"))
401 (setq ind-ref (min (org-get-indentation) ind-ref))
402 (forward-line -1))))))))))
404 (defun org-list-in-item-p-with-regexp (limit)
405 "Is the cursor inside a plain list?
406 Plain lists end when `org-list-end-regexp' is matched, or at a
407 blank line if `org-empty-line-terminates-plain-lists' is true.
409 Argument LIMIT specifies the upper-bound of the search."
410 (save-excursion
411 (let* ((actual-pos (goto-char (point-at-eol)))
412 ;; Moved to eol so current line can be matched by
413 ;; `org-item-re'.
414 (last-item-start (save-excursion
415 (org-search-backward-unenclosed
416 org-item-beginning-re limit t)))
417 (list-ender (org-list-ending-between
418 last-item-start actual-pos)))
419 ;; We are in a list when we are on an item line or when we can
420 ;; find an item before point and there is no valid list ender
421 ;; between it and the point.
422 (and last-item-start (not list-ender)))))
424 (defun org-list-top-point-with-regexp (limit)
425 "Return point at the top level item in a list.
426 Argument LIMIT specifies the upper-bound of the search.
428 List ending is determined by regexp. See
429 `org-list-ending-method'. for more information."
430 (save-excursion
431 (let ((pos (point-at-eol)))
432 ;; Is there some list above this one ? If so, go to its ending.
433 ;; Otherwise, go back to the heading above or bob.
434 (goto-char (or (org-list-ending-between limit pos) limit))
435 ;; From there, search down our list.
436 (org-search-forward-unenclosed org-item-beginning-re pos t)
437 (point-at-bol))))
439 (defun org-list-bottom-point-with-regexp (limit)
440 "Return point just before list ending.
441 Argument LIMIT specifies the lower-bound of the search.
443 List ending is determined by regexp. See
444 `org-list-ending-method'. for more information."
445 (save-excursion
446 (let ((pos (org-get-item-beginning)))
447 ;; The list ending is either first point matching
448 ;; `org-list-end-re', point at first white-line before next
449 ;; heading, or eob.
450 (or (org-list-ending-between (min pos limit) limit t) limit))))
452 (defun org-list-top-point-with-indent (limit)
453 "Return point at the top level in a list.
454 Argument LIMIT specifies the upper-bound of the search.
456 List ending is determined by indentation of text. See
457 `org-list-ending-method'. for more information."
458 (save-excursion
459 (let ((case-fold-search t))
460 (let ((item-ref (goto-char (org-get-item-beginning)))
461 (ind-ref 10000))
462 (forward-line -1)
463 (catch 'exit
464 (while t
465 (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0)
466 (org-get-indentation))))
467 (cond
468 ((looking-at "^[ \t]*:END:")
469 (throw 'exit item-ref))
470 ((<= (point) limit)
471 (throw 'exit
472 (if (and (org-at-item-p) (< ind ind-ref))
473 (point-at-bol)
474 item-ref)))
475 ((looking-at "^[ \t]*$")
476 (skip-chars-backward " \r\t\n")
477 (beginning-of-line))
478 ((looking-at "^[ \t]*#\\+end_")
479 (re-search-backward "^[ \t]*#\\+begin_"))
480 ((not (org-at-item-p))
481 (setq ind-ref (min ind ind-ref))
482 (forward-line -1))
483 ((>= ind ind-ref)
484 (throw 'exit item-ref))
486 (setq item-ref (point-at-bol) ind-ref 10000)
487 (forward-line -1))))))))))
489 (defun org-list-bottom-point-with-indent (limit)
490 "Return point just before list ending or nil if not in a list.
491 Argument LIMIT specifies the lower-bound of the search.
493 List ending is determined by the indentation of text. See
494 `org-list-ending-method' for more information."
495 (save-excursion
496 (let ((ind-ref (progn
497 (goto-char (org-get-item-beginning))
498 (org-get-indentation)))
499 (case-fold-search t))
500 ;; do not start inside a block
501 (org-list-maybe-skip-block #'re-search-forward limit)
502 (beginning-of-line)
503 (catch 'exit
504 (while t
505 (skip-chars-forward " \t")
506 (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0)
507 (org-get-indentation))))
508 (cond
509 ((or (>= (point) limit)
510 (looking-at ":END:"))
511 (throw 'exit (progn
512 ;; Ensure bottom is just after a
513 ;; non-blank line.
514 (skip-chars-backward " \r\t\n")
515 (min (point-max) (1+ (point-at-eol))))))
516 ((= (point) (point-at-eol))
517 (skip-chars-forward " \r\t\n")
518 (beginning-of-line))
519 ((org-at-item-p)
520 (setq ind-ref ind)
521 (forward-line 1))
522 ((<= ind ind-ref)
523 (throw 'exit (progn
524 ;; Again, ensure bottom is just after a
525 ;; non-blank line.
526 (skip-chars-backward " \r\t\n")
527 (min (point-max) (1+ (point-at-eol))))))
528 ((looking-at "#\\+begin_")
529 (re-search-forward "[ \t]*#\\+end_")
530 (forward-line 1))
531 (t (forward-line 1)))))))))
533 (defun org-list-at-regexp-after-bullet-p (regexp)
534 "Is point at a list item with REGEXP after bullet?"
535 (and (org-at-item-p)
536 (save-excursion
537 (goto-char (match-end 0))
538 ;; Ignore counter if any
539 (when (looking-at "\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?")
540 (goto-char (match-end 0)))
541 (looking-at regexp))))
543 (defun org-list-get-item-same-level (search-fun pos limit pre-move)
544 "Return point at the beginning of next item at the same level.
545 Search items using function SEARCH-FUN, from POS to LIMIT. It
546 uses PRE-MOVE before search. Return nil if no item was found."
547 (save-excursion
548 (goto-char pos)
549 (let* ((start (org-get-item-beginning))
550 (ind (progn (goto-char start) (org-get-indentation))))
551 ;; We don't want to match the current line.
552 (funcall pre-move)
553 ;; Skip any sublist on the way
554 (while (and (funcall search-fun org-item-beginning-re limit t)
555 (> (org-get-indentation) ind)))
556 (when (and (/= (point-at-bol) start) ; Have we moved ?
557 (= (org-get-indentation) ind))
558 (point-at-bol)))))
560 (defun org-list-separating-blank-lines-number (pos top bottom)
561 "Return number of blank lines that should separate items in list.
562 POS is the position of point to be considered.
564 TOP and BOTTOM are respectively position of list beginning and
565 list ending.
567 Assume point is at item's beginning. If the item is alone, apply
568 some heuristics to guess the result."
569 (save-excursion
570 (let ((insert-blank-p
571 (cdr (assq 'plain-list-item org-blank-before-new-entry)))
572 usr-blank)
573 (cond
574 ;; Trivial cases where there should be none.
575 ((or (and (not (eq org-list-ending-method 'indent))
576 org-empty-line-terminates-plain-lists)
577 (not insert-blank-p)) 0)
578 ;; When `org-blank-before-new-entry' says so, it is 1.
579 ((eq insert-blank-p t) 1)
580 ;; plain-list-item is 'auto. Count blank lines separating
581 ;; neighbours items in list.
582 (t (let ((next-p (org-get-next-item (point) bottom)))
583 (cond
584 ;; Is there a next item?
585 (next-p (goto-char next-p)
586 (org-back-over-empty-lines))
587 ;; Is there a previous item?
588 ((org-get-previous-item (point) top)
589 (org-back-over-empty-lines))
590 ;; User inserted blank lines, trust him
591 ((and (> pos (org-end-of-item-before-blank bottom))
592 (> (save-excursion
593 (goto-char pos)
594 (skip-chars-backward " \t")
595 (setq usr-blank (org-back-over-empty-lines))) 0))
596 usr-blank)
597 ;; Are there blank lines inside the item ?
598 ((save-excursion
599 (org-search-forward-unenclosed
600 "^[ \t]*$" (org-end-of-item-before-blank bottom) t)) 1)
601 ;; No parent: no blank line.
602 (t 0))))))))
604 (defun org-list-insert-item-generic (pos &optional checkbox after-bullet)
605 "Insert a new list item at POS.
606 If POS is before first character after bullet of the item, the
607 new item will be created before the current one.
609 Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET
610 after the bullet. Cursor will be after this text once the
611 function ends."
612 (goto-char pos)
613 ;; Is point in a special block?
614 (when (org-in-regexps-block-p
615 "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)"
616 '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2)))
617 (if (not (cdr (assq 'insert org-list-automatic-rules)))
618 ;; Rule in `org-list-automatic-rules' forbids insertion.
619 (error "Cannot insert item inside a block")
620 ;; Else, move before it prior to add a new item.
621 (end-of-line)
622 (re-search-backward "^[ \t]*#\\+\\(begin\\|BEGIN\\)_" nil t)
623 (end-of-line 0)))
624 (let* ((true-pos (point))
625 (top (org-list-top-point))
626 (bottom (copy-marker (org-list-bottom-point)))
627 (bullet (and (goto-char (org-get-item-beginning))
628 (org-list-bullet-string (org-get-bullet))))
629 (ind (org-get-indentation))
630 (before-p (progn
631 ;; Description item: text starts after colons.
632 (or (org-at-item-description-p)
633 ;; At a checkbox: text starts after it.
634 (org-at-item-checkbox-p)
635 ;; Otherwise, text starts after bullet.
636 (org-at-item-p))
637 (<= true-pos (match-end 0))))
638 (blank-lines-nb (org-list-separating-blank-lines-number
639 true-pos top bottom))
640 (insert-fun
641 (lambda (text)
642 ;; insert bullet above item in order to avoid bothering
643 ;; with possible blank lines ending last item.
644 (goto-char (org-get-item-beginning))
645 (org-indent-to-column ind)
646 (insert (concat bullet (when checkbox "[ ] ") after-bullet))
647 ;; Stay between after-bullet and before text.
648 (save-excursion
649 (insert (concat text (make-string (1+ blank-lines-nb) ?\n))))
650 (unless before-p
651 ;; store bottom: exchanging items doesn't change list
652 ;; bottom point but will modify marker anyway
653 (setq bottom (marker-position bottom))
654 (let ((col (current-column)))
655 (org-list-exchange-items
656 (org-get-item-beginning) (org-get-next-item (point) bottom)
657 bottom)
658 ;; recompute next-item: last sexp modified list
659 (goto-char (org-get-next-item (point) bottom))
660 (org-move-to-column col)))
661 ;; checkbox update might modify bottom point, so use a
662 ;; marker here
663 (setq bottom (copy-marker bottom))
664 (when checkbox (org-update-checkbox-count-maybe))
665 (org-list-repair nil top bottom))))
666 (goto-char true-pos)
667 (cond
668 (before-p (funcall insert-fun nil) t)
669 ;; Can't split item: insert bullet at the end of item.
670 ((not (org-get-alist-option org-M-RET-may-split-line 'item))
671 (funcall insert-fun nil) t)
672 ;; else, insert a new bullet along with everything from point
673 ;; down to last non-blank line of item.
675 (delete-horizontal-space)
676 ;; Get pos again in case previous command modified line.
677 (let* ((pos (point))
678 (end-before-blank (org-end-of-item-before-blank bottom))
679 (after-text
680 (when (< pos end-before-blank)
681 (prog1
682 (delete-and-extract-region pos end-before-blank)
683 ;; delete any blank line at and before point.
684 (beginning-of-line)
685 (while (looking-at "^[ \t]*$")
686 (delete-region (point-at-bol) (1+ (point-at-eol)))
687 (beginning-of-line 0))))))
688 (funcall insert-fun after-text) t)))))
690 (defvar org-last-indent-begin-marker (make-marker))
691 (defvar org-last-indent-end-marker (make-marker))
693 (defun org-list-indent-item-generic (arg no-subtree top bottom)
694 "Indent a local list item including its children.
695 When number ARG is a negative, item will be outdented, otherwise
696 it will be indented.
698 If a region is active, all items inside will be moved.
700 If NO-SUBTREE is non-nil, only indent the item itself, not its
701 children.
703 TOP and BOTTOM are respectively position at item beginning and at
704 item ending.
706 Return t if successful."
707 (let* ((regionp (org-region-active-p))
708 (rbeg (and regionp (region-beginning)))
709 (rend (and regionp (region-end))))
710 (cond
711 ((and regionp
712 (goto-char rbeg)
713 (not (org-search-forward-unenclosed org-item-beginning-re rend t)))
714 (error "No item in region"))
715 ((not (org-at-item-p))
716 (error "Not on an item"))
718 ;; Are we going to move the whole list?
719 (let* ((specialp (and (cdr (assq 'indent org-list-automatic-rules))
720 (not no-subtree)
721 (= top (point-at-bol)))))
722 ;; Determine begin and end points of zone to indent. If moving
723 ;; more than one item, ensure we keep them on subsequent moves.
724 (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft))
725 (memq this-command '(org-shiftmetaright org-shiftmetaleft)))
726 (if regionp
727 (progn
728 (set-marker org-last-indent-begin-marker rbeg)
729 (set-marker org-last-indent-end-marker rend))
730 (set-marker org-last-indent-begin-marker (point-at-bol))
731 (set-marker org-last-indent-end-marker
732 (save-excursion
733 (cond
734 (specialp bottom)
735 (no-subtree (org-end-of-item-or-at-child bottom))
736 (t (org-get-end-of-item bottom)))))))
737 ;; Get everything ready
738 (let* ((beg (marker-position org-last-indent-begin-marker))
739 (end (marker-position org-last-indent-end-marker))
740 (struct (org-list-struct
741 beg end top (if specialp end bottom) (< arg 0)))
742 (origins (org-list-struct-origins struct))
743 (beg-item (assq beg struct)))
744 (cond
745 ;; Special case: moving top-item with indent rule
746 (specialp
747 (let* ((level-skip (org-level-increment))
748 (offset (if (< arg 0) (- level-skip) level-skip))
749 (top-ind (nth 1 beg-item)))
750 (if (< (+ top-ind offset) 0)
751 (error "Cannot outdent beyond margin")
752 ;; Change bullet if necessary
753 (when (and (= (+ top-ind offset) 0)
754 (string-match "*" (nth 2 beg-item)))
755 (setcdr beg-item (list (nth 1 beg-item)
756 (org-list-bullet-string "-"))))
757 ;; Shift ancestor
758 (let ((anc (car struct)))
759 (setcdr anc (list (+ (nth 1 anc) offset) "" nil)))
760 (org-list-struct-fix-struct struct origins)
761 (org-list-struct-apply-struct struct end))))
762 ;; Forbidden move
763 ((and (< arg 0)
764 (or (and no-subtree
765 (not regionp)
766 (org-list-struct-get-child beg-item struct))
767 (let ((last-item (save-excursion
768 (goto-char end)
769 (skip-chars-backward " \r\t\n")
770 (goto-char (org-get-item-beginning))
771 (org-list-struct-assoc-at-point))))
772 (org-list-struct-get-child last-item struct))))
773 (error "Cannot outdent an item without its children"))
774 ;; Normal shifting
776 (let* ((shifted-ori (if (< arg 0)
777 (org-list-struct-outdent beg end origins)
778 (org-list-struct-indent beg end origins struct))))
779 (org-list-struct-fix-struct struct shifted-ori)
780 (org-list-struct-apply-struct struct bottom))))))))))
782 ;;; Predicates
784 (defun org-in-item-p ()
785 "Is the cursor inside a plain list?
786 This checks `org-list-ending-method'."
787 (unless (let ((outline-regexp org-outline-regexp)) (org-at-heading-p))
788 (let* ((prev-head (save-excursion (outline-previous-heading)))
789 (bound (if prev-head
790 (or (save-excursion
791 (let ((case-fold-search t))
792 (re-search-backward "^[ \t]*:END:" prev-head t)))
793 prev-head)
794 (point-min))))
795 (cond
796 ((eq org-list-ending-method 'regexp)
797 (org-list-in-item-p-with-regexp bound))
798 ((eq org-list-ending-method 'indent)
799 (org-list-in-item-p-with-indent bound))
800 (t (and (org-list-in-item-p-with-regexp bound)
801 (org-list-in-item-p-with-indent bound)))))))
803 (defun org-list-first-item-p (top)
804 "Is this item the first item in a plain list?
805 Assume point is at an item.
807 TOP is the position of list's top-item."
808 (save-excursion
809 (beginning-of-line)
810 (let ((ind (org-get-indentation)))
811 (or (not (org-search-backward-unenclosed org-item-beginning-re top t))
812 (< (org-get-indentation) ind)))))
814 (defun org-at-item-p ()
815 "Is point in a line starting a hand-formatted item?"
816 (save-excursion
817 (beginning-of-line) (looking-at org-item-beginning-re)))
819 (defun org-at-item-bullet-p ()
820 "Is point at the bullet of a plain list item?"
821 (and (org-at-item-p)
822 (not (member (char-after) '(?\ ?\t)))
823 (< (point) (match-end 0))))
825 (defun org-at-item-timer-p ()
826 "Is point at a line starting a plain list item with a timer?"
827 (org-list-at-regexp-after-bullet-p
828 "\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+::[ \t]+"))
830 (defun org-at-item-description-p ()
831 "Is point at a description list item?"
832 (org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::[ \t]+"))
834 (defun org-at-item-checkbox-p ()
835 "Is point at a line starting a plain-list item with a checklet?"
836 (org-list-at-regexp-after-bullet-p "\\(\\[[- X]\\]\\)[ \t]+"))
838 (defun org-checkbox-blocked-p ()
839 "Is the current checkbox blocked from for being checked now?
840 A checkbox is blocked if all of the following conditions are fulfilled:
842 1. The checkbox is not checked already.
843 2. The current entry has the ORDERED property set.
844 3. There is an unchecked checkbox in this entry before the current line."
845 (catch 'exit
846 (save-match-data
847 (save-excursion
848 (unless (org-at-item-checkbox-p) (throw 'exit nil))
849 (when (equal (match-string 1) "[X]")
850 ;; the box is already checked!
851 (throw 'exit nil))
852 (let ((end (point-at-bol)))
853 (condition-case nil (org-back-to-heading t)
854 (error (throw 'exit nil)))
855 (unless (org-entry-get nil "ORDERED") (throw 'exit nil))
856 (when (org-search-forward-unenclosed
857 "^[ \t]*[-+*0-9.)]+[ \t]+\\(\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\[[- ]\\]" end t)
858 (org-current-line)))))))
860 ;;; Navigate
862 ;; Every interactive navigation function is derived from a
863 ;; non-interactive one, which doesn't move point, assumes point is
864 ;; already in a list and doesn't compute list boundaries.
866 ;; If you plan to use more than one org-list function is some code,
867 ;; you should therefore first check if point is in a list with
868 ;; `org-in-item-p' or `org-at-item-p', then compute list boundaries
869 ;; with `org-list-top-point' and `org-list-bottom-point', and make use
870 ;; of non-interactive forms.
872 (defun org-list-top-point ()
873 "Return point at the top level in a list.
874 Assume point is in a list."
875 (let* ((prev-head (save-excursion (outline-previous-heading)))
876 (bound (if prev-head
877 (or (save-excursion
878 (let ((case-fold-search t))
879 (re-search-backward "^[ \t]*:END:" prev-head t)))
880 prev-head)
881 (point-min))))
882 (cond
883 ((eq org-list-ending-method 'regexp)
884 (org-list-top-point-with-regexp bound))
885 ((eq org-list-ending-method 'indent)
886 (org-list-top-point-with-indent bound))
887 (t (let ((top-re (org-list-top-point-with-regexp bound)))
888 (org-list-top-point-with-indent (or top-re bound)))))))
890 (defun org-list-bottom-point ()
891 "Return point just before list ending.
892 Assume point is in a list."
893 (let* ((next-head (save-excursion
894 (and (let ((outline-regexp org-outline-regexp))
895 ;; Use default regexp because folding
896 ;; changes OUTLINE-REGEXP.
897 (outline-next-heading)))))
898 (limit (or (save-excursion
899 (and (re-search-forward "^[ \t]*:END:" next-head t)
900 (point-at-bol)))
901 next-head
902 (point-max))))
903 (cond
904 ((eq org-list-ending-method 'regexp)
905 (org-list-bottom-point-with-regexp limit))
906 ((eq org-list-ending-method 'indent)
907 (org-list-bottom-point-with-indent limit))
908 (t (let ((bottom-re (org-list-bottom-point-with-regexp limit)))
909 (org-list-bottom-point-with-indent (or bottom-re limit)))))))
911 (defun org-get-item-beginning ()
912 "Return position of current item beginning."
913 (save-excursion
914 ;; possibly match current line
915 (end-of-line)
916 (org-search-backward-unenclosed org-item-beginning-re nil t)
917 (point-at-bol)))
919 (defun org-beginning-of-item ()
920 "Go to the beginning of the current hand-formatted item.
921 If the cursor is not in an item, throw an error."
922 (interactive)
923 (if (org-in-item-p)
924 (goto-char (org-get-item-beginning))
925 (error "Not in an item")))
927 (defun org-get-beginning-of-list (top)
928 "Return position of the first item of the current list or sublist.
929 TOP is the position at list beginning."
930 (save-excursion
931 (let (prev-p)
932 (while (setq prev-p (org-get-previous-item (point) top))
933 (goto-char prev-p))
934 (point-at-bol))))
936 (defun org-beginning-of-item-list ()
937 "Go to the beginning item of the current list or sublist.
938 Return an error if not in a list."
939 (interactive)
940 (if (org-in-item-p)
941 (goto-char (org-get-beginning-of-list (org-list-top-point)))
942 (error "Not in an item")))
944 (defun org-get-end-of-list (bottom)
945 "Return position at the end of the current list or sublist.
946 BOTTOM is the position at list ending."
947 (save-excursion
948 (goto-char (org-get-item-beginning))
949 (let ((ind (org-get-indentation)))
950 (while (and (/= (point) bottom)
951 (>= (org-get-indentation) ind))
952 (org-search-forward-unenclosed org-item-beginning-re bottom 'move))
953 (if (= (point) bottom) bottom (point-at-bol)))))
955 (defun org-end-of-item-list ()
956 "Go to the end of the current list or sublist.
957 If the cursor in not in an item, throw an error."
958 (interactive)
959 (if (org-in-item-p)
960 (goto-char (org-get-end-of-list (org-list-bottom-point)))
961 (error "Not in an item")))
963 (defun org-get-end-of-item (bottom)
964 "Return position at the end of the current item.
965 BOTTOM is the position at list ending."
966 (or (org-get-next-item (point) bottom)
967 (org-get-end-of-list bottom)))
969 (defun org-end-of-item ()
970 "Go to the end of the current hand-formatted item.
971 If the cursor is not in an item, throw an error."
972 (interactive)
973 (if (org-in-item-p)
974 (goto-char (org-get-end-of-item (org-list-bottom-point)))
975 (error "Not in an item")))
977 (defun org-end-of-item-or-at-child (bottom)
978 "Move to the end of the item, stops before the first child if any.
979 BOTTOM is the position at list ending."
980 (end-of-line)
981 (goto-char
982 (if (org-search-forward-unenclosed org-item-beginning-re bottom t)
983 (point-at-bol)
984 (org-get-end-of-item bottom))))
986 (defun org-end-of-item-before-blank (bottom)
987 "Return point at end of item, before any blank line.
988 Point returned is at eol.
990 BOTTOM is the position at list ending."
991 (save-excursion
992 (goto-char (org-get-end-of-item bottom))
993 (skip-chars-backward " \r\t\n")
994 (point-at-eol)))
996 (defun org-get-previous-item (pos limit)
997 "Return point of the previous item at the same level as POS.
998 Stop searching at LIMIT. Return nil if no item is found."
999 (org-list-get-item-same-level
1000 #'org-search-backward-unenclosed pos limit #'beginning-of-line))
1002 (defun org-previous-item ()
1003 "Move to the beginning of the previous item.
1004 Item is at the same level in the current plain list. Error if not
1005 in a plain list, or if this is the first item in the list."
1006 (interactive)
1007 (if (not (org-in-item-p))
1008 (error "Not in an item")
1009 (let ((prev-p (org-get-previous-item (point) (org-list-top-point))))
1010 (if prev-p (goto-char prev-p) (error "On first item")))))
1012 (defun org-get-next-item (pos limit)
1013 "Return point of the next item at the same level as POS.
1014 Stop searching at LIMIT. Return nil if no item is found."
1015 (org-list-get-item-same-level
1016 #'org-search-forward-unenclosed pos limit #'end-of-line))
1018 (defun org-next-item ()
1019 "Move to the beginning of the next item.
1020 Item is at the same level in the current plain list. Error if not
1021 in a plain list, or if this is the last item in the list."
1022 (interactive)
1023 (if (not (org-in-item-p))
1024 (error "Not in an item")
1025 (let ((next-p (org-get-next-item (point) (org-list-bottom-point))))
1026 (if next-p (goto-char next-p) (error "On last item")))))
1028 ;;; Manipulate
1030 (defun org-list-exchange-items (beg-A beg-B bottom)
1031 "Swap item starting at BEG-A with item starting at BEG-B.
1032 Blank lines at the end of items are left in place. Assume BEG-A
1033 is lesser than BEG-B.
1035 BOTTOM is the position at list ending."
1036 (save-excursion
1037 (let* ((end-of-item-no-blank
1038 (lambda (pos)
1039 (goto-char pos)
1040 (goto-char (org-end-of-item-before-blank bottom))))
1041 (end-A-no-blank (funcall end-of-item-no-blank beg-A))
1042 (end-B-no-blank (funcall end-of-item-no-blank beg-B))
1043 (body-A (buffer-substring beg-A end-A-no-blank))
1044 (body-B (buffer-substring beg-B end-B-no-blank))
1045 (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B)))
1046 (goto-char beg-A)
1047 (delete-region beg-A end-B-no-blank)
1048 (insert (concat body-B between-A-no-blank-and-B body-A)))))
1050 (defun org-move-item-down ()
1051 "Move the plain list item at point down, i.e. swap with following item.
1052 Subitems (items with larger indentation) are considered part of the item,
1053 so this really moves item trees."
1054 (interactive)
1055 (if (not (org-at-item-p))
1056 (error "Not at an item")
1057 (let* ((pos (point))
1058 (col (current-column))
1059 (bottom (org-list-bottom-point))
1060 (actual-item (goto-char (org-get-item-beginning)))
1061 (next-item (org-get-next-item (point) bottom)))
1062 (if (not next-item)
1063 (progn
1064 (goto-char pos)
1065 (error "Cannot move this item further down"))
1066 (org-list-exchange-items actual-item next-item bottom)
1067 (org-list-repair nil nil bottom)
1068 (goto-char (org-get-next-item (point) bottom))
1069 (org-move-to-column col)))))
1071 (defun org-move-item-up ()
1072 "Move the plain list item at point up, i.e. swap with previous item.
1073 Subitems (items with larger indentation) are considered part of the item,
1074 so this really moves item trees."
1075 (interactive)
1076 (if (not (org-at-item-p))
1077 (error "Not at an item")
1078 (let* ((pos (point))
1079 (col (current-column))
1080 (top (org-list-top-point))
1081 (bottom (org-list-bottom-point))
1082 (actual-item (goto-char (org-get-item-beginning)))
1083 (prev-item (org-get-previous-item (point) top)))
1084 (if (not prev-item)
1085 (progn
1086 (goto-char pos)
1087 (error "Cannot move this item further up"))
1088 (org-list-exchange-items prev-item actual-item bottom)
1089 (org-list-repair nil top bottom)
1090 (org-move-to-column col)))))
1092 (defun org-insert-item (&optional checkbox)
1093 "Insert a new item at the current level.
1094 If cursor is before first character after bullet of the item, the
1095 new item will be created before the current one.
1097 If CHECKBOX is non-nil, add a checkbox next to the bullet.
1099 Return t when things worked, nil when we are not in an item, or
1100 item is invisible."
1101 (unless (or (not (org-in-item-p))
1102 (save-excursion
1103 (goto-char (org-get-item-beginning))
1104 (org-invisible-p)))
1105 (if (save-excursion
1106 (goto-char (org-get-item-beginning))
1107 (org-at-item-timer-p))
1108 ;; Timer list: delegate to `org-timer-item'.
1109 (progn (org-timer-item) t)
1110 ;; if we're in a description list, ask for the new term.
1111 (let ((desc-text (when (save-excursion
1112 (and (goto-char (org-get-item-beginning))
1113 (org-at-item-description-p)))
1114 (concat (read-string "Term: ") " :: "))))
1115 ;; Don't insert a checkbox if checkbox rule is applied and it
1116 ;; is a description item.
1117 (org-list-insert-item-generic
1118 (point) (and checkbox
1119 (or (not desc-text)
1120 (not (cdr (assq 'checkbox org-list-automatic-rules)))))
1121 desc-text)))))
1123 ;;; Structures
1125 ;; The idea behind structures is to avoid moving back and forth in the
1126 ;; buffer on costly operations like indenting or fixing bullets.
1128 ;; It achieves this by taking a snapshot of an interesting part of the
1129 ;; list, in the shape of an alist, using `org-list-struct'.
1131 ;; It then proceeds to changes directly on the alist, with the help of
1132 ;; and `org-list-struct-origins'. When those are done,
1133 ;; `org-list-struct-apply-struct' applies the changes to the buffer.
1135 (defun org-list-struct-assoc-at-point ()
1136 "Return the structure association at point.
1137 It is a cons-cell whose key is point and values are indentation,
1138 bullet string and bullet counter, if any."
1139 (save-excursion
1140 (beginning-of-line)
1141 (list (point-at-bol)
1142 (org-get-indentation)
1143 (progn
1144 (looking-at "^[ \t]*\\([-+*0-9.)]+[ \t]+\\)")
1145 (match-string 1))
1146 (progn
1147 (goto-char (match-end 0))
1148 (and (looking-at "\\[@\\(?:start:\\)?\\([0-9]+\\)\\]")
1149 (match-string 1))))))
1151 (defun org-list-struct (begin end top bottom &optional outdent)
1152 "Return the structure containing the list between BEGIN and END.
1153 A structure is an alist where key is point of item and values
1154 are, in that order, indentation, bullet string and value of
1155 counter, if any. A structure contains every list and sublist that
1156 has items between BEGIN and END along with their common ancestor.
1157 If no such ancestor can be found, the function will add a virtual
1158 ancestor at position 0.
1160 TOP and BOTTOM are respectively the position of list beginning
1161 and list ending.
1163 If OUTDENT is non-nil, it will also grab all of the parent list
1164 and the grand-parent. Setting OUTDENT to t is mandatory when next
1165 change is an outdent."
1166 (save-excursion
1167 (let* (struct
1168 (extend
1169 (lambda (struct)
1170 (let* ((ind-min (apply 'min (mapcar 'cadr struct)))
1171 (begin (caar struct))
1172 (end (caar (last struct)))
1173 pre-list post-list)
1174 (goto-char begin)
1175 ;; Find beginning of most outdented list (min list)
1176 (while (and (org-search-backward-unenclosed
1177 org-item-beginning-re top t)
1178 (>= (org-get-indentation) ind-min))
1179 (setq pre-list (cons (org-list-struct-assoc-at-point)
1180 pre-list)))
1181 ;; Now get the parent. If none, add a virtual ancestor
1182 (if (< (org-get-indentation) ind-min)
1183 (setq pre-list (cons (org-list-struct-assoc-at-point)
1184 pre-list))
1185 (setq pre-list (cons (list 0 (org-get-indentation) "" nil)
1186 pre-list)))
1187 ;; Find end of min list
1188 (goto-char end)
1189 (end-of-line)
1190 (while (and (org-search-forward-unenclosed
1191 org-item-beginning-re bottom 'move)
1192 (>= (org-get-indentation) ind-min))
1193 (setq post-list (cons (org-list-struct-assoc-at-point)
1194 post-list)))
1195 ;; Is list is malformed? If some items are less
1196 ;; indented that top-item, add them anyhow.
1197 (when (and (= (caar pre-list) 0) (< (point) bottom))
1198 (beginning-of-line)
1199 (while (org-search-forward-unenclosed
1200 org-item-beginning-re bottom t)
1201 (setq post-list (cons (org-list-struct-assoc-at-point)
1202 post-list))))
1203 (append pre-list struct (reverse post-list))))))
1204 ;; Here we start: first get the core zone...
1205 (goto-char end)
1206 (while (org-search-backward-unenclosed org-item-beginning-re begin t)
1207 (setq struct (cons (org-list-struct-assoc-at-point) struct)))
1208 ;; ... then, extend it to make it a structure...
1209 (let ((extended (funcall extend struct)))
1210 ;; ... twice when OUTDENT is non-nil and struct still can be
1211 ;; extended
1212 (if (and outdent (> (caar extended) 0))
1213 (funcall extend extended)
1214 extended)))))
1216 (defun org-list-struct-origins (struct)
1217 "Return an alist where key is item's position and value parent's.
1218 STRUCT is the list's structure looked up."
1219 (let* ((struct-rev (reverse struct))
1220 (acc (list (cons (nth 1 (car struct)) 0)))
1221 (prev-item (lambda (item)
1222 (car (nth 1 (member (assq item struct) struct-rev)))))
1223 (get-origins
1224 (lambda (item)
1225 (let* ((item-pos (car item))
1226 (ind (nth 1 item))
1227 (prev-ind (caar acc)))
1228 (cond
1229 ;; List closing.
1230 ((> prev-ind ind)
1231 (let ((current-origin (or (member (assq ind acc) acc)
1232 ;; needed if top-point is
1233 ;; not the most outdented
1234 (last acc))))
1235 (setq acc current-origin)
1236 (cons item-pos (cdar acc))))
1237 ;; New list
1238 ((< prev-ind ind)
1239 (let ((origin (funcall prev-item item-pos)))
1240 (setq acc (cons (cons ind origin) acc))
1241 (cons item-pos origin)))
1242 ;; Current list going on
1243 (t (cons item-pos (cdar acc))))))))
1244 (cons '(0 . 0) (mapcar get-origins (cdr struct)))))
1246 (defun org-list-struct-get-parent (item struct origins)
1247 "Return parent association of ITEM in STRUCT or nil.
1248 ORIGINS is the alist of parents. See `org-list-struct-origins'."
1249 (let* ((parent-pos (cdr (assq (car item) origins))))
1250 (when (> parent-pos 0) (assq parent-pos struct))))
1252 (defun org-list-struct-get-child (item struct)
1253 "Return child association of ITEM in STRUCT or nil."
1254 (let ((ind (nth 1 item))
1255 (next-item (cadr (member item struct))))
1256 (when (and next-item (> (nth 1 next-item) ind)) next-item)))
1258 (defun org-list-struct-fix-bul (struct origins)
1259 "Verify and correct bullets for every association in STRUCT.
1260 ORIGINS is the alist of parents. See `org-list-struct-origins'.
1262 This function modifies STRUCT."
1263 (let* (acc
1264 (init-bul (lambda (item)
1265 (let ((counter (nth 3 item))
1266 (bullet (org-list-bullet-string (nth 2 item))))
1267 (cond
1268 ((and (string-match "[0-9]+" bullet) counter)
1269 (replace-match counter nil nil bullet))
1270 ((string-match "[0-9]+" bullet)
1271 (replace-match "1" nil nil bullet))
1272 (t bullet)))))
1273 (set-bul (lambda (item bullet)
1274 (setcdr item (list (nth 1 item) bullet (nth 3 item)))))
1275 (get-bul (lambda (item bullet)
1276 (let* ((counter (nth 3 item)))
1277 (if (and counter (string-match "[0-9]+" bullet))
1278 (replace-match counter nil nil bullet)
1279 bullet))))
1280 (fix-bul
1281 (lambda (item) struct
1282 (let* ((parent (cdr (assq (car item) origins)))
1283 (orig-ref (assq parent acc)))
1284 (if orig-ref
1285 ;; Continuing previous list
1286 (let* ((prev-bul (cdr orig-ref))
1287 (new-bul (funcall get-bul item prev-bul)))
1288 (setcdr orig-ref (org-list-inc-bullet-maybe new-bul))
1289 (funcall set-bul item new-bul))
1290 ;; A new list is starting
1291 (let ((new-bul (funcall init-bul item)))
1292 (funcall set-bul item new-bul)
1293 (setq acc (cons (cons parent
1294 (org-list-inc-bullet-maybe new-bul))
1295 acc))))))))
1296 (mapc fix-bul (cdr struct))))
1298 (defun org-list-struct-fix-ind (struct origins)
1299 "Verify and correct indentation for every association in STRUCT.
1300 ORIGINS is the alist of parents. See `org-list-struct-origins'.
1302 This function modifies STRUCT."
1303 (let* ((headless (cdr struct))
1304 (ancestor (car struct))
1305 (top-ind (+ (nth 1 ancestor) (length (nth 2 ancestor))))
1306 (new-ind
1307 (lambda (item)
1308 (let* ((parent (org-list-struct-get-parent item headless origins)))
1309 (if parent
1310 ;; Indent like parent + length of parent's bullet
1311 (setcdr item (cons (+ (length (nth 2 parent)) (nth 1 parent))
1312 (cddr item)))
1313 ;; If no parent, indent like top-point
1314 (setcdr item (cons top-ind (cddr item))))))))
1315 (mapc new-ind headless)))
1317 (defun org-list-struct-fix-struct (struct origins)
1318 "Return STRUCT with correct bullets and indentation.
1319 ORIGINS is the alist of parents. See `org-list-struct-origins'.
1321 Only elements of STRUCT that have changed are returned."
1322 (let ((old (copy-alist struct)))
1323 (org-list-struct-fix-bul struct origins)
1324 (org-list-struct-fix-ind struct origins)
1325 (delq nil (mapcar (lambda (e) (when (not (equal (pop old) e)) e)) struct))))
1327 (defun org-list-struct-outdent (start end origins)
1328 "Outdent items in a structure.
1329 Items are indented when their key is between START, included, and
1330 END, excluded.
1332 ORIGINS is the alist of parents. See `org-list-struct-origins'.
1334 STRUCT is the concerned structure."
1335 (let* (acc
1336 (out (lambda (cell)
1337 (let* ((item (car cell))
1338 (parent (cdr cell)))
1339 (cond
1340 ;; Item not yet in zone: keep association
1341 ((< item start) cell)
1342 ;; Item out of zone: follow associations in acc
1343 ((>= item end)
1344 (let ((convert (assq parent acc)))
1345 (if convert (cons item (cdr convert)) cell)))
1346 ;; Item has no parent: error
1347 ((<= parent 0)
1348 (error "Cannot outdent top-level items"))
1349 ;; Parent is outdented: keep association
1350 ((>= parent start)
1351 (setq acc (cons (cons parent item) acc)) cell)
1353 ;; Parent isn't outdented: reparent to grand-parent
1354 (let ((grand-parent (cdr (assq parent origins))))
1355 (setq acc (cons (cons parent item) acc))
1356 (cons item grand-parent))))))))
1357 (mapcar out origins)))
1359 (defun org-list-struct-indent (start end origins struct)
1360 "Indent items in a structure.
1361 Items are indented when their key is between START, included, and
1362 END, excluded.
1364 ORIGINS is the alist of parents. See `org-list-struct-origins'.
1366 STRUCT is the concerned structure. It may be modified if
1367 `org-list-demote-modify-bullet' matches bullets between START and
1368 END."
1369 (let* (acc
1370 (orig-rev (reverse origins))
1371 (get-prev-item
1372 (lambda (cell parent)
1373 (car (rassq parent (cdr (memq cell orig-rev))))))
1374 (set-assoc
1375 (lambda (cell)
1376 (setq acc (cons cell acc)) cell))
1377 (change-bullet-maybe
1378 (lambda (item)
1379 (let* ((full-item (assq item struct))
1380 (item-bul (org-trim (nth 2 full-item)))
1381 (new-bul-p (cdr (assoc item-bul org-list-demote-modify-bullet))))
1382 (when new-bul-p
1383 ;; new bullet is stored without space to ensure item
1384 ;; will be modified
1385 (setcdr full-item
1386 (list (nth 1 full-item)
1387 new-bul-p
1388 (nth 3 full-item)))))))
1389 (ind
1390 (lambda (cell)
1391 (let* ((item (car cell))
1392 (parent (cdr cell)))
1393 (cond
1394 ;; Item not yet in zone: keep association
1395 ((< item start) cell)
1396 ((>= item end)
1397 ;; Item out of zone: follow associations in acc
1398 (let ((convert (assq parent acc)))
1399 (if convert (cons item (cdr convert)) cell)))
1401 ;; Item is in zone...
1402 (let ((prev (funcall get-prev-item cell parent)))
1403 ;; Check if bullet needs to be changed
1404 (funcall change-bullet-maybe item)
1405 (cond
1406 ;; First item indented but not parent: error
1407 ((and (or (not prev) (= prev 0)) (< parent start))
1408 (error "Cannot indent the first item of a list"))
1409 ;; First item and parent indented: keep same parent
1410 ((or (not prev) (= prev 0))
1411 (funcall set-assoc cell))
1412 ;; Previous item not indented: reparent to it
1413 ((< prev start)
1414 (funcall set-assoc (cons item prev)))
1415 ;; Previous item indented: reparent like it
1417 (funcall set-assoc (cons item
1418 (cdr (assq prev acc)))))))))))))
1419 (mapcar ind origins)))
1421 (defun org-list-struct-apply-struct (struct bottom)
1422 "Apply modifications to list so it mirrors STRUCT.
1423 BOTTOM is position at list ending.
1425 Initial position is restored after the changes."
1426 (let* ((pos (copy-marker (point)))
1427 (ancestor (caar struct))
1428 (modify
1429 (lambda (item)
1430 (goto-char (car item))
1431 (let* ((new-ind (nth 1 item))
1432 (new-bul (org-list-bullet-string (nth 2 item)))
1433 (old-ind (org-get-indentation))
1434 (old-bul (progn
1435 (looking-at "[ \t]*\\(\\S-+[ \t]*\\)")
1436 (match-string 1)))
1437 (old-body-ind (+ (length old-bul) old-ind))
1438 (new-body-ind (+ (length new-bul) new-ind)))
1439 ;; 1. Shift item's body
1440 (unless (= old-body-ind new-body-ind)
1441 (org-shift-item-indentation
1442 (- new-body-ind old-body-ind) bottom))
1443 ;; 2. Replace bullet
1444 (unless (equal new-bul old-bul)
1445 (save-excursion
1446 (looking-at "[ \t]*\\(\\S-+[ \t]*\\)")
1447 (replace-match new-bul nil nil nil 1)))
1448 ;; 3. Indent item to appropriate column
1449 (unless (= new-ind old-ind)
1450 (delete-region (point-at-bol)
1451 (progn
1452 (skip-chars-forward " \t")
1453 (point)))
1454 (indent-to new-ind)))))
1455 ;; Remove ancestor if it is left.
1456 (struct-to-apply (if (or (not ancestor) (= 0 ancestor))
1457 (cdr struct)
1458 struct)))
1459 ;; Apply changes from bottom to top
1460 (mapc modify (nreverse struct-to-apply))
1461 (goto-char pos)))
1463 ;;; Indentation
1465 (defun org-get-string-indentation (s)
1466 "What indentation has S due to SPACE and TAB at the beginning of the string?"
1467 (let ((n -1) (i 0) (w tab-width) c)
1468 (catch 'exit
1469 (while (< (setq n (1+ n)) (length s))
1470 (setq c (aref s n))
1471 (cond ((= c ?\ ) (setq i (1+ i)))
1472 ((= c ?\t) (setq i (* (/ (+ w i) w) w)))
1473 (t (throw 'exit t)))))
1476 (defun org-shift-item-indentation (delta bottom)
1477 "Shift the indentation in current item by DELTA.
1478 Sub-items are not moved.
1480 BOTTOM is position at list ending."
1481 (save-excursion
1482 (let ((beg (point-at-bol))
1483 (end (org-end-of-item-or-at-child bottom)))
1484 (beginning-of-line (unless (eolp) 0))
1485 (while (> (point) beg)
1486 (when (looking-at "[ \t]*\\S-")
1487 ;; this is not an empty line
1488 (let ((i (org-get-indentation)))
1489 (when (and (> i 0) (> (+ i delta) 0))
1490 (org-indent-line-to (+ i delta)))))
1491 (beginning-of-line 0)))))
1493 (defun org-outdent-item ()
1494 "Outdent a local list item, but not its children.
1495 If a region is active, all items inside will be moved."
1496 (interactive)
1497 (org-list-indent-item-generic
1498 -1 t (org-list-top-point) (org-list-bottom-point)))
1500 (defun org-indent-item ()
1501 "Indent a local list item, but not its children.
1502 If a region is active, all items inside will be moved."
1503 (interactive)
1504 (org-list-indent-item-generic
1505 1 t (org-list-top-point) (org-list-bottom-point)))
1507 (defun org-outdent-item-tree ()
1508 "Outdent a local list item including its children.
1509 If a region is active, all items inside will be moved."
1510 (interactive)
1511 (org-list-indent-item-generic
1512 -1 nil (org-list-top-point) (org-list-bottom-point)))
1514 (defun org-indent-item-tree ()
1515 "Indent a local list item including its children.
1516 If a region is active, all items inside will be moved."
1517 (interactive)
1518 (org-list-indent-item-generic
1519 1 nil (org-list-top-point) (org-list-bottom-point)))
1521 (defvar org-tab-ind-state)
1522 (defun org-cycle-item-indentation ()
1523 "Cycle levels of indentation of an empty item.
1524 The first run indent the item, if applicable. Subsequents runs
1525 outdent it at meaningful levels in the list. When done, item is
1526 put back at its original position with its original bullet.
1528 Return t at each successful move."
1529 (let ((org-adapt-indentation nil)
1530 (ind (org-get-indentation))
1531 (bottom (and (org-at-item-p) (org-list-bottom-point))))
1532 (when (and (or (org-at-item-description-p)
1533 (org-at-item-checkbox-p)
1534 (org-at-item-p))
1535 ;; Check that item is really empty
1536 (>= (match-end 0) (save-excursion
1537 (org-end-of-item-or-at-child bottom)
1538 (skip-chars-backward " \r\t\n")
1539 (point))))
1540 (setq this-command 'org-cycle-item-indentation)
1541 (let ((top (org-list-top-point)))
1542 ;; When in the middle of the cycle, try to outdent first. If it
1543 ;; fails, and point is still at initial position, indent. Else,
1544 ;; go back to original position.
1545 (if (eq last-command 'org-cycle-item-indentation)
1546 (cond
1547 ((ignore-errors (org-list-indent-item-generic -1 t top bottom)))
1548 ((and (= (org-get-indentation) (car org-tab-ind-state))
1549 (ignore-errors
1550 (org-list-indent-item-generic 1 t top bottom))))
1551 (t (back-to-indentation)
1552 (org-indent-to-column (car org-tab-ind-state))
1553 (end-of-line)
1554 (org-list-repair (cdr org-tab-ind-state))
1555 ;; Break cycle
1556 (setq this-command 'identity)))
1557 ;; If a cycle is starting, remember indentation and bullet,
1558 ;; then try to indent. If it fails, try to outdent.
1559 (setq org-tab-ind-state (cons ind (org-get-bullet)))
1560 (cond
1561 ((ignore-errors (org-list-indent-item-generic 1 t top bottom)))
1562 ((ignore-errors (org-list-indent-item-generic -1 t top bottom)))
1563 (t (error "Cannot move item")))))
1564 t)))
1566 ;;; Bullets
1568 (defun org-get-bullet ()
1569 "Return the bullet of the item at point.
1570 Assume cursor is at an item."
1571 (save-excursion
1572 (beginning-of-line)
1573 (and (looking-at "[ \t]*\\(\\S-+\\)") (match-string 1))))
1575 (defun org-list-bullet-string (bullet)
1576 "Return BULLET with the correct number of whitespaces.
1577 It determines the number of whitespaces to append by looking at
1578 `org-list-two-spaces-after-bullet-regexp'."
1579 (save-match-data
1580 (string-match "\\S-+\\([ \t]*\\)" bullet)
1581 (replace-match
1582 (save-match-data
1583 (concat
1585 ;; Do we need to concat another white space ?
1586 (when (and org-list-two-spaces-after-bullet-regexp
1587 (string-match org-list-two-spaces-after-bullet-regexp bullet))
1588 " ")))
1589 nil nil bullet 1)))
1591 (defun org-list-inc-bullet-maybe (bullet)
1592 "Increment BULLET if applicable."
1593 (if (string-match "[0-9]+" bullet)
1594 (replace-match
1595 (number-to-string (1+ (string-to-number (match-string 0 bullet))))
1596 nil nil bullet)
1597 bullet))
1599 (defun org-list-repair (&optional force-bullet top bottom)
1600 "Make sure all items are correctly indented, with the right bullet.
1601 This function scans the list at point, along with any sublist.
1603 If FORCE-BULLET is a string, ensure all items in list share this
1604 bullet, or a logical successor in the case of an ordered list.
1606 When non-nil, TOP and BOTTOM specify respectively position of
1607 list beginning and list ending.
1609 Item's body is not indented, only shifted with the bullet."
1610 (interactive)
1611 (unless (org-at-item-p) (error "This is not a list"))
1612 (let* ((bottom (or bottom (org-list-bottom-point)))
1613 (struct (org-list-struct
1614 (point-at-bol) (point-at-eol)
1615 (or top (org-list-top-point)) bottom))
1616 (origins (org-list-struct-origins struct))
1617 fixed-struct)
1618 (if (stringp force-bullet)
1619 (let ((begin (nth 1 struct)))
1620 (setcdr begin (list (nth 1 begin)
1621 (org-list-bullet-string force-bullet)
1622 (nth 3 begin)))
1623 (setq fixed-struct
1624 (cons begin (org-list-struct-fix-struct struct origins))))
1625 (setq fixed-struct (org-list-struct-fix-struct struct origins)))
1626 (org-list-struct-apply-struct fixed-struct bottom)))
1628 (defun org-cycle-list-bullet (&optional which)
1629 "Cycle through the different itemize/enumerate bullets.
1630 This cycle the entire list level through the sequence:
1632 `-' -> `+' -> `*' -> `1.' -> `1)'
1634 If WHICH is a valid string, use that as the new bullet. If WHICH
1635 is an integer, 0 means `-', 1 means `+' etc. If WHICH is
1636 'previous, cycle backwards."
1637 (interactive "P")
1638 (save-excursion
1639 (let* ((top (org-list-top-point))
1640 (bullet (progn
1641 (goto-char (org-get-beginning-of-list top))
1642 (org-get-bullet)))
1643 (current (cond
1644 ((string-match "\\." bullet) "1.")
1645 ((string-match ")" bullet) "1)")
1646 (t bullet)))
1647 (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules)))
1648 (bullet-list (append '("-" "+" )
1649 ;; *-bullets are not allowed at column 0
1650 (unless (and bullet-rule-p
1651 (looking-at "\\S-")) '("*"))
1652 ;; Description items cannot be numbered
1653 (unless (and bullet-rule-p
1654 (or (eq org-plain-list-ordered-item-terminator ?\))
1655 (org-at-item-description-p))) '("1."))
1656 (unless (and bullet-rule-p
1657 (or (eq org-plain-list-ordered-item-terminator ?.)
1658 (org-at-item-description-p))) '("1)"))))
1659 (len (length bullet-list))
1660 (item-index (- len (length (member current bullet-list))))
1661 (get-value (lambda (index) (nth (mod index len) bullet-list)))
1662 (new (cond
1663 ((member which bullet-list) which)
1664 ((numberp which) (funcall get-value which))
1665 ((eq 'previous which) (funcall get-value (1- item-index)))
1666 (t (funcall get-value (1+ item-index))))))
1667 (org-list-repair new top))))
1669 ;;; Checkboxes
1671 (defun org-toggle-checkbox (&optional toggle-presence)
1672 "Toggle the checkbox in the current line.
1673 With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. With
1674 double prefix, set checkbox to [-].
1676 When there is an active region, toggle status or presence of the
1677 first checkbox there, and make every item inside have the
1678 same status or presence, respectively.
1680 If the cursor is in a headline, apply this to all checkbox items
1681 in the text below the heading, taking as reference the first item
1682 in subtree, ignoring drawers."
1683 (interactive "P")
1684 ;; Bounds is a list of type (beg end single-p) where single-p is t
1685 ;; when `org-toggle-checkbox' is applied to a single item. Only
1686 ;; toggles on single items will return errors.
1687 (let* ((bounds
1688 (cond
1689 ((org-region-active-p)
1690 (let ((rbeg (region-beginning))
1691 (rend (region-end)))
1692 (save-excursion
1693 (goto-char rbeg)
1694 (if (org-search-forward-unenclosed org-item-beginning-re rend 'move)
1695 (list (point-at-bol) rend nil)
1696 (error "No item in region")))))
1697 ((org-on-heading-p)
1698 ;; In this case, reference line is the first item in
1699 ;; subtree outside drawers
1700 (let ((pos (point))
1701 (limit (save-excursion (outline-next-heading) (point))))
1702 (save-excursion
1703 (goto-char limit)
1704 (org-search-backward-unenclosed ":END:" pos 'move)
1705 (org-search-forward-unenclosed
1706 org-item-beginning-re limit 'move)
1707 (list (point) limit nil))))
1708 ((org-at-item-p)
1709 (list (point-at-bol) (1+ (point-at-eol)) t))
1710 (t (error "Not at an item or heading, and no active region"))))
1711 (beg (car bounds))
1712 ;; marker is needed because deleting or inserting checkboxes
1713 ;; will change bottom point
1714 (end (copy-marker (nth 1 bounds)))
1715 (single-p (nth 2 bounds))
1716 (ref-presence (save-excursion
1717 (goto-char beg)
1718 (org-at-item-checkbox-p)))
1719 (ref-status (equal (match-string 1) "[X]"))
1720 (act-on-item
1721 (lambda (ref-pres ref-stat)
1722 (if (equal toggle-presence '(4))
1723 (cond
1724 ((and ref-pres (org-at-item-checkbox-p))
1725 (replace-match ""))
1726 ((and (not ref-pres)
1727 (not (org-at-item-checkbox-p))
1728 (org-at-item-p))
1729 (goto-char (match-end 0))
1730 ;; Ignore counter, if any
1731 (when (looking-at "\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?")
1732 (goto-char (match-end 0)))
1733 (let ((desc-p (and (org-at-item-description-p)
1734 (cdr (assq 'checkbox org-list-automatic-rules)))))
1735 (cond
1736 ((and single-p desc-p)
1737 (error "Cannot add a checkbox in a description list"))
1738 ((not desc-p) (insert "[ ] "))))))
1739 (let ((blocked (org-checkbox-blocked-p)))
1740 (cond
1741 ((and blocked single-p)
1742 (error "Checkbox blocked because of unchecked box in line %d" blocked))
1743 (blocked nil)
1744 ((org-at-item-checkbox-p)
1745 (replace-match
1746 (cond ((equal toggle-presence '(16)) "[-]")
1747 (ref-stat "[ ]")
1748 (t "[X]"))
1749 t t nil 1))))))))
1750 (save-excursion
1751 (goto-char beg)
1752 (while (< (point) end)
1753 (funcall act-on-item ref-presence ref-status)
1754 (org-search-forward-unenclosed org-item-beginning-re end 'move)))
1755 (org-update-checkbox-count-maybe)))
1757 (defun org-reset-checkbox-state-subtree ()
1758 "Reset all checkboxes in an entry subtree."
1759 (interactive "*")
1760 (save-restriction
1761 (save-excursion
1762 (org-narrow-to-subtree)
1763 (org-show-subtree)
1764 (goto-char (point-min))
1765 (let ((end (point-max)))
1766 (while (< (point) end)
1767 (when (org-at-item-checkbox-p)
1768 (replace-match "[ ]" t t nil 1))
1769 (beginning-of-line 2))))
1770 (org-update-checkbox-count-maybe)))
1772 (defvar org-checkbox-statistics-hook nil
1773 "Hook that is run whenever Org thinks checkbox statistics should be updated.
1774 This hook runs even if checkbox rule in
1775 `org-list-automatic-rules' does not apply, so it can be used to
1776 implement alternative ways of collecting statistics
1777 information.")
1779 (defun org-update-checkbox-count-maybe ()
1780 "Update checkbox statistics unless turned off by user."
1781 (when (cdr (assq 'checkbox org-list-automatic-rules))
1782 (org-update-checkbox-count))
1783 (run-hooks 'org-checkbox-statistics-hook))
1785 (defun org-update-checkbox-count (&optional all)
1786 "Update the checkbox statistics in the current section.
1787 This will find all statistic cookies like [57%] and [6/12] and update them
1788 with the current numbers. With optional prefix argument ALL, do this for
1789 the whole buffer."
1790 (interactive "P")
1791 (save-excursion
1792 (let ((cstat 0))
1793 (catch 'exit
1794 (while t
1795 (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21
1796 (beg (condition-case nil
1797 (progn (org-back-to-heading) (point))
1798 (error (point-min))))
1799 (end (copy-marker (save-excursion
1800 (outline-next-heading) (point))))
1801 (re-cookie "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
1802 (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)")
1803 beg-cookie end-cookie is-percent c-on c-off lim new
1804 curr-ind next-ind continue-from startsearch list-beg list-end
1805 (recursive
1806 (or (not org-hierarchical-checkbox-statistics)
1807 (string-match "\\<recursive\\>"
1808 (or (ignore-errors
1809 (org-entry-get nil "COOKIE_DATA"))
1810 "")))))
1811 (goto-char end)
1812 ;; find each statistics cookie
1813 (while (and (org-search-backward-unenclosed re-cookie beg 'move)
1814 (not (save-match-data
1815 (and (org-on-heading-p)
1816 (string-match "\\<todo\\>"
1817 (downcase
1818 (or (org-entry-get
1819 nil "COOKIE_DATA")
1820 "")))))))
1821 (setq beg-cookie (match-beginning 1)
1822 end-cookie (match-end 1)
1823 cstat (+ cstat (if end-cookie 1 0))
1824 startsearch (point-at-eol)
1825 continue-from (match-beginning 0)
1826 is-percent (match-beginning 2)
1827 lim (cond
1828 ((org-on-heading-p) (outline-next-heading) (point))
1829 ;; Ensure many cookies in the same list won't imply
1830 ;; computing list boundaries as many times.
1831 ((org-at-item-p)
1832 (unless (and list-beg (>= (point) list-beg))
1833 (setq list-beg (org-list-top-point)
1834 list-end (copy-marker
1835 (org-list-bottom-point))))
1836 (org-get-end-of-item list-end))
1837 (t nil))
1838 c-on 0
1839 c-off 0)
1840 (when lim
1841 ;; find first checkbox for this cookie and gather
1842 ;; statistics from all that are at this indentation level
1843 (goto-char startsearch)
1844 (if (org-search-forward-unenclosed re-box lim t)
1845 (progn
1846 (beginning-of-line)
1847 (setq curr-ind (org-get-indentation))
1848 (setq next-ind curr-ind)
1849 (while (and (bolp) (org-at-item-p)
1850 (if recursive
1851 (<= curr-ind next-ind)
1852 (= curr-ind next-ind)))
1853 (when (org-at-item-checkbox-p)
1854 (if (member (match-string 1) '("[ ]" "[-]"))
1855 (setq c-off (1+ c-off))
1856 (setq c-on (1+ c-on))))
1857 (if (not recursive)
1858 ;; org-get-next-item goes through list-enders
1859 ;; with proper limit.
1860 (goto-char (or (org-get-next-item (point) lim) lim))
1861 (end-of-line)
1862 (when (org-search-forward-unenclosed
1863 org-item-beginning-re lim t)
1864 (beginning-of-line)))
1865 (setq next-ind (org-get-indentation)))))
1866 (goto-char continue-from)
1867 ;; update cookie
1868 (when end-cookie
1869 (setq new (if is-percent
1870 (format "[%d%%]" (/ (* 100 c-on)
1871 (max 1 (+ c-on c-off))))
1872 (format "[%d/%d]" c-on (+ c-on c-off))))
1873 (goto-char beg-cookie)
1874 (insert new)
1875 (delete-region (point) (+ (point) (- end-cookie beg-cookie))))
1876 ;; update items checkbox if it has one
1877 (when (and (org-at-item-checkbox-p)
1878 (> (+ c-on c-off) 0))
1879 (setq beg-cookie (match-beginning 1)
1880 end-cookie (match-end 1))
1881 (delete-region beg-cookie end-cookie)
1882 (goto-char beg-cookie)
1883 (cond ((= c-off 0) (insert "[X]"))
1884 ((= c-on 0) (insert "[ ]"))
1885 (t (insert "[-]")))))
1886 (goto-char continue-from)))
1887 (unless (and all (outline-next-heading)) (throw 'exit nil))))
1888 (when (interactive-p)
1889 (message "Checkbox statistics updated %s (%d places)"
1890 (if all "in entire file" "in current outline entry") cstat)))))
1892 (defun org-get-checkbox-statistics-face ()
1893 "Select the face for checkbox statistics.
1894 The face will be `org-done' when all relevant boxes are checked.
1895 Otherwise it will be `org-todo'."
1896 (if (match-end 1)
1897 (if (equal (match-string 1) "100%")
1898 'org-checkbox-statistics-done
1899 'org-checkbox-statistics-todo)
1900 (if (and (> (match-end 2) (match-beginning 2))
1901 (equal (match-string 2) (match-string 3)))
1902 'org-checkbox-statistics-done
1903 'org-checkbox-statistics-todo)))
1905 ;;; Misc Tools
1907 (defun org-apply-on-list (function init-value &rest args)
1908 "Call FUNCTION on each item of the list at point.
1909 FUNCTION must be called with at least one argument: INIT-VALUE,
1910 that will contain the value returned by the function at the
1911 previous item, plus ARGS extra arguments.
1913 As an example, (org-apply-on-list (lambda (result) (1+ result)) 0)
1914 will return the number of items in the current list.
1916 Sublists of the list are skipped. Cursor is always at the
1917 beginning of the item."
1918 (let* ((pos (copy-marker (point)))
1919 (end (copy-marker (org-list-bottom-point)))
1920 (next-p (copy-marker (org-get-beginning-of-list (org-list-top-point))))
1921 (value init-value))
1922 (while (< next-p end)
1923 (goto-char next-p)
1924 (set-marker next-p (or (org-get-next-item (point) end) end))
1925 (setq value (apply function value args)))
1926 (goto-char pos)
1927 value))
1929 (defun org-sort-list (&optional with-case sorting-type getkey-func compare-func)
1930 "Sort plain list items.
1931 The cursor may be at any item of the list that should be sorted.
1932 Sublists are not sorted. Checkboxes, if any, are ignored.
1934 Sorting can be alphabetically, numerically, by date/time as given by
1935 a time stamp, by a property or by priority.
1937 Comparing entries ignores case by default. However, with an
1938 optional argument WITH-CASE, the sorting considers case as well.
1940 The command prompts for the sorting type unless it has been given
1941 to the function through the SORTING-TYPE argument, which needs to
1942 be a character, \(?n ?N ?a ?A ?t ?T ?f ?F). Here is the precise
1943 meaning of each character:
1945 n Numerically, by converting the beginning of the item to a number.
1946 a Alphabetically. Only the first line of item is checked.
1947 t By date/time, either the first active time stamp in the entry, if
1948 any, or by the first inactive one. In a timer list, sort the timers.
1950 Capital letters will reverse the sort order.
1952 If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a
1953 function to be called with point at the beginning of the record.
1954 It must return either a string or a number that should serve as
1955 the sorting key for that record. It will then use COMPARE-FUNC to
1956 compare entries."
1957 (interactive "P")
1958 (let* ((case-func (if with-case 'identity 'downcase))
1959 (top (org-list-top-point))
1960 (bottom (org-list-bottom-point))
1961 (start (org-get-beginning-of-list top))
1962 (end (org-get-end-of-list bottom))
1963 (sorting-type
1964 (progn
1965 (message
1966 "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:")
1967 (read-char-exclusive)))
1968 (getkey-func (and (= (downcase sorting-type) ?f)
1969 (org-icompleting-read "Sort using function: "
1970 obarray 'fboundp t nil nil)
1971 (intern getkey-func))))
1972 (message "Sorting items...")
1973 (save-restriction
1974 (narrow-to-region start end)
1975 (goto-char (point-min))
1976 (let* ((dcst (downcase sorting-type))
1977 (case-fold-search nil)
1978 (now (current-time))
1979 (sort-func (cond
1980 ((= dcst ?a) 'string<)
1981 ((= dcst ?f) compare-func)
1982 ((= dcst ?t) '<)
1983 (t nil)))
1984 (begin-record (lambda ()
1985 (skip-chars-forward " \r\t\n")
1986 (beginning-of-line)))
1987 (end-record (lambda ()
1988 (goto-char (org-end-of-item-before-blank end))))
1989 (value-to-sort
1990 (lambda ()
1991 (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+")
1992 (cond
1993 ((= dcst ?n)
1994 (string-to-number (buffer-substring (match-end 0)
1995 (point-at-eol))))
1996 ((= dcst ?a)
1997 (buffer-substring (match-end 0) (point-at-eol)))
1998 ((= dcst ?t)
1999 (cond
2000 ;; If it is a timer list, convert timer to seconds
2001 ((org-at-item-timer-p)
2002 (org-timer-hms-to-secs (match-string 1)))
2003 ((or (org-search-forward-unenclosed org-ts-regexp
2004 (point-at-eol) t)
2005 (org-search-forward-unenclosed org-ts-regexp-both
2006 (point-at-eol) t))
2007 (org-time-string-to-seconds (match-string 0)))
2008 (t (org-float-time now))))
2009 ((= dcst ?f)
2010 (if getkey-func
2011 (let ((value (funcall getkey-func)))
2012 (if (stringp value)
2013 (funcall case-func value)
2014 value))
2015 (error "Invalid key function `%s'" getkey-func)))
2016 (t (error "Invalid sorting type `%c'" sorting-type)))))))
2017 (sort-subr (/= dcst sorting-type)
2018 begin-record
2019 end-record
2020 value-to-sort
2022 sort-func)
2023 (org-list-repair nil top bottom)
2024 (run-hooks 'org-after-sorting-entries-or-items-hook)
2025 (message "Sorting items...done")))))
2027 ;;; Send and receive lists
2029 (defun org-list-parse-list (&optional delete)
2030 "Parse the list at point and maybe DELETE it.
2031 Return a list containing first level items as strings and
2032 sublevels as a list of strings."
2033 (let* ((start (goto-char (org-list-top-point)))
2034 (end (org-list-bottom-point))
2035 output itemsep ltype)
2036 (while (org-search-forward-unenclosed org-item-beginning-re end t)
2037 (save-excursion
2038 (beginning-of-line)
2039 (setq ltype (cond ((org-looking-at-p "^[ \t]*[0-9]") 'ordered)
2040 ((org-at-item-description-p) 'descriptive)
2041 (t 'unordered))))
2042 (let* ((indent1 (org-get-indentation))
2043 (nextitem (or (org-get-next-item (point) end) end))
2044 (item (org-trim (buffer-substring (point)
2045 (org-end-of-item-or-at-child end))))
2046 (nextindent (if (= (point) end) 0 (org-get-indentation)))
2047 (item (if (string-match
2048 "^\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\[\\([xX ]\\)\\]"
2049 item)
2050 (replace-match (if (equal (match-string 1 item) " ")
2051 "CBOFF"
2052 "CBON")
2053 t nil item 1)
2054 item)))
2055 (push item output)
2056 (when (> nextindent indent1)
2057 (save-restriction
2058 (narrow-to-region (point) nextitem)
2059 (push (org-list-parse-list) output)))))
2060 (when delete
2061 (delete-region start end)
2062 (save-match-data
2063 (when (and (not (eq org-list-ending-method 'indent))
2064 (looking-at (org-list-end-re)))
2065 (replace-match "\n"))))
2066 (setq output (nreverse output))
2067 (push ltype output)))
2069 (defun org-list-make-subtree ()
2070 "Convert the plain list at point into a subtree."
2071 (interactive)
2072 (if (not (org-in-item-p))
2073 (error "Not in a list")
2074 (let ((list (org-list-parse-list t)) nstars)
2075 (save-excursion
2076 (if (ignore-errors
2077 (org-back-to-heading))
2078 (progn (looking-at org-complex-heading-regexp)
2079 (setq nstars (length (match-string 1))))
2080 (setq nstars 0)))
2081 (org-list-make-subtrees list (1+ nstars)))))
2083 (defun org-list-make-subtrees (list level)
2084 "Convert LIST into subtrees starting at LEVEL."
2085 (if (symbolp (car list))
2086 (org-list-make-subtrees (cdr list) level)
2087 (mapcar (lambda (item)
2088 (if (stringp item)
2089 (insert (make-string
2090 (if org-odd-levels-only
2091 (1- (* 2 level)) level) ?*) " " item "\n")
2092 (org-list-make-subtrees item (1+ level))))
2093 list)))
2095 (defun org-list-insert-radio-list ()
2096 "Insert a radio list template appropriate for this major mode."
2097 (interactive)
2098 (let* ((e (assq major-mode org-list-radio-list-templates))
2099 (txt (nth 1 e))
2100 name pos)
2101 (unless e (error "No radio list setup defined for %s" major-mode))
2102 (setq name (read-string "List name: "))
2103 (while (string-match "%n" txt)
2104 (setq txt (replace-match name t t txt)))
2105 (or (bolp) (insert "\n"))
2106 (setq pos (point))
2107 (insert txt)
2108 (goto-char pos)))
2110 (defun org-list-send-list (&optional maybe)
2111 "Send a transformed version of this list to the receiver position.
2112 With argument MAYBE, fail quietly if no transformation is defined for
2113 this list."
2114 (interactive)
2115 (catch 'exit
2116 (unless (org-at-item-p) (error "Not at a list item"))
2117 (save-excursion
2118 (re-search-backward "#\\+ORGLST" nil t)
2119 (unless (looking-at "[ \t]*#\\+ORGLST[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?")
2120 (if maybe
2121 (throw 'exit nil)
2122 (error "Don't know how to transform this list"))))
2123 (let* ((name (match-string 1))
2124 (transform (intern (match-string 2)))
2125 (bottom-point
2126 (save-excursion
2127 (re-search-forward
2128 "\\(\\\\end{comment}\\|@end ignore\\|-->\\)" nil t)
2129 (match-beginning 0)))
2130 (top-point
2131 (progn
2132 (re-search-backward "#\\+ORGLST" nil t)
2133 (re-search-forward org-item-beginning-re bottom-point t)
2134 (match-beginning 0)))
2135 (list (save-restriction
2136 (narrow-to-region top-point bottom-point)
2137 (org-list-parse-list)))
2138 beg txt)
2139 (unless (fboundp transform)
2140 (error "No such transformation function %s" transform))
2141 (let ((txt (funcall transform list)))
2142 ;; Find the insertion place
2143 (save-excursion
2144 (goto-char (point-min))
2145 (unless (re-search-forward
2146 (concat "BEGIN RECEIVE ORGLST +"
2147 name
2148 "\\([ \t]\\|$\\)") nil t)
2149 (error "Don't know where to insert translated list"))
2150 (goto-char (match-beginning 0))
2151 (beginning-of-line 2)
2152 (setq beg (point))
2153 (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t)
2154 (error "Cannot find end of insertion region"))
2155 (delete-region beg (point-at-bol))
2156 (goto-char beg)
2157 (insert txt "\n")))
2158 (message "List converted and installed at receiver location"))))
2160 (defun org-list-to-generic (list params)
2161 "Convert a LIST parsed through `org-list-parse-list' to other formats.
2162 Valid parameters PARAMS are
2164 :ustart String to start an unordered list
2165 :uend String to end an unordered list
2167 :ostart String to start an ordered list
2168 :oend String to end an ordered list
2170 :dstart String to start a descriptive list
2171 :dend String to end a descriptive list
2172 :dtstart String to start a descriptive term
2173 :dtend String to end a descriptive term
2174 :ddstart String to start a description
2175 :ddend String to end a description
2177 :splice When set to t, return only list body lines, don't wrap
2178 them into :[u/o]start and :[u/o]end. Default is nil.
2180 :istart String to start a list item
2181 :iend String to end a list item
2182 :isep String to separate items
2183 :lsep String to separate sublists
2185 :cboff String to insert for an unchecked checkbox
2186 :cbon String to insert for a checked checkbox"
2187 (interactive)
2188 (let* ((p params) sublist
2189 (splicep (plist-get p :splice))
2190 (ostart (plist-get p :ostart))
2191 (oend (plist-get p :oend))
2192 (ustart (plist-get p :ustart))
2193 (uend (plist-get p :uend))
2194 (dstart (plist-get p :dstart))
2195 (dend (plist-get p :dend))
2196 (dtstart (plist-get p :dtstart))
2197 (dtend (plist-get p :dtend))
2198 (ddstart (plist-get p :ddstart))
2199 (ddend (plist-get p :ddend))
2200 (istart (plist-get p :istart))
2201 (iend (plist-get p :iend))
2202 (isep (plist-get p :isep))
2203 (lsep (plist-get p :lsep))
2204 (cbon (plist-get p :cbon))
2205 (cboff (plist-get p :cboff)))
2206 (let ((wrapper
2207 (cond ((eq (car list) 'ordered)
2208 (concat ostart "\n%s" oend "\n"))
2209 ((eq (car list) 'unordered)
2210 (concat ustart "\n%s" uend "\n"))
2211 ((eq (car list) 'descriptive)
2212 (concat dstart "\n%s" dend "\n"))))
2213 rtn term defstart defend)
2214 (while (setq sublist (pop list))
2215 (cond ((symbolp sublist) nil)
2216 ((stringp sublist)
2217 (when (string-match "^\\(.*\\)[ \t]+::" sublist)
2218 (setq term (org-trim (format (concat dtstart "%s" dtend)
2219 (match-string 1 sublist))))
2220 (setq sublist (concat ddstart
2221 (org-trim (substring sublist
2222 (match-end 0)))
2223 ddend)))
2224 (if (string-match "\\[CBON\\]" sublist)
2225 (setq sublist (replace-match cbon t t sublist)))
2226 (if (string-match "\\[CBOFF\\]" sublist)
2227 (setq sublist (replace-match cboff t t sublist)))
2228 (if (string-match "\\[-\\]" sublist)
2229 (setq sublist (replace-match "$\\boxminus$" t t sublist)))
2230 (setq rtn (concat rtn istart term sublist iend isep)))
2231 (t (setq rtn (concat rtn ;; previous list
2232 lsep ;; list separator
2233 (org-list-to-generic sublist p)
2234 lsep ;; list separator
2235 )))))
2236 (format wrapper rtn))))
2238 (defun org-list-to-latex (list &optional params)
2239 "Convert LIST into a LaTeX list.
2240 LIST is as returned by `org-list-parse-list'. PARAMS is a property list
2241 with overruling parameters for `org-list-to-generic'."
2242 (org-list-to-generic
2243 list
2244 (org-combine-plists
2245 '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}"
2246 :ustart "\\begin{itemize}" :uend "\\end{itemize}"
2247 :dstart "\\begin{description}" :dend "\\end{description}"
2248 :dtstart "[" :dtend "]"
2249 :ddstart "" :ddend ""
2250 :istart "\\item " :iend ""
2251 :isep "\n" :lsep "\n"
2252 :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}")
2253 params)))
2255 (defun org-list-to-html (list &optional params)
2256 "Convert LIST into a HTML list.
2257 LIST is as returned by `org-list-parse-list'. PARAMS is a property list
2258 with overruling parameters for `org-list-to-generic'."
2259 (org-list-to-generic
2260 list
2261 (org-combine-plists
2262 '(:splicep nil :ostart "<ol>" :oend "</ol>"
2263 :ustart "<ul>" :uend "</ul>"
2264 :dstart "<dl>" :dend "</dl>"
2265 :dtstart "<dt>" :dtend "</dt>"
2266 :ddstart "<dd>" :ddend "</dd>"
2267 :istart "<li>" :iend "</li>"
2268 :isep "\n" :lsep "\n"
2269 :cbon "<code>[X]</code>" :cboff "<code>[ ]</code>")
2270 params)))
2272 (defun org-list-to-texinfo (list &optional params)
2273 "Convert LIST into a Texinfo list.
2274 LIST is as returned by `org-list-parse-list'. PARAMS is a property list
2275 with overruling parameters for `org-list-to-generic'."
2276 (org-list-to-generic
2277 list
2278 (org-combine-plists
2279 '(:splicep nil :ostart "@itemize @minus" :oend "@end itemize"
2280 :ustart "@enumerate" :uend "@end enumerate"
2281 :dstart "@table" :dend "@end table"
2282 :dtstart "@item " :dtend "\n"
2283 :ddstart "" :ddend ""
2284 :istart "@item\n" :iend ""
2285 :isep "\n" :lsep "\n"
2286 :cbon "@code{[X]}" :cboff "@code{[ ]}")
2287 params)))
2289 (provide 'org-list)
2291 ;; arch-tag: 73cf50c1-200f-4d1d-8a53-4e842a5b11c8
2292 ;;; org-list.el ends here