lisp/org/org-list.el

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