lisp/org-list.el

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