* lisp/cedet/semantic/wisent/comp.el: Remove unnecessary eval-when-compiles.
[bpt/emacs.git] / lisp / org / org-list.el
CommitLineData
47ffc456
CD
1;;; org-list.el --- Plain lists for Org-mode
2;;
114f9c96 3;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
1e4f816a 4;; Free Software Foundation, Inc.
47ffc456
CD
5;;
6;; Author: Carsten Dominik <carsten at orgmode dot org>
33306645 7;; Bastien Guerry <bzg AT altern DOT org>
47ffc456
CD
8;; Keywords: outlines, hypermedia, calendar, wp
9;; Homepage: http://orgmode.org
86fbb8ca 10;; Version: 7.01
47ffc456
CD
11;;
12;; This file is part of GNU Emacs.
13;;
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.
18
19;; GNU Emacs is distributed in the hope that it will be useful,
20;; but WITHOUT ANY WARRANTY; without even the implied warranty of
33306645 21;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
47ffc456
CD
22;; GNU General Public License for more details.
23
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;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27;;
28;;; Commentary:
29
30;; This file contains the code dealing with plain lists in Org-mode.
31
32;;; Code:
33
86fbb8ca
CD
34(eval-when-compile
35 (require 'cl))
47ffc456
CD
36(require 'org-macs)
37(require 'org-compat)
38
39(defvar org-blank-before-new-entry)
40(defvar org-M-RET-may-split-line)
c8d0cf5c
CD
41(defvar org-complex-heading-regexp)
42(defvar org-odd-levels-only)
47ffc456
CD
43
44(declare-function org-invisible-p "org" ())
45(declare-function org-on-heading-p "org" (&optional invisible-ok))
9fc10007 46(declare-function outline-next-heading "outline" ())
47ffc456
CD
47(declare-function org-back-to-heading "org" (&optional invisible-ok))
48(declare-function org-back-over-empty-lines "org" ())
49(declare-function org-skip-whitespace "org" ())
50(declare-function org-trim "org" (s))
51(declare-function org-get-indentation "org" (&optional line))
ff4be292 52(declare-function org-timer-item "org-timer" (&optional arg))
0bd48b37 53(declare-function org-combine-plists "org" (&rest plists))
f1eee0b6
GM
54(declare-function org-entry-get "org"
55 (pom property &optional inherit literal-nil))
c8d0cf5c
CD
56(declare-function org-narrow-to-subtree "org" ())
57(declare-function org-show-subtree "org" ())
47ffc456
CD
58
59(defgroup org-plain-lists nil
60 "Options concerning plain lists in Org-mode."
61 :tag "Org Plain lists"
62 :group 'org-structure)
63
c8d0cf5c
CD
64(defcustom org-cycle-include-plain-lists t
65 "When t, make TAB cycle visibility on plain list items.
66
67Cycling plain lists works only when the cursor is on a plain list
68item. When the cursor is on an outline heading, plain lists are
69treated as text. This is the most stable way of handling this,
70which is why it is the default.
71
72When this is the symbol `integrate', then during cycling, plain
73list items will *temporarily* be interpreted as outline headlines
74with a level given by 1000+i where i is the indentation of the
75bullet. This setting can lead to strange effects when switching
76visibility to `children', because the first \"child\" in a
77subtree decides what children should be listed. If that first
78\"child\" is a plain list item with an implied large level
79number, all true children and grand children of the outline
80heading will be exposed in a children' view."
47ffc456 81 :group 'org-plain-lists
c8d0cf5c
CD
82 :type '(choice
83 (const :tag "Never" nil)
84 (const :tag "With cursor in plain list (recommended)" t)
85 (const :tag "As children of outline headings" integrate)))
86
87(defcustom org-list-demote-modify-bullet nil
88 "Default bullet type installed when demoting an item.
89This is an association list, for each bullet type, this alist will point
86fbb8ca
CD
90to the bullet that should be used when this item is demoted.
91For example,
92
93 (setq org-list-demote-modify-bullet
94 '((\"+\" . \"-\") (\"-\" . \"+\") (\"*\" . \"+\")))
95
96will make
97
98 + Movies
99 + Silence of the Lambs
100 + My Cousin Vinny
101 + Books
102 + The Hunt for Red October
103 + The Road to Omaha
104
105into
106
107 + Movies
108 - Silence of the Lambs
109 - My Cousin Vinny
110 + Books
111 - The Hunt for Red October
112 - The Road to Omaha"
c8d0cf5c
CD
113 :group 'org-plain-lists
114 :type '(repeat
115 (cons
116 (choice :tag "If the current bullet is "
117 (const "-")
118 (const "+")
119 (const "*")
120 (const "1.")
121 (const "1)"))
122 (choice :tag "demotion will change it to"
123 (const "-")
124 (const "+")
125 (const "*")
126 (const "1.")
127 (const "1)")))))
47ffc456
CD
128
129(defcustom org-plain-list-ordered-item-terminator t
130 "The character that makes a line with leading number an ordered list item.
131Valid values are ?. and ?\). To get both terminators, use t. While
132?. may look nicer, it creates the danger that a line with leading
133number may be incorrectly interpreted as an item. ?\) therefore is
134the safe choice."
135 :group 'org-plain-lists
136 :type '(choice (const :tag "dot like in \"2.\"" ?.)
137 (const :tag "paren like in \"2)\"" ?\))
138 (const :tab "both" t)))
139
ce4fdcb9
CD
140(defcustom org-list-two-spaces-after-bullet-regexp nil
141 "A regular expression matching bullets that should have 2 spaces after them.
142When nil, no bullet will have two spaces after them.
33306645 143When a string, it will be used as a regular expression. When the bullet
ce4fdcb9 144type of a list is changed, the new bullet type will be matched against this
33306645 145regexp. If it matches, there will be two spaces instead of one after
ce4fdcb9 146the bullet in each item of he list."
86fbb8ca 147 :group 'org-plain-lists
ce4fdcb9
CD
148 :type '(choice
149 (const :tag "never" nil)
150 (regexp)))
151
47ffc456 152(defcustom org-empty-line-terminates-plain-lists nil
ed21c5c8
CD
153 "Non-nil means an empty line ends all plain list levels.
154This is currently effective only during export. It should also have
155an effect for indentation and plain list folding, but it does not.
805b5d9c 156When nil, empty lines are part of the preceding item."
47ffc456
CD
157 :group 'org-plain-lists
158 :type 'boolean)
159
160(defcustom org-auto-renumber-ordered-lists t
ed21c5c8 161 "Non-nil means automatically renumber ordered plain lists.
47ffc456
CD
162Renumbering happens when the sequence have been changed with
163\\[org-shiftmetaup] or \\[org-shiftmetadown]. After other editing commands,
164use \\[org-ctrl-c-ctrl-c] to trigger renumbering."
165 :group 'org-plain-lists
166 :type 'boolean)
167
168(defcustom org-provide-checkbox-statistics t
ed21c5c8 169 "Non-nil means update checkbox statistics after insert and toggle.
c8d0cf5c
CD
170When this is set, checkbox statistics is updated each time you
171either insert a new checkbox with \\[org-insert-todo-heading] or
172toggle a checkbox with \\[org-ctrl-c-ctrl-c]."
173 :group 'org-plain-lists
174 :type 'boolean)
175
176(defcustom org-hierarchical-checkbox-statistics t
ed21c5c8 177 "Non-nil means checkbox statistics counts only the state of direct children.
54a0dee5 178When nil, all boxes below the cookie are counted.
8bfe682a 179This can be set to nil on a per-node basis using a COOKIE_DATA property
54a0dee5 180with the word \"recursive\" in the value."
47ffc456
CD
181 :group 'org-plain-lists
182 :type 'boolean)
183
184(defcustom org-description-max-indent 20
185 "Maximum indentation for the second line of a description list.
186When the indentation would be larger than this, it will become
1875 characters instead."
188 :group 'org-plain-lists
189 :type 'integer)
190
191(defvar org-list-beginning-re
c8d0cf5c 192 "^\\([ \t]*\\)\\([-+]\\|[0-9]+[.)]\\) +\\(.*\\)$")
47ffc456
CD
193
194(defcustom org-list-radio-list-templates
195 '((latex-mode "% BEGIN RECEIVE ORGLST %n
196% END RECEIVE ORGLST %n
197\\begin{comment}
198#+ORGLST: SEND %n org-list-to-latex
86fbb8ca 199-
47ffc456
CD
200\\end{comment}\n")
201 (texinfo-mode "@c BEGIN RECEIVE ORGLST %n
202@c END RECEIVE ORGLST %n
203@ignore
204#+ORGLST: SEND %n org-list-to-texinfo
86fbb8ca 205-
47ffc456
CD
206@end ignore\n")
207 (html-mode "<!-- BEGIN RECEIVE ORGLST %n -->
208<!-- END RECEIVE ORGLST %n -->
209<!--
210#+ORGLST: SEND %n org-list-to-html
86fbb8ca 211-
47ffc456
CD
212-->\n"))
213 "Templates for radio lists in different major modes.
214All occurrences of %n in a template will be replaced with the name of the
215list, obtained by prompting the user."
216 :group 'org-plain-lists
217 :type '(repeat
218 (list (symbol :tag "Major mode")
219 (string :tag "Format"))))
220
221;;;; Plain list items, including checkboxes
222
223;;; Plain list items
224
86fbb8ca
CD
225(defun org-item-re (&optional general)
226 "Return the correct regular expression for plain lists.
227If GENERAL is non-nil, return the general regexp independent of the value
228of `org-plain-list-ordered-item-terminator'."
229 (cond
230 ((or general (eq org-plain-list-ordered-item-terminator t))
231 "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
232 ((= org-plain-list-ordered-item-terminator ?.)
233 "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
234 ((= org-plain-list-ordered-item-terminator ?\))
235 "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
236 (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))))
237
47ffc456
CD
238(defun org-at-item-p ()
239 "Is point in a line starting a hand-formatted item?"
86fbb8ca
CD
240
241 (save-excursion
242 (goto-char (point-at-bol))
243 (looking-at (org-item-re))))
47ffc456 244
65c439fd
CD
245(defun org-at-item-bullet-p ()
246 "Is point at the bullet of a plain list item?"
247 (and (org-at-item-p)
248 (not (member (char-after) '(?\ ?\t)))
249 (< (point) (match-end 0))))
250
47ffc456 251(defun org-in-item-p ()
86fbb8ca 252 "Is the cursor inside a plain list item.
47ffc456
CD
253Does not have to be the first line."
254 (save-excursion
255 (condition-case nil
256 (progn
257 (org-beginning-of-item)
258 (org-at-item-p)
259 t)
260 (error nil))))
261
262(defun org-insert-item (&optional checkbox)
263 "Insert a new item at the current level.
264Return t when things worked, nil when we are not in an item."
265 (when (save-excursion
266 (condition-case nil
267 (progn
268 (org-beginning-of-item)
269 (org-at-item-p)
270 (if (org-invisible-p) (error "Invisible item"))
271 t)
272 (error nil)))
273 (let* ((bul (match-string 0))
274 (descp (save-excursion (goto-char (match-beginning 0))
275 (beginning-of-line 1)
276 (save-match-data
ff4be292
CD
277 (and (looking-at "[ \t]*\\(.*?\\) ::")
278 (match-string 1)))))
0bd48b37
CD
279 (empty-line-p (save-excursion
280 (goto-char (match-beginning 0))
281 (and (not (bobp))
282 (or (beginning-of-line 0) t)
283 (save-match-data
284 (looking-at "[ \t]*$")))))
ff4be292
CD
285 (timerp (and descp
286 (save-match-data
287 (string-match "^[-+*][ \t]+[0-9]+:[0-9]+:[0-9]+$"
288 descp))))
47ffc456
CD
289 (eow (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")
290 (match-end 0)))
c8d0cf5c
CD
291 (blank-a (if org-empty-line-terminates-plain-lists
292 nil
293 (cdr (assq 'plain-list-item org-blank-before-new-entry))))
0bd48b37 294 (blank (if (eq blank-a 'auto) empty-line-p blank-a))
47ffc456
CD
295 pos)
296 (if descp (setq checkbox nil))
ff4be292
CD
297 (if timerp
298 (progn (org-timer-item) t)
299 (cond
300 ((and (org-at-item-p) (<= (point) eow))
301 ;; before the bullet
302 (beginning-of-line 1)
303 (open-line (if blank 2 1)))
304 ((<= (point) eow)
305 (beginning-of-line 1))
306 (t
307 (unless (org-get-alist-option org-M-RET-may-split-line 'item)
308 (end-of-line 1)
309 (delete-horizontal-space))
310 (newline (if blank 2 1))))
311 (insert bul
312 (if checkbox "[ ]" "")
313 (if descp (concat (if checkbox " " "")
314 (read-string "Term: ") " :: ") ""))
315 (just-one-space)
316 (setq pos (point))
317 (end-of-line 1)
318 (unless (= (point) pos) (just-one-space) (backward-delete-char 1)))
319 (org-maybe-renumber-ordered-list)
320 (and checkbox (org-update-checkbox-count-maybe))
321 t)))
47ffc456
CD
322
323;;; Checkboxes
324
325(defun org-at-item-checkbox-p ()
326 "Is point at a line starting a plain-list item with a checklet?"
327 (and (org-at-item-p)
328 (save-excursion
329 (goto-char (match-end 0))
330 (skip-chars-forward " \t")
331 (looking-at "\\[[- X]\\]"))))
332
d6685abc
CD
333(defun org-toggle-checkbox (&optional toggle-presence)
334 "Toggle the checkbox in the current line.
335With prefix arg TOGGLE-PRESENCE, add or remove checkboxes.
c8d0cf5c 336With double prefix, set checkbox to [-].
d6685abc
CD
337When there is an active region, toggle status or presence of the checkbox
338in the first line, and make every item in the region have the same
805b5d9c 339status or presence, respectively.
a2a2e7fb
CD
340If the cursor is in a headline, apply this to all checkbox items in the
341text below the heading."
47ffc456
CD
342 (interactive "P")
343 (catch 'exit
c8d0cf5c 344 (let (beg end status first-present first-status blocked)
47ffc456
CD
345 (cond
346 ((org-region-active-p)
347 (setq beg (region-beginning) end (region-end)))
348 ((org-on-heading-p)
349 (setq beg (point) end (save-excursion (outline-next-heading) (point))))
350 ((org-at-item-checkbox-p)
c8d0cf5c
CD
351 (save-excursion
352 (if (equal toggle-presence '(4))
d6685abc
CD
353 (progn
354 (replace-match "")
355 (goto-char (match-beginning 0))
356 (just-one-space))
c8d0cf5c
CD
357 (when (setq blocked (org-checkbox-blocked-p))
358 (error "Checkbox blocked because of unchecked box in line %d"
359 blocked))
d6685abc 360 (replace-match
c8d0cf5c
CD
361 (cond ((equal toggle-presence '(16)) "[-]")
362 ((member (match-string 0) '("[ ]" "[-]")) "[X]")
d6685abc 363 (t "[ ]"))
c8d0cf5c 364 t t)))
47ffc456 365 (throw 'exit t))
d6685abc
CD
366 ((org-at-item-p)
367 ;; add a checkbox
368 (save-excursion
369 (goto-char (match-end 0))
370 (insert "[ ] "))
371 (throw 'exit t))
47ffc456 372 (t (error "Not at a checkbox or heading, and no active region")))
d6685abc 373 (setq end (move-marker (make-marker) end))
47ffc456
CD
374 (save-excursion
375 (goto-char beg)
d6685abc 376 (setq first-present (org-at-item-checkbox-p)
a2a2e7fb
CD
377 first-status
378 (save-excursion
379 (and (re-search-forward "[ \t]\\(\\[[ X]\\]\\)" end t)
380 (equal (match-string 1) "[X]"))))
47ffc456 381 (while (< (point) end)
d6685abc
CD
382 (if toggle-presence
383 (cond
384 ((and first-present (org-at-item-checkbox-p))
385 (save-excursion
386 (replace-match "")
387 (goto-char (match-beginning 0))
388 (just-one-space)))
389 ((and (not first-present) (not (org-at-item-checkbox-p))
390 (org-at-item-p))
391 (save-excursion
392 (goto-char (match-end 0))
393 (insert "[ ] "))))
394 (when (org-at-item-checkbox-p)
395 (setq status (equal (match-string 0) "[X]"))
396 (replace-match
397 (if first-status "[ ]" "[X]") t t)))
47ffc456
CD
398 (beginning-of-line 2)))))
399 (org-update-checkbox-count-maybe))
400
c8d0cf5c
CD
401(defun org-reset-checkbox-state-subtree ()
402 "Reset all checkboxes in an entry subtree."
403 (interactive "*")
404 (save-restriction
405 (save-excursion
406 (org-narrow-to-subtree)
407 (org-show-subtree)
408 (goto-char (point-min))
409 (let ((end (point-max)))
410 (while (< (point) end)
411 (when (org-at-item-checkbox-p)
412 (replace-match "[ ]" t t))
413 (beginning-of-line 2))))
414 (org-update-checkbox-count-maybe)))
415
416(defun org-checkbox-blocked-p ()
417 "Is the current checkbox blocked from for being checked now?
418A checkbox is blocked if all of the following conditions are fulfilled:
419
4201. The checkbox is not checked already.
4212. The current entry has the ORDERED property set.
4223. There is an unchecked checkbox in this entry before the current line."
423 (catch 'exit
424 (save-match-data
425 (save-excursion
426 (unless (org-at-item-checkbox-p) (throw 'exit nil))
427 (when (equal (match-string 0) "[X]")
428 ;; the box is already checked!
429 (throw 'exit nil))
430 (let ((end (point-at-bol)))
431 (condition-case nil (org-back-to-heading t)
432 (error (throw 'exit nil)))
433 (unless (org-entry-get nil "ORDERED") (throw 'exit nil))
434 (if (re-search-forward "^[ \t]*[-+*0-9.)] \\[[- ]\\]" end t)
435 (org-current-line)
436 nil))))))
437
438(defvar org-checkbox-statistics-hook nil
439 "Hook that is run whenever Org thinks checkbox statistics should be updated.
440This hook runs even if `org-provide-checkbox-statistics' is nil, to it can
441be used to implement alternative ways of collecting statistics information.")
442
47ffc456
CD
443(defun org-update-checkbox-count-maybe ()
444 "Update checkbox statistics unless turned off by user."
445 (when org-provide-checkbox-statistics
c8d0cf5c
CD
446 (org-update-checkbox-count))
447 (run-hooks 'org-checkbox-statistics-hook))
47ffc456
CD
448
449(defun org-update-checkbox-count (&optional all)
450 "Update the checkbox statistics in the current section.
451This will find all statistic cookies like [57%] and [6/12] and update them
452with the current numbers. With optional prefix argument ALL, do this for
453the whole buffer."
454 (interactive "P")
455 (save-excursion
456 (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21
457 (beg (condition-case nil
ce4fdcb9 458 (progn (org-back-to-heading) (point))
47ffc456
CD
459 (error (point-min))))
460 (end (move-marker (make-marker)
461 (progn (outline-next-heading) (point))))
462 (re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
463 (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)")
464 (re-find (concat re "\\|" re-box))
8d642074 465 beg-cookie end-cookie is-percent c-on c-off lim new
33306645 466 eline curr-ind next-ind continue-from startsearch
c8d0cf5c
CD
467 (recursive
468 (or (not org-hierarchical-checkbox-statistics)
469 (string-match "\\<recursive\\>"
ed21c5c8
CD
470 (or (ignore-errors
471 (org-entry-get nil "COOKIE_DATA"))
472 ""))))
33306645
CD
473 (cstat 0)
474 )
47ffc456
CD
475 (when all
476 (goto-char (point-min))
477 (outline-next-heading)
478 (setq beg (point) end (point-max)))
479 (goto-char end)
c8d0cf5c
CD
480 ;; find each statistics cookie
481 (while (and (re-search-backward re-find beg t)
482 (not (save-match-data
483 (and (org-on-heading-p)
484 (string-match "\\<todo\\>"
485 (downcase
486 (or (org-entry-get
487 nil "COOKIE_DATA")
488 "")))))))
47ffc456 489 (setq beg-cookie (match-beginning 1)
33306645 490 end-cookie (match-end 1)
47ffc456
CD
491 cstat (+ cstat (if end-cookie 1 0))
492 startsearch (point-at-eol)
a2a2e7fb 493 continue-from (match-beginning 0)
33306645 494 is-percent (match-beginning 2)
47ffc456
CD
495 lim (cond
496 ((org-on-heading-p) (outline-next-heading) (point))
497 ((org-at-item-p) (org-end-of-item) (point))
498 (t nil))
33306645
CD
499 c-on 0
500 c-off 0)
47ffc456 501 (when lim
33306645
CD
502 ;; find first checkbox for this cookie and gather
503 ;; statistics from all that are at this indentation level
504 (goto-char startsearch)
505 (if (re-search-forward re-box lim t)
506 (progn
507 (org-beginning-of-item)
508 (setq curr-ind (org-get-indentation))
509 (setq next-ind curr-ind)
c8d0cf5c
CD
510 (while (and (bolp) (org-at-item-p)
511 (if recursive
512 (<= curr-ind next-ind)
513 (= curr-ind next-ind)))
33306645
CD
514 (save-excursion (end-of-line) (setq eline (point)))
515 (if (re-search-forward re-box eline t)
47ffc456
CD
516 (if (member (match-string 2) '("[ ]" "[-]"))
517 (setq c-off (1+ c-off))
c8d0cf5c
CD
518 (setq c-on (1+ c-on))))
519 (if (not recursive)
520 (org-end-of-item)
521 (end-of-line)
522 (when (re-search-forward org-list-beginning-re lim t)
523 (beginning-of-line)))
524 (setq next-ind (org-get-indentation)))))
47ffc456 525 (goto-char continue-from)
33306645 526 ;; update cookie
47ffc456 527 (when end-cookie
8d642074
CD
528 (setq new (if is-percent
529 (format "[%d%%]" (/ (* 100 c-on) (max 1 (+ c-on c-off))))
530 (format "[%d/%d]" c-on (+ c-on c-off))))
47ffc456 531 (goto-char beg-cookie)
8d642074
CD
532 (insert new)
533 (delete-region (point) (+ (point) (- end-cookie beg-cookie))))
33306645
CD
534 ;; update items checkbox if it has one
535 (when (org-at-item-p)
536 (org-beginning-of-item)
537 (when (and (> (+ c-on c-off) 0)
47ffc456 538 (re-search-forward re-box (point-at-eol) t))
33306645
CD
539 (setq beg-cookie (match-beginning 2)
540 end-cookie (match-end 2))
541 (delete-region beg-cookie end-cookie)
542 (goto-char beg-cookie)
543 (cond ((= c-off 0) (insert "[X]"))
544 ((= c-on 0) (insert "[ ]"))
545 (t (insert "[-]")))
546 )))
47ffc456
CD
547 (goto-char continue-from))
548 (when (interactive-p)
33306645 549 (message "Checkbox statistics updated %s (%d places)"
47ffc456
CD
550 (if all "in entire file" "in current outline entry") cstat)))))
551
552(defun org-get-checkbox-statistics-face ()
553 "Select the face for checkbox statistics.
554The face will be `org-done' when all relevant boxes are checked. Otherwise
555it will be `org-todo'."
556 (if (match-end 1)
c8d0cf5c
CD
557 (if (equal (match-string 1) "100%")
558 'org-checkbox-statistics-done
559 'org-checkbox-statistics-todo)
47ffc456
CD
560 (if (and (> (match-end 2) (match-beginning 2))
561 (equal (match-string 2) (match-string 3)))
c8d0cf5c
CD
562 'org-checkbox-statistics-done
563 'org-checkbox-statistics-todo)))
47ffc456
CD
564
565(defun org-beginning-of-item ()
566 "Go to the beginning of the current hand-formatted item.
567If the cursor is not in an item, throw an error."
568 (interactive)
569 (let ((pos (point))
570 (limit (save-excursion
571 (condition-case nil
572 (progn
573 (org-back-to-heading)
574 (beginning-of-line 2) (point))
575 (error (point-min)))))
576 (ind-empty (if org-empty-line-terminates-plain-lists 0 10000))
577 ind ind1)
578 (if (org-at-item-p)
579 (beginning-of-line 1)
580 (beginning-of-line 1)
581 (skip-chars-forward " \t")
582 (setq ind (current-column))
583 (if (catch 'exit
584 (while t
585 (beginning-of-line 0)
586 (if (or (bobp) (< (point) limit)) (throw 'exit nil))
587
588 (if (looking-at "[ \t]*$")
589 (setq ind1 ind-empty)
590 (skip-chars-forward " \t")
591 (setq ind1 (current-column)))
592 (if (< ind1 ind)
593 (progn (beginning-of-line 1) (throw 'exit (org-at-item-p))))))
594 nil
595 (goto-char pos)
596 (error "Not in an item")))))
597
598(defun org-end-of-item ()
599 "Go to the end of the current hand-formatted item.
600If the cursor is not in an item, throw an error."
601 (interactive)
602 (let* ((pos (point))
603 ind1
604 (ind-empty (if org-empty-line-terminates-plain-lists 0 10000))
605 (limit (save-excursion (outline-next-heading) (point)))
606 (ind (save-excursion
607 (org-beginning-of-item)
608 (skip-chars-forward " \t")
609 (current-column)))
610 (end (catch 'exit
611 (while t
612 (beginning-of-line 2)
613 (if (eobp) (throw 'exit (point)))
614 (if (>= (point) limit) (throw 'exit (point-at-bol)))
615 (if (looking-at "[ \t]*$")
616 (setq ind1 ind-empty)
617 (skip-chars-forward " \t")
618 (setq ind1 (current-column)))
619 (if (<= ind1 ind)
620 (throw 'exit (point-at-bol)))))))
621 (if end
622 (goto-char end)
623 (goto-char pos)
624 (error "Not in an item"))))
625
86fbb8ca
CD
626(defun org-end-of-item-text-before-children ()
627 "Move to the end of the item text, stops before the first child if any.
628Assumes that the cursor is in the first line of an item."
629 (goto-char
630 (min (save-excursion (org-end-of-item) (point))
631 (save-excursion
632 (goto-char (point-at-eol))
633 (if (re-search-forward (concat "^" (org-item-re t)) nil 'move)
634 (match-beginning 0)
635 (point-max))))))
636
47ffc456
CD
637(defun org-next-item ()
638 "Move to the beginning of the next item in the current plain list.
639Error if not at a plain list, or if this is the last item in the list."
640 (interactive)
641 (let (ind ind1 (pos (point)))
642 (org-beginning-of-item)
643 (setq ind (org-get-indentation))
644 (org-end-of-item)
645 (setq ind1 (org-get-indentation))
646 (unless (and (org-at-item-p) (= ind ind1))
647 (goto-char pos)
648 (error "On last item"))))
649
650(defun org-previous-item ()
651 "Move to the beginning of the previous item in the current plain list.
652Error if not at a plain list, or if this is the first item in the list."
653 (interactive)
654 (let (beg ind ind1 (pos (point)))
655 (org-beginning-of-item)
656 (setq beg (point))
657 (setq ind (org-get-indentation))
658 (goto-char beg)
659 (catch 'exit
660 (while t
661 (beginning-of-line 0)
662 (if (looking-at "[ \t]*$")
663 nil
664 (if (<= (setq ind1 (org-get-indentation)) ind)
ed21c5c8
CD
665 (throw 'exit t)))
666 (if (bobp) (throw 'exit t))))
47ffc456
CD
667 (condition-case nil
668 (if (or (not (org-at-item-p))
669 (< ind1 (1- ind)))
670 (error "")
671 (org-beginning-of-item))
672 (error (goto-char pos)
673 (error "On first item")))))
674
675(defun org-first-list-item-p ()
c8d0cf5c 676 "Is this heading the first item in a plain list?"
47ffc456
CD
677 (unless (org-at-item-p)
678 (error "Not at a plain list item"))
c8d0cf5c
CD
679 (save-excursion
680 (org-beginning-of-item)
681 (= (point) (save-excursion (org-beginning-of-item-list)))))
47ffc456
CD
682
683(defun org-move-item-down ()
684 "Move the plain list item at point down, i.e. swap with following item.
685Subitems (items with larger indentation) are considered part of the item,
686so this really moves item trees."
687 (interactive)
688 (let ((col (current-column))
689 (pos (point))
690 beg beg0 end end0 ind ind1 txt ne-end ne-beg)
691 (org-beginning-of-item)
692 (setq beg0 (point))
693 (save-excursion
694 (setq ne-beg (org-back-over-empty-lines))
695 (setq beg (point)))
696 (goto-char beg0)
697 (setq ind (org-get-indentation))
698 (org-end-of-item)
699 (setq end0 (point))
700 (setq ind1 (org-get-indentation))
701 (setq ne-end (org-back-over-empty-lines))
702 (setq end (point))
703 (goto-char beg0)
704 (when (and (org-first-list-item-p) (< ne-end ne-beg))
705 ;; include less whitespace
706 (save-excursion
707 (goto-char beg)
708 (forward-line (- ne-beg ne-end))
709 (setq beg (point))))
710 (goto-char end0)
711 (if (and (org-at-item-p) (= ind ind1))
712 (progn
713 (org-end-of-item)
714 (org-back-over-empty-lines)
715 (setq txt (buffer-substring beg end))
716 (save-excursion
717 (delete-region beg end))
718 (setq pos (point))
719 (insert txt)
720 (goto-char pos) (org-skip-whitespace)
721 (org-maybe-renumber-ordered-list)
722 (move-to-column col))
723 (goto-char pos)
724 (move-to-column col)
725 (error "Cannot move this item further down"))))
726
727(defun org-move-item-up (arg)
728 "Move the plain list item at point up, i.e. swap with previous item.
729Subitems (items with larger indentation) are considered part of the item,
730so this really moves item trees."
731 (interactive "p")
732 (let ((col (current-column)) (pos (point))
733 beg beg0 end ind ind1 txt
734 ne-beg ne-ins ins-end)
735 (org-beginning-of-item)
736 (setq beg0 (point))
737 (setq ind (org-get-indentation))
738 (save-excursion
739 (setq ne-beg (org-back-over-empty-lines))
740 (setq beg (point)))
741 (goto-char beg0)
742 (org-end-of-item)
743 (org-back-over-empty-lines)
744 (setq end (point))
745 (goto-char beg0)
746 (catch 'exit
747 (while t
748 (beginning-of-line 0)
749 (if (looking-at "[ \t]*$")
750 (if org-empty-line-terminates-plain-lists
751 (progn
752 (goto-char pos)
753 (error "Cannot move this item further up"))
754 nil)
755 (if (<= (setq ind1 (org-get-indentation)) ind)
756 (throw 'exit t)))))
757 (condition-case nil
758 (org-beginning-of-item)
759 (error (goto-char beg0)
760 (move-to-column col)
761 (error "Cannot move this item further up")))
762 (setq ind1 (org-get-indentation))
763 (if (and (org-at-item-p) (= ind ind1))
764 (progn
765 (setq ne-ins (org-back-over-empty-lines))
766 (setq txt (buffer-substring beg end))
767 (save-excursion
768 (delete-region beg end))
769 (setq pos (point))
770 (insert txt)
771 (setq ins-end (point))
772 (goto-char pos) (org-skip-whitespace)
773
774 (when (and (org-first-list-item-p) (> ne-ins ne-beg))
775 ;; Move whitespace back to beginning
776 (save-excursion
777 (goto-char ins-end)
778 (let ((kill-whole-line t))
779 (kill-line (- ne-ins ne-beg)) (point)))
780 (insert (make-string (- ne-ins ne-beg) ?\n)))
781
782 (org-maybe-renumber-ordered-list)
783 (move-to-column col))
784 (goto-char pos)
785 (move-to-column col)
786 (error "Cannot move this item further up"))))
787
788(defun org-maybe-renumber-ordered-list ()
789 "Renumber the ordered list at point if setup allows it.
790This tests the user option `org-auto-renumber-ordered-lists' before
791doing the renumbering."
792 (interactive)
793 (when (and org-auto-renumber-ordered-lists
794 (org-at-item-p))
795 (if (match-beginning 3)
796 (org-renumber-ordered-list 1)
797 (org-fix-bullet-type))))
798
799(defun org-maybe-renumber-ordered-list-safe ()
800 (condition-case nil
801 (save-excursion
802 (org-maybe-renumber-ordered-list))
803 (error nil)))
804
805(defun org-cycle-list-bullet (&optional which)
806 "Cycle through the different itemize/enumerate bullets.
807This cycle the entire list level through the sequence:
808
33306645 809 `-' -> `+' -> `*' -> `1.' -> `1)'
47ffc456
CD
810
811If WHICH is a string, use that as the new bullet. If WHICH is an integer,
33306645 8120 means `-', 1 means `+' etc."
47ffc456
CD
813 (interactive "P")
814 (org-preserve-lc
815 (org-beginning-of-item-list)
816 (org-at-item-p)
817 (beginning-of-line 1)
818 (let ((current (match-string 0))
819 (prevp (eq which 'previous))
ce4fdcb9 820 new old)
47ffc456
CD
821 (setq new (cond
822 ((and (numberp which)
823 (nth (1- which) '("-" "+" "*" "1." "1)"))))
824 ((string-match "-" current) (if prevp "1)" "+"))
825 ((string-match "\\+" current)
826 (if prevp "-" (if (looking-at "\\S-") "1." "*")))
827 ((string-match "\\*" current) (if prevp "+" "1."))
ce4fdcb9
CD
828 ((string-match "\\." current)
829 (if prevp (if (looking-at "\\S-") "+" "*") "1)"))
47ffc456
CD
830 ((string-match ")" current) (if prevp "1." "-"))
831 (t (error "This should not happen"))))
ce4fdcb9
CD
832 (and (looking-at "\\([ \t]*\\)\\(\\S-+\\)")
833 (setq old (match-string 2))
834 (replace-match (concat "\\1" new)))
835 (org-shift-item-indentation (- (length new) (length old)))
47ffc456
CD
836 (org-fix-bullet-type)
837 (org-maybe-renumber-ordered-list))))
838
839(defun org-get-string-indentation (s)
840 "What indentation has S due to SPACE and TAB at the beginning of the string?"
841 (let ((n -1) (i 0) (w tab-width) c)
842 (catch 'exit
843 (while (< (setq n (1+ n)) (length s))
844 (setq c (aref s n))
845 (cond ((= c ?\ ) (setq i (1+ i)))
846 ((= c ?\t) (setq i (* (/ (+ w i) w) w)))
847 (t (throw 'exit t)))))
848 i))
849
850(defun org-renumber-ordered-list (arg)
851 "Renumber an ordered plain list.
852Cursor needs to be in the first line of an item, the line that starts
853with something like \"1.\" or \"2)\"."
854 (interactive "p")
855 (unless (and (org-at-item-p)
856 (match-beginning 3))
857 (error "This is not an ordered list"))
858 (let ((line (org-current-line))
859 (col (current-column))
860 (ind (org-get-string-indentation
861 (buffer-substring (point-at-bol) (match-beginning 3))))
862 ;; (term (substring (match-string 3) -1))
863 ind1 (n (1- arg))
8d642074 864 fmt bobp old new delta)
47ffc456
CD
865 ;; find where this list begins
866 (org-beginning-of-item-list)
867 (setq bobp (bobp))
868 (looking-at "[ \t]*[0-9]+\\([.)]\\)")
c8d0cf5c 869 (setq fmt (concat "%d" (or (match-string 1) ".")))
86fbb8ca
CD
870 (save-excursion
871 (goto-char (match-end 0))
872 (if (looking-at "[ \t]*\\[@start:\\([0-9]+\\)")
873 (setq n (1- (string-to-number (match-string 1))))))
47ffc456
CD
874 (beginning-of-line 0)
875 ;; walk forward and replace these numbers
876 (catch 'exit
877 (while t
878 (catch 'next
879 (if bobp (setq bobp nil) (beginning-of-line 2))
880 (if (eobp) (throw 'exit nil))
881 (if (looking-at "[ \t]*$") (throw 'next nil))
882 (skip-chars-forward " \t") (setq ind1 (current-column))
883 (if (> ind1 ind) (throw 'next t))
884 (if (< ind1 ind) (throw 'exit t))
885 (if (not (org-at-item-p)) (throw 'exit nil))
ce4fdcb9 886 (setq old (match-string 2))
47ffc456
CD
887 (delete-region (match-beginning 2) (match-end 2))
888 (goto-char (match-beginning 2))
ce4fdcb9 889 (insert (setq new (format fmt (setq n (1+ n)))))
8d642074
CD
890 (setq delta (- (length new) (length old)))
891 (org-shift-item-indentation delta)
892 (if (= (org-current-line) line) (setq col (+ col delta))))))
54a0dee5 893 (org-goto-line line)
47ffc456
CD
894 (org-move-to-column col)))
895
8bfe682a 896(defvar org-suppress-item-indentation) ; dynamically scoped parameter
c8d0cf5c 897(defun org-fix-bullet-type (&optional force-bullet)
ce4fdcb9
CD
898 "Make sure all items in this list have the same bullet as the first item.
899Also, fix the indentation."
47ffc456
CD
900 (interactive)
901 (unless (org-at-item-p) (error "This is not a list"))
902 (let ((line (org-current-line))
ed21c5c8 903 (chars-from-eol (- (point-at-eol) (point)))
47ffc456 904 (ind (current-indentation))
ce4fdcb9 905 ind1 bullet oldbullet)
47ffc456
CD
906 ;; find where this list begins
907 (org-beginning-of-item-list)
908 (beginning-of-line 1)
909 ;; find out what the bullet type is
910 (looking-at "[ \t]*\\(\\S-+\\)")
c8d0cf5c 911 (setq bullet (concat (or force-bullet (match-string 1)) " "))
ce4fdcb9
CD
912 (if (and org-list-two-spaces-after-bullet-regexp
913 (string-match org-list-two-spaces-after-bullet-regexp bullet))
914 (setq bullet (concat bullet " ")))
47ffc456
CD
915 ;; walk forward and replace these numbers
916 (beginning-of-line 0)
917 (catch 'exit
918 (while t
919 (catch 'next
920 (beginning-of-line 2)
921 (if (eobp) (throw 'exit nil))
922 (if (looking-at "[ \t]*$") (throw 'next nil))
923 (skip-chars-forward " \t") (setq ind1 (current-column))
924 (if (> ind1 ind) (throw 'next t))
925 (if (< ind1 ind) (throw 'exit t))
926 (if (not (org-at-item-p)) (throw 'exit nil))
927 (skip-chars-forward " \t")
ce4fdcb9
CD
928 (looking-at "\\S-+ *")
929 (setq oldbullet (match-string 0))
c8d0cf5c 930 (unless (equal bullet oldbullet) (replace-match bullet))
8bfe682a
CD
931 (org-shift-item-indentation (- (length bullet)
932 (length oldbullet))))))
54a0dee5 933 (org-goto-line line)
ed21c5c8 934 (goto-char (max (point-at-bol) (- (point-at-eol) chars-from-eol)))
47ffc456
CD
935 (if (string-match "[0-9]" bullet)
936 (org-renumber-ordered-list 1))))
937
ce4fdcb9
CD
938(defun org-shift-item-indentation (delta)
939 "Shift the indentation in current item by DELTA."
8bfe682a
CD
940 (unless (org-bound-and-true-p org-suppress-item-indentation)
941 (save-excursion
942 (let ((beg (point-at-bol))
943 (end (progn (org-end-of-item) (point)))
944 i)
945 (goto-char end)
946 (beginning-of-line 0)
947 (while (> (point) beg)
948 (when (looking-at "[ \t]*\\S-")
949 ;; this is not an empty line
950 (setq i (org-get-indentation))
951 (if (and (> i 0) (> (setq i (+ i delta)) 0))
952 (indent-line-to i)))
953 (beginning-of-line 0))))))
ce4fdcb9 954
47ffc456
CD
955(defun org-beginning-of-item-list ()
956 "Go to the beginning of the current item list.
957I.e. to the first item in this list."
958 (interactive)
959 (org-beginning-of-item)
960 (let ((pos (point-at-bol))
33306645 961 (ind (org-get-indentation))
47ffc456
CD
962 ind1)
963 ;; find where this list begins
964 (catch 'exit
965 (while t
966 (catch 'next
967 (beginning-of-line 0)
968 (if (looking-at "[ \t]*$")
969 (throw (if (bobp) 'exit 'next) t))
970 (skip-chars-forward " \t") (setq ind1 (current-column))
971 (if (or (< ind1 ind)
972 (and (= ind1 ind)
973 (not (org-at-item-p)))
974 (and (= (point-at-bol) (point-min))
975 (setq pos (point-min))))
976 (throw 'exit t)
977 (when (org-at-item-p) (setq pos (point-at-bol)))))))
978 (goto-char pos)))
979
47ffc456
CD
980(defun org-end-of-item-list ()
981 "Go to the end of the current item list.
982I.e. to the text after the last item."
983 (interactive)
984 (org-beginning-of-item)
985 (let ((pos (point-at-bol))
33306645 986 (ind (org-get-indentation))
47ffc456
CD
987 ind1)
988 ;; find where this list begins
989 (catch 'exit
990 (while t
991 (catch 'next
992 (beginning-of-line 2)
993 (if (looking-at "[ \t]*$")
c8d0cf5c
CD
994 (if (eobp)
995 (progn (setq pos (point)) (throw 'exit t))
996 (throw 'next t)))
47ffc456
CD
997 (skip-chars-forward " \t") (setq ind1 (current-column))
998 (if (or (< ind1 ind)
999 (and (= ind1 ind)
1000 (not (org-at-item-p)))
1001 (eobp))
1002 (progn
1003 (setq pos (point-at-bol))
1004 (throw 'exit t))))))
1005 (goto-char pos)))
1006
1007
1008(defvar org-last-indent-begin-marker (make-marker))
1009(defvar org-last-indent-end-marker (make-marker))
1010
1011(defun org-outdent-item (arg)
86fbb8ca 1012 "Outdent a local list item, but not its children."
47ffc456 1013 (interactive "p")
86fbb8ca 1014 (org-indent-item-tree (- arg) 'no-subtree))
47ffc456
CD
1015
1016(defun org-indent-item (arg)
86fbb8ca
CD
1017 "Indent a local list item, but not its children."
1018 (interactive "p")
1019 (org-indent-item-tree arg 'no-subtree))
1020
1021(defun org-outdent-item-tree (arg &optional no-subtree)
1022 "Outdent a local list item including its children.
1023If NO-SUBTREE is set, only outdent the item itself, not its children."
1024 (interactive "p")
1025 (org-indent-item-tree (- arg) no-subtree))
1026
1027(defun org-indent-item-tree (arg &optional no-subtree)
1028 "Indent a local list item including its children.
1029If NO-SUBTREE is set, only indent the item itself, not its children."
47ffc456 1030 (interactive "p")
c8d0cf5c 1031 (and (org-region-active-p) (org-cursor-to-region-beginning))
47ffc456
CD
1032 (unless (org-at-item-p)
1033 (error "Not on an item"))
c8d0cf5c
CD
1034 (let (beg end ind ind1 ind-bul delta ind-down ind-up firstp)
1035 (setq firstp (org-first-list-item-p))
1036 (save-excursion
1037 (setq end (and (org-region-active-p) (region-end)))
86fbb8ca
CD
1038 (if (and (memq last-command '(org-shiftmetaright org-shiftmetaleft))
1039 (memq this-command '(org-shiftmetaright org-shiftmetaleft)))
47ffc456
CD
1040 (setq beg org-last-indent-begin-marker
1041 end org-last-indent-end-marker)
1042 (org-beginning-of-item)
1043 (setq beg (move-marker org-last-indent-begin-marker (point)))
86fbb8ca
CD
1044 (if no-subtree
1045 (org-end-of-item-text-before-children)
1046 (org-end-of-item))
c8d0cf5c 1047 (setq end (move-marker org-last-indent-end-marker (or end (point)))))
47ffc456 1048 (goto-char beg)
c8d0cf5c
CD
1049 (setq ind-bul (org-item-indent-positions)
1050 ind (caar ind-bul)
1051 ind-down (car (nth 2 ind-bul))
1052 ind-up (car (nth 1 ind-bul))
47ffc456
CD
1053 delta (if (> arg 0)
1054 (if ind-down (- ind-down ind) 2)
1055 (if ind-up (- ind-up ind) -2)))
1056 (if (< (+ delta ind) 0) (error "Cannot outdent beyond margin"))
1057 (while (< (point) end)
1058 (beginning-of-line 1)
1059 (skip-chars-forward " \t") (setq ind1 (current-column))
1060 (delete-region (point-at-bol) (point))
1061 (or (eolp) (org-indent-to-column (+ ind1 delta)))
c8d0cf5c
CD
1062 (beginning-of-line 2)))
1063 (org-fix-bullet-type
1064 (and (> arg 0)
1065 (not firstp)
1066 (cdr (assoc (cdr (nth 0 ind-bul)) org-list-demote-modify-bullet))))
1067 (org-maybe-renumber-ordered-list-safe)
1068 (save-excursion
1069 (beginning-of-line 0)
1070 (condition-case nil (org-beginning-of-item) (error nil))
1071 (org-maybe-renumber-ordered-list-safe))))
47ffc456
CD
1072
1073(defun org-item-indent-positions ()
1074 "Return indentation for plain list items.
33306645
CD
1075This returns a list with three values: The current indentation, the
1076parent indentation and the indentation a child should have.
47ffc456
CD
1077Assumes cursor in item line."
1078 (let* ((bolpos (point-at-bol))
1079 (ind (org-get-indentation))
c8d0cf5c
CD
1080 (bullet (org-get-bullet))
1081 ind-down ind-up bullet-up bullet-down pos)
47ffc456
CD
1082 (save-excursion
1083 (org-beginning-of-item-list)
1084 (skip-chars-backward "\n\r \t")
1085 (when (org-in-item-p)
1086 (org-beginning-of-item)
c8d0cf5c
CD
1087 (setq ind-up (org-get-indentation))
1088 (setq bullet-up (org-get-bullet))))
47ffc456
CD
1089 (setq pos (point))
1090 (save-excursion
1091 (cond
1092 ((and (condition-case nil (progn (org-previous-item) t)
1093 (error nil))
1094 (or (forward-char 1) t)
1095 (re-search-forward "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)" bolpos t))
c8d0cf5c
CD
1096 (setq ind-down (org-get-indentation)
1097 bullet-down (org-get-bullet)))
47ffc456
CD
1098 ((and (goto-char pos)
1099 (org-at-item-p))
1100 (goto-char (match-end 0))
1101 (skip-chars-forward " \t")
c8d0cf5c
CD
1102 (setq ind-down (current-column)
1103 bullet-down (org-get-bullet)))))
1104 (if (and bullet-down (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet-down))
1105 (setq bullet-down (concat "1" (match-string 1 bullet-down))))
1106 (if (and bullet-up (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet-up))
1107 (setq bullet-up (concat "1" (match-string 1 bullet-up))))
1108 (if (and bullet (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet))
1109 (setq bullet (concat "1" (match-string 1 bullet))))
1110 (list (cons ind bullet)
1111 (cons ind-up bullet-up)
1112 (cons ind-down bullet-down))))
1113
8bfe682a
CD
1114(defvar org-tab-ind-state) ; defined in org.el
1115(defun org-cycle-item-indentation ()
1116 (let ((org-suppress-item-indentation t)
1117 (org-adapt-indentation nil))
1118 (cond
1119 ((and (looking-at "[ \t]*$")
ed21c5c8 1120 (org-looking-back "^\\([ \t]*\\)\\([-+*]\\|[0-9]+[).]\\)[ \t]+"))
8bfe682a
CD
1121 (setq this-command 'org-cycle-item-indentation)
1122 (if (eq last-command 'org-cycle-item-indentation)
1123 (condition-case nil
1124 (progn (org-outdent-item 1)
1125 (if (equal org-tab-ind-state (org-get-indentation))
1126 (org-outdent-item 1))
1127 (end-of-line 1))
1128 (error
1129 (progn
1130 (while (< (org-get-indentation) org-tab-ind-state)
1131 (progn (org-indent-item 1) (end-of-line 1)))
1132 (setq this-command 'org-cycle))))
1133 (setq org-tab-ind-state (org-get-indentation))
1134 (org-indent-item 1))
1135 t))))
1136
c8d0cf5c
CD
1137(defun org-get-bullet ()
1138 (save-excursion
1139 (goto-char (point-at-bol))
1140 (and (looking-at
1141 "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\(\\*\\)\\)\\( \\|$\\)")
1142 (or (match-string 2) (match-string 4)))))
47ffc456
CD
1143
1144;;; Send and receive lists
1145
1146(defun org-list-parse-list (&optional delete)
1147 "Parse the list at point and maybe DELETE it.
1148Return a list containing first level items as strings and
1149sublevels as a list of strings."
1150 (let* ((item-beginning (org-list-item-beginning))
33306645 1151 (start (car item-beginning))
ed21c5c8
CD
1152 (end (save-excursion
1153 (goto-char (org-list-end (cdr item-beginning)))
1154 (org-back-over-empty-lines)
1155 (point)))
33306645 1156 output itemsep ltype)
47ffc456
CD
1157 (while (re-search-forward org-list-beginning-re end t)
1158 (goto-char (match-beginning 3))
1159 (save-match-data
33306645
CD
1160 (cond ((string-match "[0-9]" (match-string 2))
1161 (setq itemsep "[0-9]+\\(?:\\.\\|)\\)"
1162 ltype 'ordered))
1163 ((string-match "^.*::" (match-string 0))
1164 (setq itemsep "[-+]" ltype 'descriptive))
1165 (t (setq itemsep "[-+]" ltype 'unordered))))
47ffc456
CD
1166 (let* ((indent1 (match-string 1))
1167 (nextitem (save-excursion
1168 (save-match-data
1169 (or (and (re-search-forward
1170 (concat "^" indent1 itemsep " *?") end t)
1171 (match-beginning 0)) end))))
1172 (item (buffer-substring
1173 (point)
86fbb8ca 1174 (or (and (org-re-search-forward-unprotected
47ffc456
CD
1175 org-list-beginning-re end t)
1176 (goto-char (match-beginning 0)))
1177 (goto-char end))))
1178 (nextindent (match-string 1))
1179 (item (org-trim item))
0bd48b37
CD
1180 (item (if (string-match "^\\[\\([xX ]\\)\\]" item)
1181 (replace-match (if (equal (match-string 1 item) " ")
1182 "[CBOFF]"
1183 "[CBON]")
1184 t nil item)
1185 item)))
47ffc456
CD
1186 (push item output)
1187 (when (> (length nextindent)
1188 (length indent1))
1189 (narrow-to-region (point) nextitem)
1190 (push (org-list-parse-list) output)
1191 (widen))))
1192 (when delete (delete-region start end))
1193 (setq output (nreverse output))
1194 (push ltype output)))
1195
1196(defun org-list-item-beginning ()
1197 "Find the beginning of the list item.
1198Return a cons which car is the beginning position of the item and
1199cdr is the indentation string."
1200 (save-excursion
1201 (if (not (or (looking-at org-list-beginning-re)
1202 (re-search-backward
1203 org-list-beginning-re nil t)))
1204 (progn (goto-char (point-min)) (point))
1205 (cons (match-beginning 0) (match-string 1)))))
1206
c8d0cf5c
CD
1207(defun org-list-goto-true-beginning ()
1208 "Go to the beginning of the list at point."
1209 (beginning-of-line 1)
1210 (while (looking-at org-list-beginning-re)
1211 (beginning-of-line 0))
1212 (progn
1213 (re-search-forward org-list-beginning-re nil t)
1214 (goto-char (match-beginning 0))))
1215
1216(defun org-list-make-subtree ()
1217 "Convert the plain list at point into a subtree."
1218 (interactive)
1219 (org-list-goto-true-beginning)
1220 (let ((list (org-list-parse-list t)) nstars)
1221 (save-excursion
1222 (if (condition-case nil
1223 (org-back-to-heading)
1224 (error nil))
1225 (progn (re-search-forward org-complex-heading-regexp nil t)
1226 (setq nstars (length (match-string 1))))
1227 (setq nstars 0)))
1228 (org-list-make-subtrees list (1+ nstars))))
1229
1230(defun org-list-make-subtrees (list level)
1231 "Convert LIST into subtrees starting at LEVEL."
1232 (if (symbolp (car list))
1233 (org-list-make-subtrees (cdr list) level)
1234 (mapcar (lambda (item)
1235 (if (stringp item)
1236 (insert (make-string
1237 (if org-odd-levels-only
1238 (1- (* 2 level)) level) ?*) " " item "\n")
1239 (org-list-make-subtrees item (1+ level))))
1240 list)))
1241
47ffc456
CD
1242(defun org-list-end (indent)
1243 "Return the position of the end of the list.
c8d0cf5c 1244INDENT is the indentation of the list, as a string."
47ffc456
CD
1245 (save-excursion
1246 (catch 'exit
1247 (while (or (looking-at org-list-beginning-re)
c8d0cf5c
CD
1248 (looking-at (concat "^" indent "[ \t]+\\|^$"))
1249 (> (or (get-text-property (point) 'original-indentation) -1)
1250 (length indent)))
47ffc456
CD
1251 (if (eq (point) (point-max))
1252 (throw 'exit (point-max)))
c8d0cf5c
CD
1253 (forward-line 1)))
1254 (point)))
47ffc456
CD
1255
1256(defun org-list-insert-radio-list ()
1257 "Insert a radio list template appropriate for this major mode."
1258 (interactive)
1259 (let* ((e (assq major-mode org-list-radio-list-templates))
1260 (txt (nth 1 e))
1261 name pos)
1262 (unless e (error "No radio list setup defined for %s" major-mode))
1263 (setq name (read-string "List name: "))
1264 (while (string-match "%n" txt)
1265 (setq txt (replace-match name t t txt)))
1266 (or (bolp) (insert "\n"))
1267 (setq pos (point))
1268 (insert txt)
1269 (goto-char pos)))
1270
1271(defun org-list-send-list (&optional maybe)
8bfe682a 1272 "Send a transformed version of this list to the receiver position.
47ffc456
CD
1273With argument MAYBE, fail quietly if no transformation is defined for
1274this list."
1275 (interactive)
1276 (catch 'exit
1277 (unless (org-at-item-p) (error "Not at a list"))
1278 (save-excursion
c8d0cf5c 1279 (org-list-goto-true-beginning)
47ffc456 1280 (beginning-of-line 0)
86fbb8ca 1281 (unless (looking-at "[ \t]*#\\+ORGLST[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?")
47ffc456
CD
1282 (if maybe
1283 (throw 'exit nil)
1284 (error "Don't know how to transform this list"))))
1285 (let* ((name (match-string 1))
47ffc456 1286 (transform (intern (match-string 2)))
8bfe682a 1287 (item-beginning (org-list-item-beginning))
86fbb8ca
CD
1288 (list (save-excursion (org-list-goto-true-beginning)
1289 (org-list-parse-list)))
1290 txt beg)
47ffc456
CD
1291 (unless (fboundp transform)
1292 (error "No such transformation function %s" transform))
86fbb8ca
CD
1293 (let ((txt (funcall transform list)))
1294 ;; Find the insertion place
1295 (save-excursion
1296 (goto-char (point-min))
1297 (unless (re-search-forward
1298 (concat "BEGIN RECEIVE ORGLST +" name "\\([ \t]\\|$\\)") nil t)
1299 (error "Don't know where to insert translated list"))
1300 (goto-char (match-beginning 0))
1301 (beginning-of-line 2)
1302 (setq beg (point))
1303 (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t)
1304 (error "Cannot find end of insertion region"))
1305 (beginning-of-line 1)
1306 (delete-region beg (point))
1307 (goto-char beg)
1308 (insert txt "\n")))
47ffc456
CD
1309 (message "List converted and installed at receiver location"))))
1310
1311(defun org-list-to-generic (list params)
1312 "Convert a LIST parsed through `org-list-parse-list' to other formats.
1313
1314Valid parameters PARAMS are
1315
33306645
CD
1316:ustart String to start an unordered list
1317:uend String to end an unordered list
47ffc456 1318
33306645
CD
1319:ostart String to start an ordered list
1320:oend String to end an ordered list
47ffc456 1321
33306645
CD
1322:dstart String to start a descriptive list
1323:dend String to end a descriptive list
47ffc456 1324:dtstart String to start a descriptive term
33306645 1325:dtend String to end a descriptive term
47ffc456 1326:ddstart String to start a description
33306645 1327:ddend String to end a description
47ffc456 1328
33306645
CD
1329:splice When set to t, return only list body lines, don't wrap
1330 them into :[u/o]start and :[u/o]end. Default is nil.
47ffc456 1331
33306645
CD
1332:istart String to start a list item
1333:iend String to end a list item
1334:isep String to separate items
0bd48b37
CD
1335:lsep String to separate sublists
1336
1337:cboff String to insert for an unchecked checkbox
1338:cbon String to insert for a checked checkbox"
47ffc456
CD
1339 (interactive)
1340 (let* ((p params) sublist
1341 (splicep (plist-get p :splice))
1342 (ostart (plist-get p :ostart))
33306645 1343 (oend (plist-get p :oend))
47ffc456 1344 (ustart (plist-get p :ustart))
33306645 1345 (uend (plist-get p :uend))
47ffc456 1346 (dstart (plist-get p :dstart))
33306645 1347 (dend (plist-get p :dend))
47ffc456 1348 (dtstart (plist-get p :dtstart))
33306645 1349 (dtend (plist-get p :dtend))
47ffc456 1350 (ddstart (plist-get p :ddstart))
33306645 1351 (ddend (plist-get p :ddend))
47ffc456 1352 (istart (plist-get p :istart))
33306645
CD
1353 (iend (plist-get p :iend))
1354 (isep (plist-get p :isep))
0bd48b37
CD
1355 (lsep (plist-get p :lsep))
1356 (cbon (plist-get p :cbon))
1357 (cboff (plist-get p :cboff)))
47ffc456
CD
1358 (let ((wrapper
1359 (cond ((eq (car list) 'ordered)
1360 (concat ostart "\n%s" oend "\n"))
1361 ((eq (car list) 'unordered)
1362 (concat ustart "\n%s" uend "\n"))
1363 ((eq (car list) 'descriptive)
1364 (concat dstart "\n%s" dend "\n"))))
1365 rtn term defstart defend)
1366 (while (setq sublist (pop list))
1367 (cond ((symbolp sublist) nil)
1368 ((stringp sublist)
33306645
CD
1369 (when (string-match "^\\(.*\\) ::" sublist)
1370 (setq term (org-trim (format (concat dtstart "%s" dtend)
1371 (match-string 1 sublist))))
1372 (setq sublist (substring sublist (1+ (length term)))))
0bd48b37
CD
1373 (if (string-match "\\[CBON\\]" sublist)
1374 (setq sublist (replace-match cbon t t sublist)))
1375 (if (string-match "\\[CBOFF\\]" sublist)
1376 (setq sublist (replace-match cboff t t sublist)))
8bfe682a
CD
1377 (if (string-match "\\[-\\]" sublist)
1378 (setq sublist (replace-match "$\\boxminus$" t t sublist)))
33306645
CD
1379 (setq rtn (concat rtn istart term ddstart
1380 sublist ddend iend isep)))
1381 (t (setq rtn (concat rtn ;; previous list
1382 lsep ;; list separator
1383 (org-list-to-generic sublist p)
1384 lsep ;; list separator
1385 )))))
47ffc456
CD
1386 (format wrapper rtn))))
1387
0bd48b37
CD
1388(defun org-list-to-latex (list &optional params)
1389 "Convert LIST into a LaTeX list.
86fbb8ca 1390LIST is as returned by `org-list-parse-list'. PARAMS is a property list
0bd48b37 1391with overruling parameters for `org-list-to-generic'."
47ffc456 1392 (org-list-to-generic
0bd48b37
CD
1393 list
1394 (org-combine-plists
1395 '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}"
1396 :ustart "\\begin{itemize}" :uend "\\end{itemize}"
1397 :dstart "\\begin{description}" :dend "\\end{description}"
1398 :dtstart "[" :dtend "]"
1399 :ddstart "" :ddend ""
1400 :istart "\\item " :iend ""
1401 :isep "\n" :lsep "\n"
1402 :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}")
1403 params)))
1404
1405(defun org-list-to-html (list &optional params)
1406 "Convert LIST into a HTML list.
86fbb8ca 1407LIST is as returned by `org-list-parse-list'. PARAMS is a property list
0bd48b37 1408with overruling parameters for `org-list-to-generic'."
47ffc456 1409 (org-list-to-generic
0bd48b37
CD
1410 list
1411 (org-combine-plists
1412 '(:splicep nil :ostart "<ol>" :oend "</ol>"
1413 :ustart "<ul>" :uend "</ul>"
1414 :dstart "<dl>" :dend "</dl>"
1415 :dtstart "<dt>" :dtend "</dt>"
1416 :ddstart "<dd>" :ddend "</dd>"
1417 :istart "<li>" :iend "</li>"
1418 :isep "\n" :lsep "\n"
1419 :cbon "<code>[X]</code>" :cboff "<code>[ ]</code>")
1420 params)))
1421
1422(defun org-list-to-texinfo (list &optional params)
1423 "Convert LIST into a Texinfo list.
86fbb8ca 1424LIST is as returned by `org-list-parse-list'. PARAMS is a property list
0bd48b37 1425with overruling parameters for `org-list-to-generic'."
47ffc456 1426 (org-list-to-generic
c8d0cf5c 1427 list
0bd48b37
CD
1428 (org-combine-plists
1429 '(:splicep nil :ostart "@itemize @minus" :oend "@end itemize"
1430 :ustart "@enumerate" :uend "@end enumerate"
1431 :dstart "@table" :dend "@end table"
1432 :dtstart "@item " :dtend "\n"
1433 :ddstart "" :ddend ""
1434 :istart "@item\n" :iend ""
1435 :isep "\n" :lsep "\n"
1436 :cbon "@code{[X]}" :cboff "@code{[ ]}")
1437 params)))
47ffc456
CD
1438
1439(provide 'org-list)
1440
3048977d 1441;; arch-tag: 73cf50c1-200f-4d1d-8a53-4e842a5b11c8
47ffc456 1442;;; org-list.el ends here