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