lisp/org-list.el

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