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