icalendar: uid-format, bug fixes.
[bpt/emacs.git] / lisp / org / org-list.el
CommitLineData
47ffc456
CD
1;;; org-list.el --- Plain lists for Org-mode
2;;
ae940284 3;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
47ffc456
CD
4;;
5;; Author: Carsten Dominik <carsten at orgmode dot org>
33306645 6;; Bastien Guerry <bzg AT altern DOT org>
47ffc456
CD
7;; Keywords: outlines, hypermedia, calendar, wp
8;; Homepage: http://orgmode.org
fdf730ed 9;; Version: 6.16
47ffc456
CD
10;;
11;; This file is part of GNU Emacs.
12;;
13;; GNU Emacs is free software: you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
33306645 20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
47ffc456
CD
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26;;
27;;; Commentary:
28
29;; This file contains the code dealing with plain lists in Org-mode.
30
31;;; Code:
32
33(require 'org-macs)
34(require 'org-compat)
35
36(defvar org-blank-before-new-entry)
37(defvar org-M-RET-may-split-line)
38
39(declare-function org-invisible-p "org" ())
40(declare-function org-on-heading-p "org" (&optional invisible-ok))
9fc10007
GM
41(declare-function outline-next-heading "outline" ())
42(declare-function outline-back-to-heading "outline" (&optional invisible-ok))
47ffc456
CD
43(declare-function org-back-to-heading "org" (&optional invisible-ok))
44(declare-function org-back-over-empty-lines "org" ())
45(declare-function org-skip-whitespace "org" ())
46(declare-function org-trim "org" (s))
47(declare-function org-get-indentation "org" (&optional line))
ff4be292 48(declare-function org-timer-item "org-timer" (&optional arg))
47ffc456
CD
49
50(defgroup org-plain-lists nil
51 "Options concerning plain lists in Org-mode."
52 :tag "Org Plain lists"
53 :group 'org-structure)
54
55(defcustom org-cycle-include-plain-lists nil
56 "Non-nil means, include plain lists into visibility cycling.
57This means that during cycling, plain list items will *temporarily* be
58interpreted as outline headlines with a level given by 1000+i where i is the
59indentation of the bullet. In all other operations, plain list items are
33306645 60not seen as headlines. For example, you cannot assign a TODO keyword to
47ffc456
CD
61such an item."
62 :group 'org-plain-lists
63 :type 'boolean)
64
65(defcustom org-plain-list-ordered-item-terminator t
66 "The character that makes a line with leading number an ordered list item.
67Valid values are ?. and ?\). To get both terminators, use t. While
68?. may look nicer, it creates the danger that a line with leading
69number may be incorrectly interpreted as an item. ?\) therefore is
70the safe choice."
71 :group 'org-plain-lists
72 :type '(choice (const :tag "dot like in \"2.\"" ?.)
73 (const :tag "paren like in \"2)\"" ?\))
74 (const :tab "both" t)))
75
ce4fdcb9
CD
76(defcustom org-list-two-spaces-after-bullet-regexp nil
77 "A regular expression matching bullets that should have 2 spaces after them.
78When nil, no bullet will have two spaces after them.
33306645 79When a string, it will be used as a regular expression. When the bullet
ce4fdcb9 80type of a list is changed, the new bullet type will be matched against this
33306645 81regexp. If it matches, there will be two spaces instead of one after
ce4fdcb9
CD
82the bullet in each item of he list."
83 :group 'org-plain-list
84 :type '(choice
85 (const :tag "never" nil)
86 (regexp)))
87
47ffc456
CD
88(defcustom org-empty-line-terminates-plain-lists nil
89 "Non-nil means, an empty line ends all plain list levels.
90When nil, empty lines are part of the preceeding item."
91 :group 'org-plain-lists
92 :type 'boolean)
93
94(defcustom org-auto-renumber-ordered-lists t
95 "Non-nil means, automatically renumber ordered plain lists.
96Renumbering happens when the sequence have been changed with
97\\[org-shiftmetaup] or \\[org-shiftmetadown]. After other editing commands,
98use \\[org-ctrl-c-ctrl-c] to trigger renumbering."
99 :group 'org-plain-lists
100 :type 'boolean)
101
102(defcustom org-provide-checkbox-statistics t
103 "Non-nil means, update checkbox statistics after insert and toggle.
104When this is set, checkbox statistics is updated each time you either insert
105a new checkbox with \\[org-insert-todo-heading] or toggle a checkbox
106with \\[org-ctrl-c-ctrl-c\\]."
107 :group 'org-plain-lists
108 :type 'boolean)
109
110(defcustom org-description-max-indent 20
111 "Maximum indentation for the second line of a description list.
112When the indentation would be larger than this, it will become
1135 characters instead."
114 :group 'org-plain-lists
115 :type 'integer)
116
117(defvar org-list-beginning-re
118 "^\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) +\\(.*\\)$")
119
120(defcustom org-list-radio-list-templates
121 '((latex-mode "% BEGIN RECEIVE ORGLST %n
122% END RECEIVE ORGLST %n
123\\begin{comment}
124#+ORGLST: SEND %n org-list-to-latex
125| | |
126\\end{comment}\n")
127 (texinfo-mode "@c BEGIN RECEIVE ORGLST %n
128@c END RECEIVE ORGLST %n
129@ignore
130#+ORGLST: SEND %n org-list-to-texinfo
131| | |
132@end ignore\n")
133 (html-mode "<!-- BEGIN RECEIVE ORGLST %n -->
134<!-- END RECEIVE ORGLST %n -->
135<!--
136#+ORGLST: SEND %n org-list-to-html
137| | |
138-->\n"))
139 "Templates for radio lists in different major modes.
140All occurrences of %n in a template will be replaced with the name of the
141list, obtained by prompting the user."
142 :group 'org-plain-lists
143 :type '(repeat
144 (list (symbol :tag "Major mode")
145 (string :tag "Format"))))
146
147;;;; Plain list items, including checkboxes
148
149;;; Plain list items
150
151(defun org-at-item-p ()
152 "Is point in a line starting a hand-formatted item?"
153 (let ((llt org-plain-list-ordered-item-terminator))
154 (save-excursion
155 (goto-char (point-at-bol))
156 (looking-at
157 (cond
158 ((eq llt t) "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
159 ((= llt ?.) "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
160 ((= llt ?\)) "\\([ \t]*\\([-+]\\|\\([0-9]+))\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
161 (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))))))
162
163(defun org-in-item-p ()
164 "It the cursor inside a plain list item.
165Does not have to be the first line."
166 (save-excursion
167 (condition-case nil
168 (progn
169 (org-beginning-of-item)
170 (org-at-item-p)
171 t)
172 (error nil))))
173
174(defun org-insert-item (&optional checkbox)
175 "Insert a new item at the current level.
176Return t when things worked, nil when we are not in an item."
177 (when (save-excursion
178 (condition-case nil
179 (progn
180 (org-beginning-of-item)
181 (org-at-item-p)
182 (if (org-invisible-p) (error "Invisible item"))
183 t)
184 (error nil)))
185 (let* ((bul (match-string 0))
186 (descp (save-excursion (goto-char (match-beginning 0))
187 (beginning-of-line 1)
188 (save-match-data
ff4be292
CD
189 (and (looking-at "[ \t]*\\(.*?\\) ::")
190 (match-string 1)))))
191 (timerp (and descp
192 (save-match-data
193 (string-match "^[-+*][ \t]+[0-9]+:[0-9]+:[0-9]+$"
194 descp))))
47ffc456
CD
195 (eow (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")
196 (match-end 0)))
197 (blank (cdr (assq 'plain-list-item org-blank-before-new-entry)))
198 pos)
199 (if descp (setq checkbox nil))
ff4be292
CD
200 (if timerp
201 (progn (org-timer-item) t)
202 (cond
203 ((and (org-at-item-p) (<= (point) eow))
204 ;; before the bullet
205 (beginning-of-line 1)
206 (open-line (if blank 2 1)))
207 ((<= (point) eow)
208 (beginning-of-line 1))
209 (t
210 (unless (org-get-alist-option org-M-RET-may-split-line 'item)
211 (end-of-line 1)
212 (delete-horizontal-space))
213 (newline (if blank 2 1))))
214 (insert bul
215 (if checkbox "[ ]" "")
216 (if descp (concat (if checkbox " " "")
217 (read-string "Term: ") " :: ") ""))
218 (just-one-space)
219 (setq pos (point))
220 (end-of-line 1)
221 (unless (= (point) pos) (just-one-space) (backward-delete-char 1)))
222 (org-maybe-renumber-ordered-list)
223 (and checkbox (org-update-checkbox-count-maybe))
224 t)))
47ffc456
CD
225
226;;; Checkboxes
227
228(defun org-at-item-checkbox-p ()
229 "Is point at a line starting a plain-list item with a checklet?"
230 (and (org-at-item-p)
231 (save-excursion
232 (goto-char (match-end 0))
233 (skip-chars-forward " \t")
234 (looking-at "\\[[- X]\\]"))))
235
236(defun org-toggle-checkbox (&optional arg)
237 "Toggle the checkbox in the current line."
238 (interactive "P")
239 (catch 'exit
240 (let (beg end status (firstnew 'unknown))
241 (cond
242 ((org-region-active-p)
243 (setq beg (region-beginning) end (region-end)))
244 ((org-on-heading-p)
245 (setq beg (point) end (save-excursion (outline-next-heading) (point))))
246 ((org-at-item-checkbox-p)
247 (let ((pos (point)))
248 (replace-match
249 (cond (arg "[-]")
250 ((member (match-string 0) '("[ ]" "[-]")) "[X]")
251 (t "[ ]"))
252 t t)
253 (goto-char pos))
254 (throw 'exit t))
255 (t (error "Not at a checkbox or heading, and no active region")))
256 (save-excursion
257 (goto-char beg)
258 (while (< (point) end)
259 (when (org-at-item-checkbox-p)
260 (setq status (equal (match-string 0) "[X]"))
261 (when (eq firstnew 'unknown)
262 (setq firstnew (not status)))
263 (replace-match
264 (if (if arg (not status) firstnew) "[X]" "[ ]") t t))
265 (beginning-of-line 2)))))
266 (org-update-checkbox-count-maybe))
267
268(defun org-update-checkbox-count-maybe ()
269 "Update checkbox statistics unless turned off by user."
270 (when org-provide-checkbox-statistics
271 (org-update-checkbox-count)))
272
273(defun org-update-checkbox-count (&optional all)
274 "Update the checkbox statistics in the current section.
275This will find all statistic cookies like [57%] and [6/12] and update them
276with the current numbers. With optional prefix argument ALL, do this for
277the whole buffer."
278 (interactive "P")
279 (save-excursion
280 (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21
281 (beg (condition-case nil
ce4fdcb9 282 (progn (org-back-to-heading) (point))
47ffc456
CD
283 (error (point-min))))
284 (end (move-marker (make-marker)
285 (progn (outline-next-heading) (point))))
286 (re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
287 (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)")
288 (re-find (concat re "\\|" re-box))
289 beg-cookie end-cookie is-percent c-on c-off lim
33306645
CD
290 eline curr-ind next-ind continue-from startsearch
291 (cstat 0)
292 )
47ffc456
CD
293 (when all
294 (goto-char (point-min))
295 (outline-next-heading)
296 (setq beg (point) end (point-max)))
297 (goto-char end)
298 ;; find each statistic cookie
299 (while (re-search-backward re-find beg t)
300 (setq beg-cookie (match-beginning 1)
33306645 301 end-cookie (match-end 1)
47ffc456
CD
302 cstat (+ cstat (if end-cookie 1 0))
303 startsearch (point-at-eol)
304 continue-from (point-at-bol)
33306645 305 is-percent (match-beginning 2)
47ffc456
CD
306 lim (cond
307 ((org-on-heading-p) (outline-next-heading) (point))
308 ((org-at-item-p) (org-end-of-item) (point))
309 (t nil))
33306645
CD
310 c-on 0
311 c-off 0)
47ffc456 312 (when lim
33306645
CD
313 ;; find first checkbox for this cookie and gather
314 ;; statistics from all that are at this indentation level
315 (goto-char startsearch)
316 (if (re-search-forward re-box lim t)
317 (progn
318 (org-beginning-of-item)
319 (setq curr-ind (org-get-indentation))
320 (setq next-ind curr-ind)
321 (while (and (bolp) (org-at-item-p) (= curr-ind next-ind))
322 (save-excursion (end-of-line) (setq eline (point)))
323 (if (re-search-forward re-box eline t)
47ffc456
CD
324 (if (member (match-string 2) '("[ ]" "[-]"))
325 (setq c-off (1+ c-off))
33306645
CD
326 (setq c-on (1+ c-on))
327 )
328 )
329 (org-end-of-item)
330 (setq next-ind (org-get-indentation))
331 )))
47ffc456 332 (goto-char continue-from)
33306645 333 ;; update cookie
47ffc456
CD
334 (when end-cookie
335 (delete-region beg-cookie end-cookie)
336 (goto-char beg-cookie)
337 (insert
338 (if is-percent
339 (format "[%d%%]" (/ (* 100 c-on) (max 1 (+ c-on c-off))))
340 (format "[%d/%d]" c-on (+ c-on c-off)))))
33306645
CD
341 ;; update items checkbox if it has one
342 (when (org-at-item-p)
343 (org-beginning-of-item)
344 (when (and (> (+ c-on c-off) 0)
47ffc456 345 (re-search-forward re-box (point-at-eol) t))
33306645
CD
346 (setq beg-cookie (match-beginning 2)
347 end-cookie (match-end 2))
348 (delete-region beg-cookie end-cookie)
349 (goto-char beg-cookie)
350 (cond ((= c-off 0) (insert "[X]"))
351 ((= c-on 0) (insert "[ ]"))
352 (t (insert "[-]")))
353 )))
47ffc456
CD
354 (goto-char continue-from))
355 (when (interactive-p)
33306645 356 (message "Checkbox statistics updated %s (%d places)"
47ffc456
CD
357 (if all "in entire file" "in current outline entry") cstat)))))
358
359(defun org-get-checkbox-statistics-face ()
360 "Select the face for checkbox statistics.
361The face will be `org-done' when all relevant boxes are checked. Otherwise
362it will be `org-todo'."
363 (if (match-end 1)
364 (if (equal (match-string 1) "100%") 'org-done 'org-todo)
365 (if (and (> (match-end 2) (match-beginning 2))
366 (equal (match-string 2) (match-string 3)))
367 'org-done
368 'org-todo)))
369
370(defun org-beginning-of-item ()
371 "Go to the beginning of the current hand-formatted item.
372If the cursor is not in an item, throw an error."
373 (interactive)
374 (let ((pos (point))
375 (limit (save-excursion
376 (condition-case nil
377 (progn
378 (org-back-to-heading)
379 (beginning-of-line 2) (point))
380 (error (point-min)))))
381 (ind-empty (if org-empty-line-terminates-plain-lists 0 10000))
382 ind ind1)
383 (if (org-at-item-p)
384 (beginning-of-line 1)
385 (beginning-of-line 1)
386 (skip-chars-forward " \t")
387 (setq ind (current-column))
388 (if (catch 'exit
389 (while t
390 (beginning-of-line 0)
391 (if (or (bobp) (< (point) limit)) (throw 'exit nil))
392
393 (if (looking-at "[ \t]*$")
394 (setq ind1 ind-empty)
395 (skip-chars-forward " \t")
396 (setq ind1 (current-column)))
397 (if (< ind1 ind)
398 (progn (beginning-of-line 1) (throw 'exit (org-at-item-p))))))
399 nil
400 (goto-char pos)
401 (error "Not in an item")))))
402
403(defun org-end-of-item ()
404 "Go to the end of the current hand-formatted item.
405If the cursor is not in an item, throw an error."
406 (interactive)
407 (let* ((pos (point))
408 ind1
409 (ind-empty (if org-empty-line-terminates-plain-lists 0 10000))
410 (limit (save-excursion (outline-next-heading) (point)))
411 (ind (save-excursion
412 (org-beginning-of-item)
413 (skip-chars-forward " \t")
414 (current-column)))
415 (end (catch 'exit
416 (while t
417 (beginning-of-line 2)
418 (if (eobp) (throw 'exit (point)))
419 (if (>= (point) limit) (throw 'exit (point-at-bol)))
420 (if (looking-at "[ \t]*$")
421 (setq ind1 ind-empty)
422 (skip-chars-forward " \t")
423 (setq ind1 (current-column)))
424 (if (<= ind1 ind)
425 (throw 'exit (point-at-bol)))))))
426 (if end
427 (goto-char end)
428 (goto-char pos)
429 (error "Not in an item"))))
430
431(defun org-next-item ()
432 "Move to the beginning of the next item in the current plain list.
433Error if not at a plain list, or if this is the last item in the list."
434 (interactive)
435 (let (ind ind1 (pos (point)))
436 (org-beginning-of-item)
437 (setq ind (org-get-indentation))
438 (org-end-of-item)
439 (setq ind1 (org-get-indentation))
440 (unless (and (org-at-item-p) (= ind ind1))
441 (goto-char pos)
442 (error "On last item"))))
443
444(defun org-previous-item ()
445 "Move to the beginning of the previous item in the current plain list.
446Error if not at a plain list, or if this is the first item in the list."
447 (interactive)
448 (let (beg ind ind1 (pos (point)))
449 (org-beginning-of-item)
450 (setq beg (point))
451 (setq ind (org-get-indentation))
452 (goto-char beg)
453 (catch 'exit
454 (while t
455 (beginning-of-line 0)
456 (if (looking-at "[ \t]*$")
457 nil
458 (if (<= (setq ind1 (org-get-indentation)) ind)
459 (throw 'exit t)))))
460 (condition-case nil
461 (if (or (not (org-at-item-p))
462 (< ind1 (1- ind)))
463 (error "")
464 (org-beginning-of-item))
465 (error (goto-char pos)
466 (error "On first item")))))
467
468(defun org-first-list-item-p ()
469 "Is this heading the item in a plain list?"
470 (unless (org-at-item-p)
471 (error "Not at a plain list item"))
472 (org-beginning-of-item)
473 (= (point) (save-excursion (org-beginning-of-item-list))))
474
475(defun org-move-item-down ()
476 "Move the plain list item at point down, i.e. swap with following item.
477Subitems (items with larger indentation) are considered part of the item,
478so this really moves item trees."
479 (interactive)
480 (let ((col (current-column))
481 (pos (point))
482 beg beg0 end end0 ind ind1 txt ne-end ne-beg)
483 (org-beginning-of-item)
484 (setq beg0 (point))
485 (save-excursion
486 (setq ne-beg (org-back-over-empty-lines))
487 (setq beg (point)))
488 (goto-char beg0)
489 (setq ind (org-get-indentation))
490 (org-end-of-item)
491 (setq end0 (point))
492 (setq ind1 (org-get-indentation))
493 (setq ne-end (org-back-over-empty-lines))
494 (setq end (point))
495 (goto-char beg0)
496 (when (and (org-first-list-item-p) (< ne-end ne-beg))
497 ;; include less whitespace
498 (save-excursion
499 (goto-char beg)
500 (forward-line (- ne-beg ne-end))
501 (setq beg (point))))
502 (goto-char end0)
503 (if (and (org-at-item-p) (= ind ind1))
504 (progn
505 (org-end-of-item)
506 (org-back-over-empty-lines)
507 (setq txt (buffer-substring beg end))
508 (save-excursion
509 (delete-region beg end))
510 (setq pos (point))
511 (insert txt)
512 (goto-char pos) (org-skip-whitespace)
513 (org-maybe-renumber-ordered-list)
514 (move-to-column col))
515 (goto-char pos)
516 (move-to-column col)
517 (error "Cannot move this item further down"))))
518
519(defun org-move-item-up (arg)
520 "Move the plain list item at point up, i.e. swap with previous item.
521Subitems (items with larger indentation) are considered part of the item,
522so this really moves item trees."
523 (interactive "p")
524 (let ((col (current-column)) (pos (point))
525 beg beg0 end ind ind1 txt
526 ne-beg ne-ins ins-end)
527 (org-beginning-of-item)
528 (setq beg0 (point))
529 (setq ind (org-get-indentation))
530 (save-excursion
531 (setq ne-beg (org-back-over-empty-lines))
532 (setq beg (point)))
533 (goto-char beg0)
534 (org-end-of-item)
535 (org-back-over-empty-lines)
536 (setq end (point))
537 (goto-char beg0)
538 (catch 'exit
539 (while t
540 (beginning-of-line 0)
541 (if (looking-at "[ \t]*$")
542 (if org-empty-line-terminates-plain-lists
543 (progn
544 (goto-char pos)
545 (error "Cannot move this item further up"))
546 nil)
547 (if (<= (setq ind1 (org-get-indentation)) ind)
548 (throw 'exit t)))))
549 (condition-case nil
550 (org-beginning-of-item)
551 (error (goto-char beg0)
552 (move-to-column col)
553 (error "Cannot move this item further up")))
554 (setq ind1 (org-get-indentation))
555 (if (and (org-at-item-p) (= ind ind1))
556 (progn
557 (setq ne-ins (org-back-over-empty-lines))
558 (setq txt (buffer-substring beg end))
559 (save-excursion
560 (delete-region beg end))
561 (setq pos (point))
562 (insert txt)
563 (setq ins-end (point))
564 (goto-char pos) (org-skip-whitespace)
565
566 (when (and (org-first-list-item-p) (> ne-ins ne-beg))
567 ;; Move whitespace back to beginning
568 (save-excursion
569 (goto-char ins-end)
570 (let ((kill-whole-line t))
571 (kill-line (- ne-ins ne-beg)) (point)))
572 (insert (make-string (- ne-ins ne-beg) ?\n)))
573
574 (org-maybe-renumber-ordered-list)
575 (move-to-column col))
576 (goto-char pos)
577 (move-to-column col)
578 (error "Cannot move this item further up"))))
579
580(defun org-maybe-renumber-ordered-list ()
581 "Renumber the ordered list at point if setup allows it.
582This tests the user option `org-auto-renumber-ordered-lists' before
583doing the renumbering."
584 (interactive)
585 (when (and org-auto-renumber-ordered-lists
586 (org-at-item-p))
587 (if (match-beginning 3)
588 (org-renumber-ordered-list 1)
589 (org-fix-bullet-type))))
590
591(defun org-maybe-renumber-ordered-list-safe ()
592 (condition-case nil
593 (save-excursion
594 (org-maybe-renumber-ordered-list))
595 (error nil)))
596
597(defun org-cycle-list-bullet (&optional which)
598 "Cycle through the different itemize/enumerate bullets.
599This cycle the entire list level through the sequence:
600
33306645 601 `-' -> `+' -> `*' -> `1.' -> `1)'
47ffc456
CD
602
603If WHICH is a string, use that as the new bullet. If WHICH is an integer,
33306645 6040 means `-', 1 means `+' etc."
47ffc456
CD
605 (interactive "P")
606 (org-preserve-lc
607 (org-beginning-of-item-list)
608 (org-at-item-p)
609 (beginning-of-line 1)
610 (let ((current (match-string 0))
611 (prevp (eq which 'previous))
ce4fdcb9 612 new old)
47ffc456
CD
613 (setq new (cond
614 ((and (numberp which)
615 (nth (1- which) '("-" "+" "*" "1." "1)"))))
616 ((string-match "-" current) (if prevp "1)" "+"))
617 ((string-match "\\+" current)
618 (if prevp "-" (if (looking-at "\\S-") "1." "*")))
619 ((string-match "\\*" current) (if prevp "+" "1."))
ce4fdcb9
CD
620 ((string-match "\\." current)
621 (if prevp (if (looking-at "\\S-") "+" "*") "1)"))
47ffc456
CD
622 ((string-match ")" current) (if prevp "1." "-"))
623 (t (error "This should not happen"))))
ce4fdcb9
CD
624 (and (looking-at "\\([ \t]*\\)\\(\\S-+\\)")
625 (setq old (match-string 2))
626 (replace-match (concat "\\1" new)))
627 (org-shift-item-indentation (- (length new) (length old)))
47ffc456
CD
628 (org-fix-bullet-type)
629 (org-maybe-renumber-ordered-list))))
630
631(defun org-get-string-indentation (s)
632 "What indentation has S due to SPACE and TAB at the beginning of the string?"
633 (let ((n -1) (i 0) (w tab-width) c)
634 (catch 'exit
635 (while (< (setq n (1+ n)) (length s))
636 (setq c (aref s n))
637 (cond ((= c ?\ ) (setq i (1+ i)))
638 ((= c ?\t) (setq i (* (/ (+ w i) w) w)))
639 (t (throw 'exit t)))))
640 i))
641
642(defun org-renumber-ordered-list (arg)
643 "Renumber an ordered plain list.
644Cursor needs to be in the first line of an item, the line that starts
645with something like \"1.\" or \"2)\"."
646 (interactive "p")
647 (unless (and (org-at-item-p)
648 (match-beginning 3))
649 (error "This is not an ordered list"))
650 (let ((line (org-current-line))
651 (col (current-column))
652 (ind (org-get-string-indentation
653 (buffer-substring (point-at-bol) (match-beginning 3))))
654 ;; (term (substring (match-string 3) -1))
655 ind1 (n (1- arg))
ce4fdcb9 656 fmt bobp old new)
47ffc456
CD
657 ;; find where this list begins
658 (org-beginning-of-item-list)
659 (setq bobp (bobp))
660 (looking-at "[ \t]*[0-9]+\\([.)]\\)")
661 (setq fmt (concat "%d" (match-string 1)))
662 (beginning-of-line 0)
663 ;; walk forward and replace these numbers
664 (catch 'exit
665 (while t
666 (catch 'next
667 (if bobp (setq bobp nil) (beginning-of-line 2))
668 (if (eobp) (throw 'exit nil))
669 (if (looking-at "[ \t]*$") (throw 'next nil))
670 (skip-chars-forward " \t") (setq ind1 (current-column))
671 (if (> ind1 ind) (throw 'next t))
672 (if (< ind1 ind) (throw 'exit t))
673 (if (not (org-at-item-p)) (throw 'exit nil))
ce4fdcb9 674 (setq old (match-string 2))
47ffc456
CD
675 (delete-region (match-beginning 2) (match-end 2))
676 (goto-char (match-beginning 2))
ce4fdcb9
CD
677 (insert (setq new (format fmt (setq n (1+ n)))))
678 (org-shift-item-indentation (- (length new) (length old))))))
47ffc456
CD
679 (goto-line line)
680 (org-move-to-column col)))
681
682(defun org-fix-bullet-type ()
ce4fdcb9
CD
683 "Make sure all items in this list have the same bullet as the first item.
684Also, fix the indentation."
47ffc456
CD
685 (interactive)
686 (unless (org-at-item-p) (error "This is not a list"))
687 (let ((line (org-current-line))
688 (col (current-column))
689 (ind (current-indentation))
ce4fdcb9 690 ind1 bullet oldbullet)
47ffc456
CD
691 ;; find where this list begins
692 (org-beginning-of-item-list)
693 (beginning-of-line 1)
694 ;; find out what the bullet type is
695 (looking-at "[ \t]*\\(\\S-+\\)")
ce4fdcb9
CD
696 (setq bullet (concat (match-string 1) " "))
697 (if (and org-list-two-spaces-after-bullet-regexp
698 (string-match org-list-two-spaces-after-bullet-regexp bullet))
699 (setq bullet (concat bullet " ")))
47ffc456
CD
700 ;; walk forward and replace these numbers
701 (beginning-of-line 0)
702 (catch 'exit
703 (while t
704 (catch 'next
705 (beginning-of-line 2)
706 (if (eobp) (throw 'exit nil))
707 (if (looking-at "[ \t]*$") (throw 'next nil))
708 (skip-chars-forward " \t") (setq ind1 (current-column))
709 (if (> ind1 ind) (throw 'next t))
710 (if (< ind1 ind) (throw 'exit t))
711 (if (not (org-at-item-p)) (throw 'exit nil))
712 (skip-chars-forward " \t")
ce4fdcb9
CD
713 (looking-at "\\S-+ *")
714 (setq oldbullet (match-string 0))
715 (replace-match bullet)
716 (org-shift-item-indentation (- (length bullet) (length oldbullet))))))
47ffc456
CD
717 (goto-line line)
718 (org-move-to-column col)
719 (if (string-match "[0-9]" bullet)
720 (org-renumber-ordered-list 1))))
721
ce4fdcb9
CD
722(defun org-shift-item-indentation (delta)
723 "Shift the indentation in current item by DELTA."
724 (save-excursion
725 (let ((beg (point-at-bol))
726 (end (progn (org-end-of-item) (point)))
727 i)
728 (goto-char end)
729 (beginning-of-line 0)
730 (while (> (point) beg)
731 (when (looking-at "[ \t]*\\S-")
732 ;; this is not an empty line
733 (setq i (org-get-indentation))
734 (if (and (> i 0) (> (setq i (+ i delta)) 0))
735 (indent-line-to i)))
736 (beginning-of-line 0)))))
737
47ffc456
CD
738(defun org-beginning-of-item-list ()
739 "Go to the beginning of the current item list.
740I.e. to the first item in this list."
741 (interactive)
742 (org-beginning-of-item)
743 (let ((pos (point-at-bol))
33306645 744 (ind (org-get-indentation))
47ffc456
CD
745 ind1)
746 ;; find where this list begins
747 (catch 'exit
748 (while t
749 (catch 'next
750 (beginning-of-line 0)
751 (if (looking-at "[ \t]*$")
752 (throw (if (bobp) 'exit 'next) t))
753 (skip-chars-forward " \t") (setq ind1 (current-column))
754 (if (or (< ind1 ind)
755 (and (= ind1 ind)
756 (not (org-at-item-p)))
757 (and (= (point-at-bol) (point-min))
758 (setq pos (point-min))))
759 (throw 'exit t)
760 (when (org-at-item-p) (setq pos (point-at-bol)))))))
761 (goto-char pos)))
762
763
764(defun org-end-of-item-list ()
765 "Go to the end of the current item list.
766I.e. to the text after the last item."
767 (interactive)
768 (org-beginning-of-item)
769 (let ((pos (point-at-bol))
33306645 770 (ind (org-get-indentation))
47ffc456
CD
771 ind1)
772 ;; find where this list begins
773 (catch 'exit
774 (while t
775 (catch 'next
776 (beginning-of-line 2)
777 (if (looking-at "[ \t]*$")
778 (throw (if (eobp) 'exit 'next) t))
779 (skip-chars-forward " \t") (setq ind1 (current-column))
780 (if (or (< ind1 ind)
781 (and (= ind1 ind)
782 (not (org-at-item-p)))
783 (eobp))
784 (progn
785 (setq pos (point-at-bol))
786 (throw 'exit t))))))
787 (goto-char pos)))
788
789
790(defvar org-last-indent-begin-marker (make-marker))
791(defvar org-last-indent-end-marker (make-marker))
792
793(defun org-outdent-item (arg)
794 "Outdent a local list item."
795 (interactive "p")
796 (org-indent-item (- arg)))
797
798(defun org-indent-item (arg)
799 "Indent a local list item."
800 (interactive "p")
801 (unless (org-at-item-p)
802 (error "Not on an item"))
803 (save-excursion
804 (let (beg end ind ind1 tmp delta ind-down ind-up)
805 (if (memq last-command '(org-shiftmetaright org-shiftmetaleft))
806 (setq beg org-last-indent-begin-marker
807 end org-last-indent-end-marker)
808 (org-beginning-of-item)
809 (setq beg (move-marker org-last-indent-begin-marker (point)))
810 (org-end-of-item)
811 (setq end (move-marker org-last-indent-end-marker (point))))
812 (goto-char beg)
813 (setq tmp (org-item-indent-positions)
814 ind (car tmp)
815 ind-down (nth 2 tmp)
816 ind-up (nth 1 tmp)
817 delta (if (> arg 0)
818 (if ind-down (- ind-down ind) 2)
819 (if ind-up (- ind-up ind) -2)))
820 (if (< (+ delta ind) 0) (error "Cannot outdent beyond margin"))
821 (while (< (point) end)
822 (beginning-of-line 1)
823 (skip-chars-forward " \t") (setq ind1 (current-column))
824 (delete-region (point-at-bol) (point))
825 (or (eolp) (org-indent-to-column (+ ind1 delta)))
826 (beginning-of-line 2))))
827 (org-fix-bullet-type)
828 (org-maybe-renumber-ordered-list-safe)
829 (save-excursion
830 (beginning-of-line 0)
831 (condition-case nil (org-beginning-of-item) (error nil))
832 (org-maybe-renumber-ordered-list-safe)))
833
834(defun org-item-indent-positions ()
835 "Return indentation for plain list items.
33306645
CD
836This returns a list with three values: The current indentation, the
837parent indentation and the indentation a child should have.
47ffc456
CD
838Assumes cursor in item line."
839 (let* ((bolpos (point-at-bol))
840 (ind (org-get-indentation))
841 ind-down ind-up pos)
842 (save-excursion
843 (org-beginning-of-item-list)
844 (skip-chars-backward "\n\r \t")
845 (when (org-in-item-p)
846 (org-beginning-of-item)
847 (setq ind-up (org-get-indentation))))
848 (setq pos (point))
849 (save-excursion
850 (cond
851 ((and (condition-case nil (progn (org-previous-item) t)
852 (error nil))
853 (or (forward-char 1) t)
854 (re-search-forward "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)" bolpos t))
855 (setq ind-down (org-get-indentation)))
856 ((and (goto-char pos)
857 (org-at-item-p))
858 (goto-char (match-end 0))
859 (skip-chars-forward " \t")
860 (setq ind-down (current-column)))))
861 (list ind ind-up ind-down)))
862
863
864;;; Send and receive lists
865
866(defun org-list-parse-list (&optional delete)
867 "Parse the list at point and maybe DELETE it.
868Return a list containing first level items as strings and
869sublevels as a list of strings."
870 (let* ((item-beginning (org-list-item-beginning))
33306645
CD
871 (start (car item-beginning))
872 (end (org-list-end (cdr item-beginning)))
873 output itemsep ltype)
47ffc456
CD
874 (while (re-search-forward org-list-beginning-re end t)
875 (goto-char (match-beginning 3))
876 (save-match-data
33306645
CD
877 (cond ((string-match "[0-9]" (match-string 2))
878 (setq itemsep "[0-9]+\\(?:\\.\\|)\\)"
879 ltype 'ordered))
880 ((string-match "^.*::" (match-string 0))
881 (setq itemsep "[-+]" ltype 'descriptive))
882 (t (setq itemsep "[-+]" ltype 'unordered))))
47ffc456
CD
883 (let* ((indent1 (match-string 1))
884 (nextitem (save-excursion
885 (save-match-data
886 (or (and (re-search-forward
887 (concat "^" indent1 itemsep " *?") end t)
888 (match-beginning 0)) end))))
889 (item (buffer-substring
890 (point)
891 (or (and (re-search-forward
892 org-list-beginning-re end t)
893 (goto-char (match-beginning 0)))
894 (goto-char end))))
895 (nextindent (match-string 1))
896 (item (org-trim item))
897 (item (if (string-match "^\\[.+\\]" item)
898 (replace-match "\\\\texttt{\\&}"
899 t nil item) item)))
900 (push item output)
901 (when (> (length nextindent)
902 (length indent1))
903 (narrow-to-region (point) nextitem)
904 (push (org-list-parse-list) output)
905 (widen))))
906 (when delete (delete-region start end))
907 (setq output (nreverse output))
908 (push ltype output)))
909
910(defun org-list-item-beginning ()
911 "Find the beginning of the list item.
912Return a cons which car is the beginning position of the item and
913cdr is the indentation string."
914 (save-excursion
915 (if (not (or (looking-at org-list-beginning-re)
916 (re-search-backward
917 org-list-beginning-re nil t)))
918 (progn (goto-char (point-min)) (point))
919 (cons (match-beginning 0) (match-string 1)))))
920
921(defun org-list-end (indent)
922 "Return the position of the end of the list.
923INDENT is the indentation of the list."
924 (save-excursion
925 (catch 'exit
926 (while (or (looking-at org-list-beginning-re)
927 (looking-at (concat "^" indent "[ \t]+\\|^$")))
928 (if (eq (point) (point-max))
929 (throw 'exit (point-max)))
930 (forward-line 1))) (point)))
931
932(defun org-list-insert-radio-list ()
933 "Insert a radio list template appropriate for this major mode."
934 (interactive)
935 (let* ((e (assq major-mode org-list-radio-list-templates))
936 (txt (nth 1 e))
937 name pos)
938 (unless e (error "No radio list setup defined for %s" major-mode))
939 (setq name (read-string "List name: "))
940 (while (string-match "%n" txt)
941 (setq txt (replace-match name t t txt)))
942 (or (bolp) (insert "\n"))
943 (setq pos (point))
944 (insert txt)
945 (goto-char pos)))
946
947(defun org-list-send-list (&optional maybe)
948 "Send a tranformed version of this list to the receiver position.
949With argument MAYBE, fail quietly if no transformation is defined for
950this list."
951 (interactive)
952 (catch 'exit
953 (unless (org-at-item-p) (error "Not at a list"))
954 (save-excursion
955 (goto-char (car (org-list-item-beginning)))
956 (beginning-of-line 0)
957 (unless (looking-at "#\\+ORGLST: *SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?")
958 (if maybe
959 (throw 'exit nil)
960 (error "Don't know how to transform this list"))))
961 (let* ((name (match-string 1))
33306645 962 (item-beginning (org-list-item-beginning))
47ffc456
CD
963 (transform (intern (match-string 2)))
964 (txt (buffer-substring-no-properties
33306645 965 (car item-beginning)
47ffc456
CD
966 (org-list-end (cdr item-beginning))))
967 (list (org-list-parse-list))
33306645 968 beg)
47ffc456
CD
969 (unless (fboundp transform)
970 (error "No such transformation function %s" transform))
971 (setq txt (funcall transform list))
972 ;; Find the insertion place
973 (save-excursion
974 (goto-char (point-min))
975 (unless (re-search-forward
976 (concat "BEGIN RECEIVE ORGLST +" name "\\([ \t]\\|$\\)") nil t)
977 (error "Don't know where to insert translated list"))
978 (goto-char (match-beginning 0))
979 (beginning-of-line 2)
980 (setq beg (point))
981 (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t)
982 (error "Cannot find end of insertion region"))
983 (beginning-of-line 1)
984 (delete-region beg (point))
985 (goto-char beg)
986 (insert txt "\n"))
987 (message "List converted and installed at receiver location"))))
988
989(defun org-list-to-generic (list params)
990 "Convert a LIST parsed through `org-list-parse-list' to other formats.
991
992Valid parameters PARAMS are
993
33306645
CD
994:ustart String to start an unordered list
995:uend String to end an unordered list
47ffc456 996
33306645
CD
997:ostart String to start an ordered list
998:oend String to end an ordered list
47ffc456 999
33306645
CD
1000:dstart String to start a descriptive list
1001:dend String to end a descriptive list
47ffc456 1002:dtstart String to start a descriptive term
33306645 1003:dtend String to end a descriptive term
47ffc456 1004:ddstart String to start a description
33306645 1005:ddend String to end a description
47ffc456 1006
33306645
CD
1007:splice When set to t, return only list body lines, don't wrap
1008 them into :[u/o]start and :[u/o]end. Default is nil.
47ffc456 1009
33306645
CD
1010:istart String to start a list item
1011:iend String to end a list item
1012:isep String to separate items
1013:lsep String to separate sublists"
47ffc456
CD
1014 (interactive)
1015 (let* ((p params) sublist
1016 (splicep (plist-get p :splice))
1017 (ostart (plist-get p :ostart))
33306645 1018 (oend (plist-get p :oend))
47ffc456 1019 (ustart (plist-get p :ustart))
33306645 1020 (uend (plist-get p :uend))
47ffc456 1021 (dstart (plist-get p :dstart))
33306645 1022 (dend (plist-get p :dend))
47ffc456 1023 (dtstart (plist-get p :dtstart))
33306645 1024 (dtend (plist-get p :dtend))
47ffc456 1025 (ddstart (plist-get p :ddstart))
33306645 1026 (ddend (plist-get p :ddend))
47ffc456 1027 (istart (plist-get p :istart))
33306645
CD
1028 (iend (plist-get p :iend))
1029 (isep (plist-get p :isep))
1030 (lsep (plist-get p :lsep)))
47ffc456
CD
1031 (let ((wrapper
1032 (cond ((eq (car list) 'ordered)
1033 (concat ostart "\n%s" oend "\n"))
1034 ((eq (car list) 'unordered)
1035 (concat ustart "\n%s" uend "\n"))
1036 ((eq (car list) 'descriptive)
1037 (concat dstart "\n%s" dend "\n"))))
1038 rtn term defstart defend)
1039 (while (setq sublist (pop list))
1040 (cond ((symbolp sublist) nil)
1041 ((stringp sublist)
33306645
CD
1042 (when (string-match "^\\(.*\\) ::" sublist)
1043 (setq term (org-trim (format (concat dtstart "%s" dtend)
1044 (match-string 1 sublist))))
1045 (setq sublist (substring sublist (1+ (length term)))))
1046 (setq rtn (concat rtn istart term ddstart
1047 sublist ddend iend isep)))
1048 (t (setq rtn (concat rtn ;; previous list
1049 lsep ;; list separator
1050 (org-list-to-generic sublist p)
1051 lsep ;; list separator
1052 )))))
47ffc456
CD
1053 (format wrapper rtn))))
1054
1055(defun org-list-to-latex (list)
1056 "Convert LIST into a LaTeX list."
1057 (org-list-to-generic
1058 list '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}"
33306645
CD
1059 :ustart "\\begin{itemize}" :uend "\\end{itemize}"
1060 :dstart "\\begin{description}" :dend "\\end{description}"
1061 :dtstart "[" :dtend "]"
1062 :ddstart "" :ddend ""
1063 :istart "\\item " :iend ""
1064 :isep "\n" :lsep "\n")))
47ffc456
CD
1065
1066(defun org-list-to-html (list)
1067 "Convert LIST into a HTML list."
1068 (org-list-to-generic
1069 list '(:splicep nil :ostart "<ol>" :oend "</ol>"
33306645
CD
1070 :ustart "<ul>" :uend "</ul>"
1071 :dstart "<dl>" :dend "</dl>"
1072 :dtstart "<dt>" :dtend "</dt>"
1073 :ddstart "<dd>" :ddend "</dd>"
1074 :istart "<li>" :iend "</li>"
1075 :isep "\n" :lsep "\n")))
47ffc456
CD
1076
1077(defun org-list-to-texinfo (list)
1078 "Convert LIST into a Texinfo list."
1079 (org-list-to-generic
1080 list '(:splicep nil :ostart "@itemize @minus" :oend "@end itemize"
33306645
CD
1081 :ustart "@enumerate" :uend "@end enumerate"
1082 :dstart "@table" :dend "@end table"
1083 :dtstart "@item " :dtend "\n"
1084 :ddstart "" :ddend ""
1085 :istart "@item\n" :iend ""
1086 :isep "\n" :lsep "\n")))
47ffc456
CD
1087
1088(provide 'org-list)
1089
3048977d 1090;; arch-tag: 73cf50c1-200f-4d1d-8a53-4e842a5b11c8
47ffc456 1091;;; org-list.el ends here