| 1 | ;;; org-list.el --- Plain lists for Org-mode |
| 2 | ;; |
| 3 | ;; Copyright (C) 2004-2012 Free Software Foundation, Inc. |
| 4 | ;; |
| 5 | ;; Author: Carsten Dominik <carsten at orgmode dot org> |
| 6 | ;; Bastien Guerry <bzg AT gnu DOT org> |
| 7 | ;; Keywords: outlines, hypermedia, calendar, wp |
| 8 | ;; Homepage: http://orgmode.org |
| 9 | ;; |
| 10 | ;; This file is part of GNU Emacs. |
| 11 | ;; |
| 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
| 13 | ;; it under the terms of the GNU General Public License as published by |
| 14 | ;; the Free Software Foundation, either version 3 of the License, or |
| 15 | ;; (at your option) any later version. |
| 16 | |
| 17 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 20 | ;; GNU General Public License for more details. |
| 21 | |
| 22 | ;; You should have received a copy of the GNU General Public License |
| 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 24 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 25 | ;; |
| 26 | ;;; Commentary: |
| 27 | |
| 28 | ;; This file contains the code dealing with plain lists in Org-mode. |
| 29 | |
| 30 | ;; The core concept behind lists is their structure. A structure is |
| 31 | ;; a snapshot of the list, in the shape of a data tree (see |
| 32 | ;; `org-list-struct'). |
| 33 | |
| 34 | ;; Once the list structure is stored, it is possible to make changes |
| 35 | ;; on it that will be mirrored to the real list or to get information |
| 36 | ;; about the list, using accessors and methods provided in the |
| 37 | ;; library. Most of them require the use of one or two helper |
| 38 | ;; functions, namely `org-list-parents-alist' and |
| 39 | ;; `org-list-prevs-alist'. |
| 40 | |
| 41 | ;; Structure is eventually applied to the buffer with |
| 42 | ;; `org-list-write-struct'. This function repairs (bullets, |
| 43 | ;; indentation, checkboxes) the list in the process. It should be |
| 44 | ;; called near the end of any function working on structures. |
| 45 | |
| 46 | ;; Thus, a function applying to lists should usually follow this |
| 47 | ;; template: |
| 48 | |
| 49 | ;; 1. Verify point is in a list and grab item beginning (with the same |
| 50 | ;; function `org-in-item-p'). If the function requires the cursor |
| 51 | ;; to be at item's bullet, `org-at-item-p' is more selective. It |
| 52 | ;; is also possible to move point to the closest item with |
| 53 | ;; `org-list-search-backward', or `org-list-search-forward', |
| 54 | ;; applied to the function `org-item-beginning-re'. |
| 55 | |
| 56 | ;; 2. Get list structure with `org-list-struct'. |
| 57 | |
| 58 | ;; 3. Compute one, or both, helper functions, |
| 59 | ;; (`org-list-parents-alist', `org-list-prevs-alist') depending on |
| 60 | ;; needed accessors. |
| 61 | |
| 62 | ;; 4. Proceed with the modifications, using methods and accessors. |
| 63 | |
| 64 | ;; 5. Verify and apply structure to buffer, using |
| 65 | ;; `org-list-write-struct'. |
| 66 | |
| 67 | ;; 6. If changes made to the list might have modified check-boxes, |
| 68 | ;; call `org-update-checkbox-count-maybe'. |
| 69 | |
| 70 | ;; Computing a structure can be a costly operation on huge lists (a |
| 71 | ;; few thousand lines long). Thus, code should follow the rule: |
| 72 | ;; "collect once, use many". As a corollary, it is usually a bad idea |
| 73 | ;; to use directly an interactive function inside the code, as those, |
| 74 | ;; being independent entities, read the whole list structure another |
| 75 | ;; time. |
| 76 | |
| 77 | ;;; Code: |
| 78 | |
| 79 | (eval-when-compile |
| 80 | (require 'cl)) |
| 81 | (require 'org-macs) |
| 82 | (require 'org-compat) |
| 83 | |
| 84 | (defvar org-M-RET-may-split-line) |
| 85 | (defvar org-auto-align-tags) |
| 86 | (defvar org-blank-before-new-entry) |
| 87 | (defvar org-clock-string) |
| 88 | (defvar org-closed-string) |
| 89 | (defvar org-deadline-string) |
| 90 | (defvar org-description-max-indent) |
| 91 | (defvar org-drawers) |
| 92 | (defvar org-odd-levels-only) |
| 93 | (defvar org-scheduled-string) |
| 94 | (defvar org-ts-regexp) |
| 95 | (defvar org-ts-regexp-both) |
| 96 | |
| 97 | (declare-function org-at-heading-p "org" (&optional ignored)) |
| 98 | (declare-function org-before-first-heading-p "org" ()) |
| 99 | (declare-function org-back-to-heading "org" (&optional invisible-ok)) |
| 100 | (declare-function org-combine-plists "org" (&rest plists)) |
| 101 | (declare-function org-count "org" (cl-item cl-seq)) |
| 102 | (declare-function org-current-level "org" ()) |
| 103 | (declare-function org-entry-get "org" |
| 104 | (pom property &optional inherit literal-nil)) |
| 105 | (declare-function org-fix-tags-on-the-fly "org" ()) |
| 106 | (declare-function org-get-indentation "org" (&optional line)) |
| 107 | (declare-function org-icompleting-read "org" (&rest args)) |
| 108 | (declare-function org-in-block-p "org" (names)) |
| 109 | (declare-function org-in-regexp "org" (re &optional nlines visually)) |
| 110 | (declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) |
| 111 | (declare-function org-inlinetask-goto-end "org-inlinetask" ()) |
| 112 | (declare-function org-inlinetask-in-task-p "org-inlinetask" ()) |
| 113 | (declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) |
| 114 | (declare-function org-level-increment "org" ()) |
| 115 | (declare-function org-narrow-to-subtree "org" ()) |
| 116 | (declare-function org-at-heading-p "org" (&optional invisible-ok)) |
| 117 | (declare-function org-previous-line-empty-p "org" ()) |
| 118 | (declare-function org-remove-if "org" (predicate seq)) |
| 119 | (declare-function org-reduced-level "org" (L)) |
| 120 | (declare-function org-show-subtree "org" ()) |
| 121 | (declare-function org-time-string-to-seconds "org" (s)) |
| 122 | (declare-function org-timer-hms-to-secs "org-timer" (hms)) |
| 123 | (declare-function org-timer-item "org-timer" (&optional arg)) |
| 124 | (declare-function org-trim "org" (s)) |
| 125 | (declare-function org-uniquify "org" (list)) |
| 126 | (declare-function outline-invisible-p "outline" (&optional pos)) |
| 127 | (declare-function outline-flag-region "outline" (from to flag)) |
| 128 | (declare-function outline-next-heading "outline" ()) |
| 129 | (declare-function outline-previous-heading "outline" ()) |
| 130 | |
| 131 | |
| 132 | \f |
| 133 | ;;; Configuration variables |
| 134 | |
| 135 | (defgroup org-plain-lists nil |
| 136 | "Options concerning plain lists in Org-mode." |
| 137 | :tag "Org Plain lists" |
| 138 | :group 'org-structure) |
| 139 | |
| 140 | (defcustom org-cycle-include-plain-lists t |
| 141 | "When t, make TAB cycle visibility on plain list items. |
| 142 | Cycling plain lists works only when the cursor is on a plain list |
| 143 | item. When the cursor is on an outline heading, plain lists are |
| 144 | treated as text. This is the most stable way of handling this, |
| 145 | which is why it is the default. |
| 146 | |
| 147 | When this is the symbol `integrate', then during cycling, plain |
| 148 | list items will *temporarily* be interpreted as outline headlines |
| 149 | with a level given by 1000+i where i is the indentation of the |
| 150 | bullet. This setting can lead to strange effects when switching |
| 151 | visibility to `children', because the first \"child\" in a |
| 152 | subtree decides what children should be listed. If that first |
| 153 | \"child\" is a plain list item with an implied large level |
| 154 | number, all true children and grand children of the outline |
| 155 | heading will be exposed in a children' view." |
| 156 | :group 'org-plain-lists |
| 157 | :type '(choice |
| 158 | (const :tag "Never" nil) |
| 159 | (const :tag "With cursor in plain list (recommended)" t) |
| 160 | (const :tag "As children of outline headings" integrate))) |
| 161 | |
| 162 | (defcustom org-list-demote-modify-bullet nil |
| 163 | "Default bullet type installed when demoting an item. |
| 164 | This is an association list, for each bullet type, this alist will point |
| 165 | to the bullet that should be used when this item is demoted. |
| 166 | For example, |
| 167 | |
| 168 | (setq org-list-demote-modify-bullet |
| 169 | '((\"+\" . \"-\") (\"-\" . \"+\") (\"*\" . \"+\"))) |
| 170 | |
| 171 | will make |
| 172 | |
| 173 | + Movies |
| 174 | + Silence of the Lambs |
| 175 | + My Cousin Vinny |
| 176 | + Books |
| 177 | + The Hunt for Red October |
| 178 | + The Road to Omaha |
| 179 | |
| 180 | into |
| 181 | |
| 182 | + Movies |
| 183 | - Silence of the Lambs |
| 184 | - My Cousin Vinny |
| 185 | + Books |
| 186 | - The Hunt for Red October |
| 187 | - The Road to Omaha" |
| 188 | :group 'org-plain-lists |
| 189 | :type '(repeat |
| 190 | (cons |
| 191 | (choice :tag "If the current bullet is " |
| 192 | (const "-") |
| 193 | (const "+") |
| 194 | (const "*") |
| 195 | (const "1.") |
| 196 | (const "1)")) |
| 197 | (choice :tag "demotion will change it to" |
| 198 | (const "-") |
| 199 | (const "+") |
| 200 | (const "*") |
| 201 | (const "1.") |
| 202 | (const "1)"))))) |
| 203 | |
| 204 | (defcustom org-plain-list-ordered-item-terminator t |
| 205 | "The character that makes a line with leading number an ordered list item. |
| 206 | Valid values are ?. and ?\). To get both terminators, use t." |
| 207 | :group 'org-plain-lists |
| 208 | :type '(choice (const :tag "dot like in \"2.\"" ?.) |
| 209 | (const :tag "paren like in \"2)\"" ?\)) |
| 210 | (const :tag "both" t))) |
| 211 | |
| 212 | (defcustom org-alphabetical-lists nil |
| 213 | "Non-nil means single character alphabetical bullets are allowed. |
| 214 | Both uppercase and lowercase are handled. Lists with more than |
| 215 | 26 items will fallback to standard numbering. Alphabetical |
| 216 | counters like \"[@c]\" will be recognized." |
| 217 | :group 'org-plain-lists |
| 218 | :version "24.1" |
| 219 | :type 'boolean) |
| 220 | |
| 221 | (defcustom org-list-two-spaces-after-bullet-regexp nil |
| 222 | "A regular expression matching bullets that should have 2 spaces after them. |
| 223 | When nil, no bullet will have two spaces after them. When |
| 224 | a string, it will be used as a regular expression. When the |
| 225 | bullet type of a list is changed, the new bullet type will be |
| 226 | matched against this regexp. If it matches, there will be two |
| 227 | spaces instead of one after the bullet in each item of the list." |
| 228 | :group 'org-plain-lists |
| 229 | :type '(choice |
| 230 | (const :tag "never" nil) |
| 231 | (regexp))) |
| 232 | |
| 233 | (defcustom org-empty-line-terminates-plain-lists nil |
| 234 | "Non-nil means an empty line ends all plain list levels. |
| 235 | Otherwise, two of them will be necessary." |
| 236 | :group 'org-plain-lists |
| 237 | :type 'boolean) |
| 238 | |
| 239 | (defcustom org-list-automatic-rules '((checkbox . t) |
| 240 | (indent . t)) |
| 241 | "Non-nil means apply set of rules when acting on lists. |
| 242 | By default, automatic actions are taken when using |
| 243 | \\[org-meta-return], \\[org-metaright], \\[org-metaleft], |
| 244 | \\[org-shiftmetaright], \\[org-shiftmetaleft], |
| 245 | \\[org-ctrl-c-minus], \\[org-toggle-checkbox] or |
| 246 | \\[org-insert-todo-heading]. You can disable individually these |
| 247 | rules by setting them to nil. Valid rules are: |
| 248 | |
| 249 | checkbox when non-nil, checkbox statistics is updated each time |
| 250 | you either insert a new checkbox or toggle a checkbox. |
| 251 | indent when non-nil, indenting or outdenting list top-item |
| 252 | with its subtree will move the whole list and |
| 253 | outdenting a list whose bullet is * to column 0 will |
| 254 | change that bullet to \"-\"." |
| 255 | :group 'org-plain-lists |
| 256 | :version "24.1" |
| 257 | :type '(alist :tag "Sets of rules" |
| 258 | :key-type |
| 259 | (choice |
| 260 | (const :tag "Checkbox" checkbox) |
| 261 | (const :tag "Indent" indent)) |
| 262 | :value-type |
| 263 | (boolean :tag "Activate" :value t))) |
| 264 | |
| 265 | (defcustom org-list-use-circular-motion nil |
| 266 | "Non-nil means commands implying motion in lists should be cyclic. |
| 267 | |
| 268 | In that case, the item following the last item is the first one, |
| 269 | and the item preceding the first item is the last one. |
| 270 | |
| 271 | This affects the behavior of \\[org-move-item-up], |
| 272 | \\[org-move-item-down], \\[org-next-item] and |
| 273 | \\[org-previous-item]." |
| 274 | :group 'org-plain-lists |
| 275 | :version "24.1" |
| 276 | :type 'boolean) |
| 277 | |
| 278 | (defvar org-checkbox-statistics-hook nil |
| 279 | "Hook that is run whenever Org thinks checkbox statistics should be updated. |
| 280 | This hook runs even if checkbox rule in |
| 281 | `org-list-automatic-rules' does not apply, so it can be used to |
| 282 | implement alternative ways of collecting statistics |
| 283 | information.") |
| 284 | |
| 285 | (defcustom org-hierarchical-checkbox-statistics t |
| 286 | "Non-nil means checkbox statistics counts only the state of direct children. |
| 287 | When nil, all boxes below the cookie are counted. |
| 288 | This can be set to nil on a per-node basis using a COOKIE_DATA property |
| 289 | with the word \"recursive\" in the value." |
| 290 | :group 'org-plain-lists |
| 291 | :type 'boolean) |
| 292 | |
| 293 | (defcustom org-description-max-indent 20 |
| 294 | "Maximum indentation for the second line of a description list. |
| 295 | When the indentation would be larger than this, it will become |
| 296 | 5 characters instead." |
| 297 | :group 'org-plain-lists |
| 298 | :type 'integer) |
| 299 | |
| 300 | (defcustom org-list-indent-offset 0 |
| 301 | "Additional indentation for sub-items in a list. |
| 302 | By setting this to a small number, usually 1 or 2, one can more |
| 303 | clearly distinguish sub-items in a list." |
| 304 | :group 'org-plain-lists |
| 305 | :version "24.1" |
| 306 | :type 'integer) |
| 307 | |
| 308 | (defcustom org-list-radio-list-templates |
| 309 | '((latex-mode "% BEGIN RECEIVE ORGLST %n |
| 310 | % END RECEIVE ORGLST %n |
| 311 | \\begin{comment} |
| 312 | #+ORGLST: SEND %n org-list-to-latex |
| 313 | - |
| 314 | \\end{comment}\n") |
| 315 | (texinfo-mode "@c BEGIN RECEIVE ORGLST %n |
| 316 | @c END RECEIVE ORGLST %n |
| 317 | @ignore |
| 318 | #+ORGLST: SEND %n org-list-to-texinfo |
| 319 | - |
| 320 | @end ignore\n") |
| 321 | (html-mode "<!-- BEGIN RECEIVE ORGLST %n --> |
| 322 | <!-- END RECEIVE ORGLST %n --> |
| 323 | <!-- |
| 324 | #+ORGLST: SEND %n org-list-to-html |
| 325 | - |
| 326 | -->\n")) |
| 327 | "Templates for radio lists in different major modes. |
| 328 | All occurrences of %n in a template will be replaced with the name of the |
| 329 | list, obtained by prompting the user." |
| 330 | :group 'org-plain-lists |
| 331 | :type '(repeat |
| 332 | (list (symbol :tag "Major mode") |
| 333 | (string :tag "Format")))) |
| 334 | |
| 335 | (defvar org-list-forbidden-blocks '("example" "verse" "src" "ascii" "beamer" |
| 336 | "docbook" "html" "latex" "odt") |
| 337 | "Names of blocks where lists are not allowed. |
| 338 | Names must be in lower case.") |
| 339 | |
| 340 | (defvar org-list-export-context '(block inlinetask) |
| 341 | "Context types where lists will be interpreted during export. |
| 342 | |
| 343 | Valid types are `drawer', `inlinetask' and `block'. More |
| 344 | specifically, type `block' is determined by the variable |
| 345 | `org-list-forbidden-blocks'.") |
| 346 | |
| 347 | |
| 348 | \f |
| 349 | ;;; Predicates and regexps |
| 350 | |
| 351 | (defconst org-list-end-re (if org-empty-line-terminates-plain-lists "^[ \t]*\n" |
| 352 | "^[ \t]*\n[ \t]*\n") |
| 353 | "Regex corresponding to the end of a list. |
| 354 | It depends on `org-empty-line-terminates-plain-lists'.") |
| 355 | |
| 356 | (defconst org-list-full-item-re |
| 357 | (concat "^[ \t]*\\(\\(?:[-+*]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)\\(?:[ \t]+\\|$\\)\\)" |
| 358 | "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?" |
| 359 | "\\(?:\\(\\[[ X-]\\]\\)\\(?:[ \t]+\\|$\\)\\)?" |
| 360 | "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?") |
| 361 | "Matches a list item and puts everything into groups: |
| 362 | group 1: bullet |
| 363 | group 2: counter |
| 364 | group 3: checkbox |
| 365 | group 4: description tag") |
| 366 | |
| 367 | (defun org-item-re () |
| 368 | "Return the correct regular expression for plain lists." |
| 369 | (let ((term (cond |
| 370 | ((eq org-plain-list-ordered-item-terminator t) "[.)]") |
| 371 | ((= org-plain-list-ordered-item-terminator ?\)) ")") |
| 372 | ((= org-plain-list-ordered-item-terminator ?.) "\\.") |
| 373 | (t "[.)]"))) |
| 374 | (alpha (if org-alphabetical-lists "\\|[A-Za-z]" ""))) |
| 375 | (concat "\\([ \t]*\\([-+]\\|\\(\\([0-9]+" alpha "\\)" term |
| 376 | "\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)"))) |
| 377 | |
| 378 | (defsubst org-item-beginning-re () |
| 379 | "Regexp matching the beginning of a plain list item." |
| 380 | (concat "^" (org-item-re))) |
| 381 | |
| 382 | (defun org-list-at-regexp-after-bullet-p (regexp) |
| 383 | "Is point at a list item with REGEXP after bullet?" |
| 384 | (and (org-at-item-p) |
| 385 | (save-excursion |
| 386 | (goto-char (match-end 0)) |
| 387 | (let ((counter-re (concat "\\(?:\\[@\\(?:start:\\)?" |
| 388 | (if org-alphabetical-lists |
| 389 | "\\([0-9]+\\|[A-Za-z]\\)" |
| 390 | "[0-9]+") |
| 391 | "\\][ \t]*\\)"))) |
| 392 | ;; Ignore counter if any |
| 393 | (when (looking-at counter-re) (goto-char (match-end 0)))) |
| 394 | (looking-at regexp)))) |
| 395 | |
| 396 | (defun org-list-in-valid-context-p () |
| 397 | "Is point in a context where lists are allowed?" |
| 398 | (not (org-in-block-p org-list-forbidden-blocks))) |
| 399 | |
| 400 | (defun org-in-item-p () |
| 401 | "Return item beginning position when in a plain list, nil otherwise." |
| 402 | (save-excursion |
| 403 | (beginning-of-line) |
| 404 | (let* ((case-fold-search t) |
| 405 | (context (org-list-context)) |
| 406 | (lim-up (car context)) |
| 407 | (drawers-re (concat "^[ \t]*:\\(" |
| 408 | (mapconcat 'regexp-quote org-drawers "\\|") |
| 409 | "\\):[ \t]*$")) |
| 410 | (inlinetask-re (and (featurep 'org-inlinetask) |
| 411 | (org-inlinetask-outline-regexp))) |
| 412 | (item-re (org-item-re)) |
| 413 | ;; Indentation isn't meaningful when point starts at an empty |
| 414 | ;; line or an inline task. |
| 415 | (ind-ref (if (or (looking-at "^[ \t]*$") |
| 416 | (and inlinetask-re (looking-at inlinetask-re))) |
| 417 | 10000 |
| 418 | (org-get-indentation)))) |
| 419 | (cond |
| 420 | ((eq (nth 2 context) 'invalid) nil) |
| 421 | ((looking-at item-re) (point)) |
| 422 | (t |
| 423 | ;; Detect if cursor in amidst `org-list-end-re'. First, count |
| 424 | ;; number HL of hard lines it takes, then call `org-in-regexp' |
| 425 | ;; to compute its boundaries END-BOUNDS. When point is |
| 426 | ;; in-between, move cursor before regexp beginning. |
| 427 | (let ((hl 0) (i -1) end-bounds) |
| 428 | (when (and (progn |
| 429 | (while (setq i (string-match |
| 430 | "[\r\n]" org-list-end-re (1+ i))) |
| 431 | (setq hl (1+ hl))) |
| 432 | (setq end-bounds (org-in-regexp org-list-end-re hl))) |
| 433 | (>= (point) (car end-bounds)) |
| 434 | (< (point) (cdr end-bounds))) |
| 435 | (goto-char (car end-bounds)) |
| 436 | (forward-line -1))) |
| 437 | ;; Look for an item, less indented that reference line. |
| 438 | (catch 'exit |
| 439 | (while t |
| 440 | (let ((ind (org-get-indentation))) |
| 441 | (cond |
| 442 | ;; This is exactly what we want. |
| 443 | ((and (looking-at item-re) (< ind ind-ref)) |
| 444 | (throw 'exit (point))) |
| 445 | ;; At upper bound of search or looking at the end of a |
| 446 | ;; previous list: search is over. |
| 447 | ((<= (point) lim-up) (throw 'exit nil)) |
| 448 | ((looking-at org-list-end-re) (throw 'exit nil)) |
| 449 | ;; Skip blocks, drawers, inline-tasks, blank lines |
| 450 | ((and (looking-at "^[ \t]*#\\+end_") |
| 451 | (re-search-backward "^[ \t]*#\\+begin_" lim-up t))) |
| 452 | ((and (looking-at "^[ \t]*:END:") |
| 453 | (re-search-backward drawers-re lim-up t)) |
| 454 | (beginning-of-line)) |
| 455 | ((and inlinetask-re (looking-at inlinetask-re)) |
| 456 | (org-inlinetask-goto-beginning) |
| 457 | (forward-line -1)) |
| 458 | ((looking-at "^[ \t]*$") (forward-line -1)) |
| 459 | ;; Text at column 0 cannot belong to a list: stop. |
| 460 | ((zerop ind) (throw 'exit nil)) |
| 461 | ;; Normal text less indented than reference line, take |
| 462 | ;; it as new reference. |
| 463 | ((< ind ind-ref) |
| 464 | (setq ind-ref ind) |
| 465 | (forward-line -1)) |
| 466 | (t (forward-line -1))))))))))) |
| 467 | |
| 468 | (defun org-at-item-p () |
| 469 | "Is point in a line starting a hand-formatted item?" |
| 470 | (save-excursion |
| 471 | (beginning-of-line) |
| 472 | (and (looking-at (org-item-re)) (org-list-in-valid-context-p)))) |
| 473 | |
| 474 | (defun org-at-item-bullet-p () |
| 475 | "Is point at the bullet of a plain list item?" |
| 476 | (and (org-at-item-p) |
| 477 | (not (member (char-after) '(?\ ?\t))) |
| 478 | (< (point) (match-end 0)))) |
| 479 | |
| 480 | (defun org-at-item-timer-p () |
| 481 | "Is point at a line starting a plain list item with a timer?" |
| 482 | (org-list-at-regexp-after-bullet-p |
| 483 | "\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+::[ \t]+")) |
| 484 | |
| 485 | (defun org-at-item-description-p () |
| 486 | "Is point at a description list item?" |
| 487 | (org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::\\([ \t]+\\|$\\)")) |
| 488 | |
| 489 | (defun org-at-item-checkbox-p () |
| 490 | "Is point at a line starting a plain-list item with a checklet?" |
| 491 | (org-list-at-regexp-after-bullet-p "\\(\\[[- X]\\]\\)[ \t]+")) |
| 492 | |
| 493 | (defun org-at-item-counter-p () |
| 494 | "Is point at a line starting a plain-list item with a counter?" |
| 495 | (and (org-at-item-p) |
| 496 | (looking-at org-list-full-item-re) |
| 497 | (match-string 2))) |
| 498 | |
| 499 | |
| 500 | \f |
| 501 | ;;; Structures and helper functions |
| 502 | |
| 503 | (defun org-list-context () |
| 504 | "Determine context, and its boundaries, around point. |
| 505 | |
| 506 | Context will be a cell like (MIN MAX CONTEXT) where MIN and MAX |
| 507 | are boundaries and CONTEXT is a symbol among `drawer', `block', |
| 508 | `invalid', `inlinetask' and nil. |
| 509 | |
| 510 | Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'." |
| 511 | (save-match-data |
| 512 | (save-excursion |
| 513 | (org-with-limited-levels |
| 514 | (beginning-of-line) |
| 515 | (let ((case-fold-search t) (pos (point)) beg end context-type |
| 516 | ;; Get positions of surrounding headings. This is the |
| 517 | ;; default context. |
| 518 | (lim-up (or (save-excursion (and (ignore-errors (org-back-to-heading t)) |
| 519 | (point))) |
| 520 | (point-min))) |
| 521 | (lim-down (or (save-excursion (outline-next-heading)) (point-max)))) |
| 522 | ;; Is point inside a drawer? |
| 523 | (let ((end-re "^[ \t]*:END:") |
| 524 | ;; Can't use org-drawers-regexp as this function might |
| 525 | ;; be called in buffers not in Org mode. |
| 526 | (beg-re (concat "^[ \t]*:\\(" |
| 527 | (mapconcat 'regexp-quote org-drawers "\\|") |
| 528 | "\\):[ \t]*$"))) |
| 529 | (when (save-excursion |
| 530 | (and (not (looking-at beg-re)) |
| 531 | (not (looking-at end-re)) |
| 532 | (setq beg (and (re-search-backward beg-re lim-up t) |
| 533 | (1+ (point-at-eol)))) |
| 534 | (setq end (or (and (re-search-forward end-re lim-down t) |
| 535 | (1- (match-beginning 0))) |
| 536 | lim-down)) |
| 537 | (>= end pos))) |
| 538 | (setq lim-up beg lim-down end context-type 'drawer))) |
| 539 | ;; Is point strictly in a block, and of which type? |
| 540 | (let ((block-re "^[ \t]*#\\+\\(begin\\|end\\)_") type) |
| 541 | (when (save-excursion |
| 542 | (and (not (looking-at block-re)) |
| 543 | (setq beg (and (re-search-backward block-re lim-up t) |
| 544 | (1+ (point-at-eol)))) |
| 545 | (looking-at "^[ \t]*#\\+begin_\\(\\S-+\\)") |
| 546 | (setq type (downcase (match-string 1))) |
| 547 | (goto-char beg) |
| 548 | (setq end (or (and (re-search-forward block-re lim-down t) |
| 549 | (1- (point-at-bol))) |
| 550 | lim-down)) |
| 551 | (>= end pos) |
| 552 | (equal (downcase (match-string 1)) "end"))) |
| 553 | (setq lim-up beg lim-down end |
| 554 | context-type (if (member type org-list-forbidden-blocks) |
| 555 | 'invalid 'block)))) |
| 556 | ;; Is point in an inlinetask? |
| 557 | (when (and (featurep 'org-inlinetask) |
| 558 | (save-excursion |
| 559 | (let* ((beg-re (org-inlinetask-outline-regexp)) |
| 560 | (end-re (concat beg-re "END[ \t]*$"))) |
| 561 | (and (not (looking-at "^\\*+")) |
| 562 | (setq beg (and (re-search-backward beg-re lim-up t) |
| 563 | (1+ (point-at-eol)))) |
| 564 | (not (looking-at end-re)) |
| 565 | (setq end (and (re-search-forward end-re lim-down t) |
| 566 | (1- (match-beginning 0)))) |
| 567 | (> (point) pos))))) |
| 568 | (setq lim-up beg lim-down end context-type 'inlinetask)) |
| 569 | ;; Return context boundaries and type. |
| 570 | (list lim-up lim-down context-type)))))) |
| 571 | |
| 572 | (defun org-list-struct () |
| 573 | "Return structure of list at point. |
| 574 | |
| 575 | A list structure is an alist where key is point at item, and |
| 576 | values are: |
| 577 | 1. indentation, |
| 578 | 2. bullet with trailing whitespace, |
| 579 | 3. bullet counter, if any, |
| 580 | 4. checkbox, if any, |
| 581 | 5. description tag, if any, |
| 582 | 6. position at item end. |
| 583 | |
| 584 | Thus the following list, where numbers in parens are |
| 585 | point-at-bol: |
| 586 | |
| 587 | - [X] first item (1) |
| 588 | 1. sub-item 1 (18) |
| 589 | 5. [@5] sub-item 2 (34) |
| 590 | some other text belonging to first item (55) |
| 591 | - last item (97) |
| 592 | + tag :: description (109) |
| 593 | (131) |
| 594 | |
| 595 | will get the following structure: |
| 596 | |
| 597 | \(\(1 0 \"- \" nil \"[X]\" nil 97\) |
| 598 | \(18 2 \"1. \" nil nil nil 34\) |
| 599 | \(34 2 \"5. \" \"5\" nil nil 55\) |
| 600 | \(97 0 \"- \" nil nil nil 131\) |
| 601 | \(109 2 \"+ \" nil nil \"tag\" 131\) |
| 602 | |
| 603 | Assume point is at an item." |
| 604 | (save-excursion |
| 605 | (beginning-of-line) |
| 606 | (let* ((case-fold-search t) |
| 607 | (context (org-list-context)) |
| 608 | (lim-up (car context)) |
| 609 | (lim-down (nth 1 context)) |
| 610 | (text-min-ind 10000) |
| 611 | (item-re (org-item-re)) |
| 612 | (drawers-re (concat "^[ \t]*:\\(" |
| 613 | (mapconcat 'regexp-quote org-drawers "\\|") |
| 614 | "\\):[ \t]*$")) |
| 615 | (inlinetask-re (and (featurep 'org-inlinetask) |
| 616 | (org-inlinetask-outline-regexp))) |
| 617 | (beg-cell (cons (point) (org-get-indentation))) |
| 618 | ind itm-lst itm-lst-2 end-lst end-lst-2 struct |
| 619 | (assoc-at-point |
| 620 | (function |
| 621 | ;; Return association at point. |
| 622 | (lambda (ind) |
| 623 | (looking-at org-list-full-item-re) |
| 624 | (let ((bullet (match-string-no-properties 1))) |
| 625 | (list (point) |
| 626 | ind |
| 627 | bullet |
| 628 | (match-string-no-properties 2) ; counter |
| 629 | (match-string-no-properties 3) ; checkbox |
| 630 | ;; Description tag. |
| 631 | (and (save-match-data (string-match "[-+*]" bullet)) |
| 632 | (match-string-no-properties 4))))))) |
| 633 | (end-before-blank |
| 634 | (function |
| 635 | ;; Ensure list ends at the first blank line. |
| 636 | (lambda () |
| 637 | (skip-chars-backward " \r\t\n") |
| 638 | (min (1+ (point-at-eol)) lim-down))))) |
| 639 | ;; 1. Read list from starting item to its beginning, and save |
| 640 | ;; top item position and indentation in BEG-CELL. Also store |
| 641 | ;; ending position of items in END-LST. |
| 642 | (save-excursion |
| 643 | (catch 'exit |
| 644 | (while t |
| 645 | (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0) |
| 646 | (org-get-indentation)))) |
| 647 | (cond |
| 648 | ((<= (point) lim-up) |
| 649 | ;; At upward limit: if we ended at an item, store it, |
| 650 | ;; else dismiss useless data recorded above BEG-CELL. |
| 651 | ;; Jump to part 2. |
| 652 | (throw 'exit |
| 653 | (setq itm-lst |
| 654 | (if (or (not (looking-at item-re)) |
| 655 | (get-text-property (point) 'org-example)) |
| 656 | (memq (assq (car beg-cell) itm-lst) itm-lst) |
| 657 | (setq beg-cell (cons (point) ind)) |
| 658 | (cons (funcall assoc-at-point ind) itm-lst))))) |
| 659 | ;; At a verbatim block, go before its beginning. Move |
| 660 | ;; from eol to ensure `previous-single-property-change' |
| 661 | ;; will return a value. |
| 662 | ((get-text-property (point) 'org-example) |
| 663 | (goto-char (previous-single-property-change |
| 664 | (point-at-eol) 'org-example nil lim-up)) |
| 665 | (forward-line -1)) |
| 666 | ;; Looking at a list ending regexp. Dismiss useless |
| 667 | ;; data recorded above BEG-CELL. Jump to part 2. |
| 668 | ((looking-at org-list-end-re) |
| 669 | (throw 'exit |
| 670 | (setq itm-lst |
| 671 | (memq (assq (car beg-cell) itm-lst) itm-lst)))) |
| 672 | ;; Point is at an item. Add data to ITM-LST. It may |
| 673 | ;; also end a previous item: save it in END-LST. If |
| 674 | ;; ind is less or equal than BEG-CELL and there is no |
| 675 | ;; end at this ind or lesser, this item becomes the new |
| 676 | ;; BEG-CELL. |
| 677 | ((looking-at item-re) |
| 678 | (push (funcall assoc-at-point ind) itm-lst) |
| 679 | (push (cons ind (point)) end-lst) |
| 680 | (when (< ind text-min-ind) (setq beg-cell (cons (point) ind))) |
| 681 | (forward-line -1)) |
| 682 | ;; Skip blocks, drawers, inline tasks, blank lines. |
| 683 | ((and (looking-at "^[ \t]*#\\+end_") |
| 684 | (re-search-backward "^[ \t]*#\\+begin_" lim-up t))) |
| 685 | ((and (looking-at "^[ \t]*:END:") |
| 686 | (re-search-backward drawers-re lim-up t)) |
| 687 | (beginning-of-line)) |
| 688 | ((and inlinetask-re (looking-at inlinetask-re)) |
| 689 | (org-inlinetask-goto-beginning) |
| 690 | (forward-line -1)) |
| 691 | ((looking-at "^[ \t]*$") |
| 692 | (forward-line -1)) |
| 693 | ;; From there, point is not at an item. Interpret |
| 694 | ;; line's indentation: |
| 695 | ;; - text at column 0 is necessarily out of any list. |
| 696 | ;; Dismiss data recorded above BEG-CELL. Jump to |
| 697 | ;; part 2. |
| 698 | ;; - any other case may be an ending position for an |
| 699 | ;; hypothetical item above. Store it and proceed. |
| 700 | ((zerop ind) |
| 701 | (throw 'exit |
| 702 | (setq itm-lst |
| 703 | (memq (assq (car beg-cell) itm-lst) itm-lst)))) |
| 704 | (t |
| 705 | (when (< ind text-min-ind) (setq text-min-ind ind)) |
| 706 | (push (cons ind (point)) end-lst) |
| 707 | (forward-line -1))))))) |
| 708 | ;; 2. Read list from starting point to its end, that is until we |
| 709 | ;; get out of context, or that a non-item line is less or |
| 710 | ;; equally indented than BEG-CELL's cdr. Also, store ending |
| 711 | ;; position of items in END-LST-2. |
| 712 | (catch 'exit |
| 713 | (while t |
| 714 | (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0) |
| 715 | (org-get-indentation)))) |
| 716 | (cond |
| 717 | ((>= (point) lim-down) |
| 718 | ;; At downward limit: this is de facto the end of the |
| 719 | ;; list. Save point as an ending position, and jump to |
| 720 | ;; part 3. |
| 721 | (throw 'exit |
| 722 | (push (cons 0 (funcall end-before-blank)) end-lst-2))) |
| 723 | ;; At a verbatim block, move to its end. Point is at bol |
| 724 | ;; and 'org-example property is set by whole lines: |
| 725 | ;; `next-single-property-change' always return a value. |
| 726 | ((get-text-property (point) 'org-example) |
| 727 | (goto-char |
| 728 | (next-single-property-change (point) 'org-example nil lim-down))) |
| 729 | ;; Looking at a list ending regexp. Save point as an |
| 730 | ;; ending position and jump to part 3. |
| 731 | ((looking-at org-list-end-re) |
| 732 | (throw 'exit (push (cons 0 (point)) end-lst-2))) |
| 733 | ((looking-at item-re) |
| 734 | ;; Point is at an item. Add data to ITM-LST-2. It may |
| 735 | ;; also end a previous item, so save it in END-LST-2. |
| 736 | (push (funcall assoc-at-point ind) itm-lst-2) |
| 737 | (push (cons ind (point)) end-lst-2) |
| 738 | (forward-line 1)) |
| 739 | ;; Skip inline tasks and blank lines along the way |
| 740 | ((and inlinetask-re (looking-at inlinetask-re)) |
| 741 | (org-inlinetask-goto-end)) |
| 742 | ((looking-at "^[ \t]*$") |
| 743 | (forward-line 1)) |
| 744 | ;; Ind is lesser or equal than BEG-CELL's. The list is |
| 745 | ;; over: store point as an ending position and jump to |
| 746 | ;; part 3. |
| 747 | ((<= ind (cdr beg-cell)) |
| 748 | (throw 'exit |
| 749 | (push (cons 0 (funcall end-before-blank)) end-lst-2))) |
| 750 | ;; Else, if ind is lesser or equal than previous item's, |
| 751 | ;; this is an ending position: store it. In any case, |
| 752 | ;; skip block or drawer at point, and move to next line. |
| 753 | (t |
| 754 | (when (<= ind (nth 1 (car itm-lst-2))) |
| 755 | (push (cons ind (point)) end-lst-2)) |
| 756 | (cond |
| 757 | ((and (looking-at "^[ \t]*#\\+begin_") |
| 758 | (re-search-forward "^[ \t]*#\\+end_" lim-down t))) |
| 759 | ((and (looking-at drawers-re) |
| 760 | (re-search-forward "^[ \t]*:END:" lim-down t)))) |
| 761 | (forward-line 1)))))) |
| 762 | (setq struct (append itm-lst (cdr (nreverse itm-lst-2))) |
| 763 | end-lst (append end-lst (cdr (nreverse end-lst-2)))) |
| 764 | ;; 3. Associate each item to its end position. |
| 765 | (org-list-struct-assoc-end struct end-lst) |
| 766 | ;; 4. Return STRUCT |
| 767 | struct))) |
| 768 | |
| 769 | (defun org-list-struct-assoc-end (struct end-list) |
| 770 | "Associate proper ending point to items in STRUCT. |
| 771 | |
| 772 | END-LIST is a pseudo-alist where car is indentation and cdr is |
| 773 | ending position. |
| 774 | |
| 775 | This function modifies STRUCT." |
| 776 | (let ((endings end-list)) |
| 777 | (mapc |
| 778 | (lambda (elt) |
| 779 | (let ((pos (car elt)) |
| 780 | (ind (nth 1 elt))) |
| 781 | ;; Remove end candidates behind current item. |
| 782 | (while (or (<= (cdar endings) pos)) |
| 783 | (pop endings)) |
| 784 | ;; Add end position to item assoc. |
| 785 | (let ((old-end (nthcdr 6 elt)) |
| 786 | (new-end (assoc-default ind endings '<=))) |
| 787 | (if old-end |
| 788 | (setcar old-end new-end) |
| 789 | (setcdr elt (append (cdr elt) (list new-end))))))) |
| 790 | struct))) |
| 791 | |
| 792 | (defun org-list-prevs-alist (struct) |
| 793 | "Return alist between item and previous item in STRUCT." |
| 794 | (let ((item-end-alist (mapcar (lambda (e) (cons (car e) (nth 6 e))) |
| 795 | struct))) |
| 796 | (mapcar (lambda (e) |
| 797 | (let ((prev (car (rassq (car e) item-end-alist)))) |
| 798 | (cons (car e) prev))) |
| 799 | struct))) |
| 800 | |
| 801 | (defun org-list-parents-alist (struct) |
| 802 | "Return alist between item and parent in STRUCT." |
| 803 | (let* ((ind-to-ori (list (list (nth 1 (car struct))))) |
| 804 | (top-item (org-list-get-top-point struct)) |
| 805 | (prev-pos (list top-item))) |
| 806 | (cons prev-pos |
| 807 | (mapcar (lambda (item) |
| 808 | (let ((pos (car item)) |
| 809 | (ind (nth 1 item)) |
| 810 | (prev-ind (caar ind-to-ori))) |
| 811 | (push pos prev-pos) |
| 812 | (cond |
| 813 | ((> prev-ind ind) |
| 814 | ;; A sub-list is over. Find the associated |
| 815 | ;; origin in IND-TO-ORI. If it cannot be |
| 816 | ;; found (ill-formed list), set its parent as |
| 817 | ;; the first item less indented. If there is |
| 818 | ;; none, make it a top-level item. |
| 819 | (setq ind-to-ori |
| 820 | (or (member (assq ind ind-to-ori) ind-to-ori) |
| 821 | (catch 'exit |
| 822 | (mapc |
| 823 | (lambda (e) |
| 824 | (when (< (car e) ind) |
| 825 | (throw 'exit (member e ind-to-ori)))) |
| 826 | ind-to-ori) |
| 827 | (list (list ind))))) |
| 828 | (cons pos (cdar ind-to-ori))) |
| 829 | ;; A sub-list starts. Every item at IND will |
| 830 | ;; have previous item as its parent. |
| 831 | ((< prev-ind ind) |
| 832 | (let ((origin (nth 1 prev-pos))) |
| 833 | (push (cons ind origin) ind-to-ori) |
| 834 | (cons pos origin))) |
| 835 | ;; Another item in the same sub-list: it shares |
| 836 | ;; the same parent as the previous item. |
| 837 | (t (cons pos (cdar ind-to-ori)))))) |
| 838 | (cdr struct))))) |
| 839 | |
| 840 | |
| 841 | \f |
| 842 | ;;; Accessors |
| 843 | |
| 844 | (defsubst org-list-get-nth (n key struct) |
| 845 | "Return the Nth value of KEY in STRUCT." |
| 846 | (nth n (assq key struct))) |
| 847 | |
| 848 | (defun org-list-set-nth (n key struct new) |
| 849 | "Set the Nth value of KEY in STRUCT to NEW. |
| 850 | \nThis function modifies STRUCT." |
| 851 | (setcar (nthcdr n (assq key struct)) new)) |
| 852 | |
| 853 | (defsubst org-list-get-ind (item struct) |
| 854 | "Return indentation of ITEM in STRUCT." |
| 855 | (org-list-get-nth 1 item struct)) |
| 856 | |
| 857 | (defun org-list-set-ind (item struct ind) |
| 858 | "Set indentation of ITEM in STRUCT to IND. |
| 859 | \nThis function modifies STRUCT." |
| 860 | (org-list-set-nth 1 item struct ind)) |
| 861 | |
| 862 | (defsubst org-list-get-bullet (item struct) |
| 863 | "Return bullet of ITEM in STRUCT." |
| 864 | (org-list-get-nth 2 item struct)) |
| 865 | |
| 866 | (defun org-list-set-bullet (item struct bullet) |
| 867 | "Set bullet of ITEM in STRUCT to BULLET. |
| 868 | \nThis function modifies STRUCT." |
| 869 | (org-list-set-nth 2 item struct bullet)) |
| 870 | |
| 871 | (defsubst org-list-get-counter (item struct) |
| 872 | "Return counter of ITEM in STRUCT." |
| 873 | (org-list-get-nth 3 item struct)) |
| 874 | |
| 875 | (defsubst org-list-get-checkbox (item struct) |
| 876 | "Return checkbox of ITEM in STRUCT or nil." |
| 877 | (org-list-get-nth 4 item struct)) |
| 878 | |
| 879 | (defun org-list-set-checkbox (item struct checkbox) |
| 880 | "Set checkbox of ITEM in STRUCT to CHECKBOX. |
| 881 | \nThis function modifies STRUCT." |
| 882 | (org-list-set-nth 4 item struct checkbox)) |
| 883 | |
| 884 | (defsubst org-list-get-tag (item struct) |
| 885 | "Return end position of ITEM in STRUCT." |
| 886 | (org-list-get-nth 5 item struct)) |
| 887 | |
| 888 | (defun org-list-get-item-end (item struct) |
| 889 | "Return end position of ITEM in STRUCT." |
| 890 | (org-list-get-nth 6 item struct)) |
| 891 | |
| 892 | (defun org-list-get-item-end-before-blank (item struct) |
| 893 | "Return point at end of ITEM in STRUCT, before any blank line. |
| 894 | Point returned is at end of line." |
| 895 | (save-excursion |
| 896 | (goto-char (org-list-get-item-end item struct)) |
| 897 | (skip-chars-backward " \r\t\n") |
| 898 | (point-at-eol))) |
| 899 | |
| 900 | (defun org-list-get-parent (item struct parents) |
| 901 | "Return parent of ITEM or nil. |
| 902 | STRUCT is the list structure. PARENTS is the alist of parents, |
| 903 | as returned by `org-list-parents-alist'." |
| 904 | (let ((parents (or parents (org-list-parents-alist struct)))) |
| 905 | (cdr (assq item parents)))) |
| 906 | |
| 907 | (defun org-list-has-child-p (item struct) |
| 908 | "Non-nil if ITEM has a child. |
| 909 | |
| 910 | STRUCT is the list structure. |
| 911 | |
| 912 | Value returned is the position of the first child of ITEM." |
| 913 | (let ((ind (org-list-get-ind item struct)) |
| 914 | (child-maybe (car (nth 1 (member (assq item struct) struct))))) |
| 915 | (when (and child-maybe |
| 916 | (< ind (org-list-get-ind child-maybe struct))) |
| 917 | child-maybe))) |
| 918 | |
| 919 | (defun org-list-get-next-item (item struct prevs) |
| 920 | "Return next item in same sub-list as ITEM, or nil. |
| 921 | STRUCT is the list structure. PREVS is the alist of previous |
| 922 | items, as returned by `org-list-prevs-alist'." |
| 923 | (car (rassq item prevs))) |
| 924 | |
| 925 | (defun org-list-get-prev-item (item struct prevs) |
| 926 | "Return previous item in same sub-list as ITEM, or nil. |
| 927 | STRUCT is the list structure. PREVS is the alist of previous |
| 928 | items, as returned by `org-list-prevs-alist'." |
| 929 | (cdr (assq item prevs))) |
| 930 | |
| 931 | (defun org-list-get-subtree (item struct) |
| 932 | "List all items having ITEM as a common ancestor, or nil. |
| 933 | STRUCT is the list structure." |
| 934 | (let* ((item-end (org-list-get-item-end item struct)) |
| 935 | (sub-struct (cdr (member (assq item struct) struct))) |
| 936 | subtree) |
| 937 | (catch 'exit |
| 938 | (mapc (lambda (e) |
| 939 | (let ((pos (car e))) |
| 940 | (if (< pos item-end) (push pos subtree) (throw 'exit nil)))) |
| 941 | sub-struct)) |
| 942 | (nreverse subtree))) |
| 943 | |
| 944 | (defun org-list-get-all-items (item struct prevs) |
| 945 | "List all items in the same sub-list as ITEM. |
| 946 | STRUCT is the list structure. PREVS is the alist of previous |
| 947 | items, as returned by `org-list-prevs-alist'." |
| 948 | (let ((prev-item item) |
| 949 | (next-item item) |
| 950 | before-item after-item) |
| 951 | (while (setq prev-item (org-list-get-prev-item prev-item struct prevs)) |
| 952 | (push prev-item before-item)) |
| 953 | (while (setq next-item (org-list-get-next-item next-item struct prevs)) |
| 954 | (push next-item after-item)) |
| 955 | (append before-item (list item) (nreverse after-item)))) |
| 956 | |
| 957 | (defun org-list-get-children (item struct parents) |
| 958 | "List all children of ITEM, or nil. |
| 959 | STRUCT is the list structure. PARENTS is the alist of parents, |
| 960 | as returned by `org-list-parents-alist'." |
| 961 | (let (all child) |
| 962 | (while (setq child (car (rassq item parents))) |
| 963 | (setq parents (cdr (member (assq child parents) parents))) |
| 964 | (push child all)) |
| 965 | (nreverse all))) |
| 966 | |
| 967 | (defun org-list-get-top-point (struct) |
| 968 | "Return point at beginning of list. |
| 969 | STRUCT is the list structure." |
| 970 | (caar struct)) |
| 971 | |
| 972 | (defun org-list-get-bottom-point (struct) |
| 973 | "Return point at bottom of list. |
| 974 | STRUCT is the list structure." |
| 975 | (apply 'max |
| 976 | (mapcar (lambda (e) (org-list-get-item-end (car e) struct)) struct))) |
| 977 | |
| 978 | (defun org-list-get-list-begin (item struct prevs) |
| 979 | "Return point at beginning of sub-list ITEM belongs. |
| 980 | STRUCT is the list structure. PREVS is the alist of previous |
| 981 | items, as returned by `org-list-prevs-alist'." |
| 982 | (let ((first-item item) prev-item) |
| 983 | (while (setq prev-item (org-list-get-prev-item first-item struct prevs)) |
| 984 | (setq first-item prev-item)) |
| 985 | first-item)) |
| 986 | |
| 987 | (defalias 'org-list-get-first-item 'org-list-get-list-begin) |
| 988 | |
| 989 | (defun org-list-get-last-item (item struct prevs) |
| 990 | "Return point at last item of sub-list ITEM belongs. |
| 991 | STRUCT is the list structure. PREVS is the alist of previous |
| 992 | items, as returned by `org-list-prevs-alist'." |
| 993 | (let ((last-item item) next-item) |
| 994 | (while (setq next-item (org-list-get-next-item last-item struct prevs)) |
| 995 | (setq last-item next-item)) |
| 996 | last-item)) |
| 997 | |
| 998 | (defun org-list-get-list-end (item struct prevs) |
| 999 | "Return point at end of sub-list ITEM belongs. |
| 1000 | STRUCT is the list structure. PREVS is the alist of previous |
| 1001 | items, as returned by `org-list-prevs-alist'." |
| 1002 | (org-list-get-item-end (org-list-get-last-item item struct prevs) struct)) |
| 1003 | |
| 1004 | (defun org-list-get-list-type (item struct prevs) |
| 1005 | "Return the type of the list containing ITEM, as a symbol. |
| 1006 | |
| 1007 | STRUCT is the list structure. PREVS is the alist of previous |
| 1008 | items, as returned by `org-list-prevs-alist'. |
| 1009 | |
| 1010 | Possible types are `descriptive', `ordered' and `unordered'. The |
| 1011 | type is determined by the first item of the list." |
| 1012 | (let ((first (org-list-get-list-begin item struct prevs))) |
| 1013 | (cond |
| 1014 | ((string-match "[[:alnum:]]" (org-list-get-bullet first struct)) 'ordered) |
| 1015 | ((org-list-get-tag first struct) 'descriptive) |
| 1016 | (t 'unordered)))) |
| 1017 | |
| 1018 | (defun org-list-get-item-number (item struct prevs parents) |
| 1019 | "Return ITEM's sequence number. |
| 1020 | |
| 1021 | STRUCT is the list structure. PREVS is the alist of previous |
| 1022 | items, as returned by `org-list-prevs-alist'. PARENTS is the |
| 1023 | alist of ancestors, as returned by `org-list-parents-alist'. |
| 1024 | |
| 1025 | Return value is a list of integers. Counters have an impact on |
| 1026 | that value." |
| 1027 | (let ((get-relative-number |
| 1028 | (function |
| 1029 | (lambda (item struct prevs) |
| 1030 | ;; Return relative sequence number of ITEM in the sub-list |
| 1031 | ;; it belongs. STRUCT is the list structure. PREVS is |
| 1032 | ;; the alist of previous items. |
| 1033 | (let ((seq 0) (pos item) counter) |
| 1034 | (while (and (not (setq counter (org-list-get-counter pos struct))) |
| 1035 | (setq pos (org-list-get-prev-item pos struct prevs))) |
| 1036 | (incf seq)) |
| 1037 | (if (not counter) (1+ seq) |
| 1038 | (cond |
| 1039 | ((string-match "[A-Za-z]" counter) |
| 1040 | (+ (- (string-to-char (upcase (match-string 0 counter))) 64) |
| 1041 | seq)) |
| 1042 | ((string-match "[0-9]+" counter) |
| 1043 | (+ (string-to-number (match-string 0 counter)) seq)) |
| 1044 | (t (1+ seq))))))))) |
| 1045 | ;; Cons each parent relative number into return value (OUT). |
| 1046 | (let ((out (list (funcall get-relative-number item struct prevs))) |
| 1047 | (parent item)) |
| 1048 | (while (setq parent (org-list-get-parent parent struct parents)) |
| 1049 | (push (funcall get-relative-number parent struct prevs) out)) |
| 1050 | ;; Return value. |
| 1051 | out))) |
| 1052 | |
| 1053 | |
| 1054 | \f |
| 1055 | ;;; Searching |
| 1056 | |
| 1057 | (defun org-list-search-generic (search re bound noerr) |
| 1058 | "Search a string in valid contexts for lists. |
| 1059 | Arguments SEARCH, RE, BOUND and NOERR are similar to those used |
| 1060 | in `re-search-forward'." |
| 1061 | (catch 'exit |
| 1062 | (let ((origin (point))) |
| 1063 | (while t |
| 1064 | ;; 1. No match: return to origin or bound, depending on NOERR. |
| 1065 | (unless (funcall search re bound noerr) |
| 1066 | (throw 'exit (and (goto-char (if (memq noerr '(t nil)) origin bound)) |
| 1067 | nil))) |
| 1068 | ;; 2. Match in valid context: return point. Else, continue |
| 1069 | ;; searching. |
| 1070 | (when (org-list-in-valid-context-p) (throw 'exit (point))))))) |
| 1071 | |
| 1072 | (defun org-list-search-backward (regexp &optional bound noerror) |
| 1073 | "Like `re-search-backward' but stop only where lists are recognized. |
| 1074 | Arguments REGEXP, BOUND and NOERROR are similar to those used in |
| 1075 | `re-search-backward'." |
| 1076 | (org-list-search-generic #'re-search-backward |
| 1077 | regexp (or bound (point-min)) noerror)) |
| 1078 | |
| 1079 | (defun org-list-search-forward (regexp &optional bound noerror) |
| 1080 | "Like `re-search-forward' but stop only where lists are recognized. |
| 1081 | Arguments REGEXP, BOUND and NOERROR are similar to those used in |
| 1082 | `re-search-forward'." |
| 1083 | (org-list-search-generic #'re-search-forward |
| 1084 | regexp (or bound (point-max)) noerror)) |
| 1085 | |
| 1086 | |
| 1087 | \f |
| 1088 | ;;; Methods on structures |
| 1089 | |
| 1090 | (defsubst org-list-bullet-string (bullet) |
| 1091 | "Return BULLET with the correct number of whitespaces. |
| 1092 | It determines the number of whitespaces to append by looking at |
| 1093 | `org-list-two-spaces-after-bullet-regexp'." |
| 1094 | (save-match-data |
| 1095 | (let ((spaces (if (and org-list-two-spaces-after-bullet-regexp |
| 1096 | (string-match |
| 1097 | org-list-two-spaces-after-bullet-regexp bullet)) |
| 1098 | " " |
| 1099 | " "))) |
| 1100 | (string-match "\\S-+\\([ \t]*\\)" bullet) |
| 1101 | (replace-match spaces nil nil bullet 1)))) |
| 1102 | |
| 1103 | (defun org-list-swap-items (beg-A beg-B struct) |
| 1104 | "Swap item starting at BEG-A with item starting at BEG-B in STRUCT. |
| 1105 | |
| 1106 | Blank lines at the end of items are left in place. Item |
| 1107 | visibility is preserved. Return the new structure after the |
| 1108 | changes. |
| 1109 | |
| 1110 | Assume BEG-A is lesser than BEG-B and that BEG-A and BEG-B belong |
| 1111 | to the same sub-list. |
| 1112 | |
| 1113 | This function modifies STRUCT." |
| 1114 | (save-excursion |
| 1115 | (let* ((end-A-no-blank (org-list-get-item-end-before-blank beg-A struct)) |
| 1116 | (end-B-no-blank (org-list-get-item-end-before-blank beg-B struct)) |
| 1117 | (end-A (org-list-get-item-end beg-A struct)) |
| 1118 | (end-B (org-list-get-item-end beg-B struct)) |
| 1119 | (size-A (- end-A-no-blank beg-A)) |
| 1120 | (size-B (- end-B-no-blank beg-B)) |
| 1121 | (body-A (buffer-substring beg-A end-A-no-blank)) |
| 1122 | (body-B (buffer-substring beg-B end-B-no-blank)) |
| 1123 | (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B)) |
| 1124 | (sub-A (cons beg-A (org-list-get-subtree beg-A struct))) |
| 1125 | (sub-B (cons beg-B (org-list-get-subtree beg-B struct))) |
| 1126 | ;; Store overlays responsible for visibility status. We |
| 1127 | ;; also need to store their boundaries as they will be |
| 1128 | ;; removed from buffer. |
| 1129 | (overlays (cons |
| 1130 | (mapcar (lambda (ov) |
| 1131 | (list ov (overlay-start ov) (overlay-end ov))) |
| 1132 | (overlays-in beg-A end-A)) |
| 1133 | (mapcar (lambda (ov) |
| 1134 | (list ov (overlay-start ov) (overlay-end ov))) |
| 1135 | (overlays-in beg-B end-B))))) |
| 1136 | ;; 1. Move effectively items in buffer. |
| 1137 | (goto-char beg-A) |
| 1138 | (delete-region beg-A end-B-no-blank) |
| 1139 | (insert (concat body-B between-A-no-blank-and-B body-A)) |
| 1140 | ;; 2. Now modify struct. No need to re-read the list, the |
| 1141 | ;; transformation is just a shift of positions. Some special |
| 1142 | ;; attention is required for items ending at END-A and END-B |
| 1143 | ;; as empty spaces are not moved there. In others words, |
| 1144 | ;; item BEG-A will end with whitespaces that were at the end |
| 1145 | ;; of BEG-B and the same applies to BEG-B. |
| 1146 | (mapc (lambda (e) |
| 1147 | (let ((pos (car e))) |
| 1148 | (cond |
| 1149 | ((< pos beg-A)) |
| 1150 | ((memq pos sub-A) |
| 1151 | (let ((end-e (nth 6 e))) |
| 1152 | (setcar e (+ pos (- end-B-no-blank end-A-no-blank))) |
| 1153 | (setcar (nthcdr 6 e) |
| 1154 | (+ end-e (- end-B-no-blank end-A-no-blank))) |
| 1155 | (when (= end-e end-A) (setcar (nthcdr 6 e) end-B)))) |
| 1156 | ((memq pos sub-B) |
| 1157 | (let ((end-e (nth 6 e))) |
| 1158 | (setcar e (- (+ pos beg-A) beg-B)) |
| 1159 | (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B))) |
| 1160 | (when (= end-e end-B) |
| 1161 | (setcar (nthcdr 6 e) |
| 1162 | (+ beg-A size-B (- end-A end-A-no-blank)))))) |
| 1163 | ((< pos beg-B) |
| 1164 | (let ((end-e (nth 6 e))) |
| 1165 | (setcar e (+ pos (- size-B size-A))) |
| 1166 | (setcar (nthcdr 6 e) (+ end-e (- size-B size-A)))))))) |
| 1167 | struct) |
| 1168 | (setq struct (sort struct (lambda (e1 e2) (< (car e1) (car e2))))) |
| 1169 | ;; Restore visibility status, by moving overlays to their new |
| 1170 | ;; position. |
| 1171 | (mapc (lambda (ov) |
| 1172 | (move-overlay |
| 1173 | (car ov) |
| 1174 | (+ (nth 1 ov) (- (+ beg-B (- size-B size-A)) beg-A)) |
| 1175 | (+ (nth 2 ov) (- (+ beg-B (- size-B size-A)) beg-A)))) |
| 1176 | (car overlays)) |
| 1177 | (mapc (lambda (ov) |
| 1178 | (move-overlay (car ov) |
| 1179 | (+ (nth 1 ov) (- beg-A beg-B)) |
| 1180 | (+ (nth 2 ov) (- beg-A beg-B)))) |
| 1181 | (cdr overlays)) |
| 1182 | ;; Return structure. |
| 1183 | struct))) |
| 1184 | |
| 1185 | (defun org-list-separating-blank-lines-number (pos struct prevs) |
| 1186 | "Return number of blank lines that should separate items in list. |
| 1187 | |
| 1188 | POS is the position of point where `org-list-insert-item' was called. |
| 1189 | |
| 1190 | STRUCT is the list structure. PREVS is the alist of previous |
| 1191 | items, as returned by `org-list-prevs-alist'. |
| 1192 | |
| 1193 | Assume point is at item's beginning. If the item is alone, apply |
| 1194 | some heuristics to guess the result." |
| 1195 | (save-excursion |
| 1196 | (let ((item (point)) |
| 1197 | (insert-blank-p |
| 1198 | (cdr (assq 'plain-list-item org-blank-before-new-entry))) |
| 1199 | usr-blank |
| 1200 | (count-blanks |
| 1201 | (function |
| 1202 | (lambda () |
| 1203 | ;; Count blank lines above beginning of line. |
| 1204 | (save-excursion |
| 1205 | (count-lines (goto-char (point-at-bol)) |
| 1206 | (progn (skip-chars-backward " \r\t\n") |
| 1207 | (forward-line) |
| 1208 | (point)))))))) |
| 1209 | (cond |
| 1210 | ;; Trivial cases where there should be none. |
| 1211 | ((or org-empty-line-terminates-plain-lists (not insert-blank-p)) 0) |
| 1212 | ;; When `org-blank-before-new-entry' says so, it is 1. |
| 1213 | ((eq insert-blank-p t) 1) |
| 1214 | ;; `plain-list-item' is 'auto. Count blank lines separating |
| 1215 | ;; neighbours items in list. |
| 1216 | (t (let ((next-p (org-list-get-next-item item struct prevs))) |
| 1217 | (cond |
| 1218 | ;; Is there a next item? |
| 1219 | (next-p (goto-char next-p) |
| 1220 | (funcall count-blanks)) |
| 1221 | ;; Is there a previous item? |
| 1222 | ((org-list-get-prev-item item struct prevs) |
| 1223 | (funcall count-blanks)) |
| 1224 | ;; User inserted blank lines, trust him. |
| 1225 | ((and (> pos (org-list-get-item-end-before-blank item struct)) |
| 1226 | (> (save-excursion (goto-char pos) |
| 1227 | (setq usr-blank (funcall count-blanks))) |
| 1228 | 0)) |
| 1229 | usr-blank) |
| 1230 | ;; Are there blank lines inside the list so far? |
| 1231 | ((save-excursion |
| 1232 | (goto-char (org-list-get-top-point struct)) |
| 1233 | ;; Do not use `org-list-search-forward' so blank lines |
| 1234 | ;; in blocks can be counted in. |
| 1235 | (re-search-forward |
| 1236 | "^[ \t]*$" (org-list-get-item-end-before-blank item struct) t)) |
| 1237 | 1) |
| 1238 | ;; Default choice: no blank line. |
| 1239 | (t 0)))))))) |
| 1240 | |
| 1241 | (defun org-list-insert-item (pos struct prevs &optional checkbox after-bullet) |
| 1242 | "Insert a new list item at POS and return the new structure. |
| 1243 | If POS is before first character after bullet of the item, the |
| 1244 | new item will be created before the current one. |
| 1245 | |
| 1246 | STRUCT is the list structure. PREVS is the the alist of previous |
| 1247 | items, as returned by `org-list-prevs-alist'. |
| 1248 | |
| 1249 | Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET |
| 1250 | after the bullet. Cursor will be after this text once the |
| 1251 | function ends. |
| 1252 | |
| 1253 | This function modifies STRUCT." |
| 1254 | (let ((case-fold-search t)) |
| 1255 | ;; 1. Get information about list: position of point with regards |
| 1256 | ;; to item start (BEFOREP), blank lines number separating items |
| 1257 | ;; (BLANK-NB), if we're allowed to (SPLIT-LINE-P). |
| 1258 | (let* ((item (progn (goto-char pos) (goto-char (org-list-get-item-begin)))) |
| 1259 | (item-end (org-list-get-item-end item struct)) |
| 1260 | (item-end-no-blank (org-list-get-item-end-before-blank item struct)) |
| 1261 | (beforep |
| 1262 | (progn |
| 1263 | (looking-at org-list-full-item-re) |
| 1264 | ;; Do not count tag in a non-descriptive list. |
| 1265 | (<= pos (if (and (match-beginning 4) |
| 1266 | (save-match-data |
| 1267 | (string-match "[.)]" (match-string 1)))) |
| 1268 | (match-beginning 4) |
| 1269 | (match-end 0))))) |
| 1270 | (split-line-p (org-get-alist-option org-M-RET-may-split-line 'item)) |
| 1271 | (blank-nb (org-list-separating-blank-lines-number |
| 1272 | pos struct prevs)) |
| 1273 | ;; 2. Build the new item to be created. Concatenate same |
| 1274 | ;; bullet as item, checkbox, text AFTER-BULLET if |
| 1275 | ;; provided, and text cut from point to end of item |
| 1276 | ;; (TEXT-CUT) to form item's BODY. TEXT-CUT depends on |
| 1277 | ;; BEFOREP and SPLIT-LINE-P. The difference of size |
| 1278 | ;; between what was cut and what was inserted in buffer |
| 1279 | ;; is stored in SIZE-OFFSET. |
| 1280 | (ind (org-list-get-ind item struct)) |
| 1281 | (ind-size (if indent-tabs-mode |
| 1282 | (+ (/ ind tab-width) (mod ind tab-width)) |
| 1283 | ind)) |
| 1284 | (bullet (org-list-bullet-string (org-list-get-bullet item struct))) |
| 1285 | (box (when checkbox "[ ]")) |
| 1286 | (text-cut |
| 1287 | (and (not beforep) split-line-p |
| 1288 | (progn |
| 1289 | (goto-char pos) |
| 1290 | ;; If POS is greater than ITEM-END, then point is |
| 1291 | ;; in some white lines after the end of the list. |
| 1292 | ;; Those must be removed, or they will be left, |
| 1293 | ;; stacking up after the list. |
| 1294 | (when (< item-end pos) |
| 1295 | (delete-region (1- item-end) (point-at-eol))) |
| 1296 | (skip-chars-backward " \r\t\n") |
| 1297 | (setq pos (point)) |
| 1298 | (delete-and-extract-region pos item-end-no-blank)))) |
| 1299 | (body (concat bullet (when box (concat box " ")) after-bullet |
| 1300 | (and text-cut |
| 1301 | (if (string-match "\\`[ \t]+" text-cut) |
| 1302 | (replace-match "" t t text-cut) |
| 1303 | text-cut)))) |
| 1304 | (item-sep (make-string (1+ blank-nb) ?\n)) |
| 1305 | (item-size (+ ind-size (length body) (length item-sep))) |
| 1306 | (size-offset (- item-size (length text-cut)))) |
| 1307 | ;; 4. Insert effectively item into buffer. |
| 1308 | (goto-char item) |
| 1309 | (org-indent-to-column ind) |
| 1310 | (insert body item-sep) |
| 1311 | ;; 5. Add new item to STRUCT. |
| 1312 | (mapc (lambda (e) |
| 1313 | (let ((p (car e)) (end (nth 6 e))) |
| 1314 | (cond |
| 1315 | ;; Before inserted item, positions don't change but |
| 1316 | ;; an item ending after insertion has its end shifted |
| 1317 | ;; by SIZE-OFFSET. |
| 1318 | ((< p item) |
| 1319 | (when (> end item) (setcar (nthcdr 6 e) (+ end size-offset)))) |
| 1320 | ;; Trivial cases where current item isn't split in |
| 1321 | ;; two. Just shift every item after new one by |
| 1322 | ;; ITEM-SIZE. |
| 1323 | ((or beforep (not split-line-p)) |
| 1324 | (setcar e (+ p item-size)) |
| 1325 | (setcar (nthcdr 6 e) (+ end item-size))) |
| 1326 | ;; Item is split in two: elements before POS are just |
| 1327 | ;; shifted by ITEM-SIZE. In the case item would end |
| 1328 | ;; after split POS, ending is only shifted by |
| 1329 | ;; SIZE-OFFSET. |
| 1330 | ((< p pos) |
| 1331 | (setcar e (+ p item-size)) |
| 1332 | (if (< end pos) |
| 1333 | (setcar (nthcdr 6 e) (+ end item-size)) |
| 1334 | (setcar (nthcdr 6 e) (+ end size-offset)))) |
| 1335 | ;; Elements after POS are moved into new item. |
| 1336 | ;; Length of ITEM-SEP has to be removed as ITEM-SEP |
| 1337 | ;; doesn't appear in buffer yet. |
| 1338 | ((< p item-end) |
| 1339 | (setcar e (+ p size-offset (- item pos (length item-sep)))) |
| 1340 | (if (= end item-end) |
| 1341 | (setcar (nthcdr 6 e) (+ item item-size)) |
| 1342 | (setcar (nthcdr 6 e) |
| 1343 | (+ end size-offset |
| 1344 | (- item pos (length item-sep)))))) |
| 1345 | ;; Elements at ITEM-END or after are only shifted by |
| 1346 | ;; SIZE-OFFSET. |
| 1347 | (t (setcar e (+ p size-offset)) |
| 1348 | (setcar (nthcdr 6 e) (+ end size-offset)))))) |
| 1349 | struct) |
| 1350 | (push (list item ind bullet nil box nil (+ item item-size)) struct) |
| 1351 | (setq struct (sort struct (lambda (e1 e2) (< (car e1) (car e2))))) |
| 1352 | ;; 6. If not BEFOREP, new item must appear after ITEM, so |
| 1353 | ;; exchange ITEM with the next item in list. Position cursor |
| 1354 | ;; after bullet, counter, checkbox, and label. |
| 1355 | (if beforep |
| 1356 | (goto-char item) |
| 1357 | (setq struct (org-list-swap-items item (+ item item-size) struct)) |
| 1358 | (goto-char (org-list-get-next-item |
| 1359 | item struct (org-list-prevs-alist struct)))) |
| 1360 | struct))) |
| 1361 | |
| 1362 | (defun org-list-delete-item (item struct) |
| 1363 | "Remove ITEM from the list and return the new structure. |
| 1364 | |
| 1365 | STRUCT is the list structure." |
| 1366 | (let* ((end (org-list-get-item-end item struct)) |
| 1367 | (beg (if (= (org-list-get-bottom-point struct) end) |
| 1368 | ;; If ITEM ends with the list, delete blank lines |
| 1369 | ;; before it. |
| 1370 | (save-excursion |
| 1371 | (goto-char item) |
| 1372 | (skip-chars-backward " \r\t\n") |
| 1373 | (min (1+ (point-at-eol)) (point-max))) |
| 1374 | item))) |
| 1375 | ;; Remove item from buffer. |
| 1376 | (delete-region beg end) |
| 1377 | ;; Remove item from structure and shift others items accordingly. |
| 1378 | ;; Don't forget to shift also ending position when appropriate. |
| 1379 | (let ((size (- end beg))) |
| 1380 | (delq nil (mapcar (lambda (e) |
| 1381 | (let ((pos (car e))) |
| 1382 | (cond |
| 1383 | ((< pos item) |
| 1384 | (let ((end-e (nth 6 e))) |
| 1385 | (cond |
| 1386 | ((< end-e item) e) |
| 1387 | ((= end-e item) |
| 1388 | (append (butlast e) (list beg))) |
| 1389 | (t |
| 1390 | (append (butlast e) (list (- end-e size))))))) |
| 1391 | ((< pos end) nil) |
| 1392 | (t |
| 1393 | (cons (- pos size) |
| 1394 | (append (butlast (cdr e)) |
| 1395 | (list (- (nth 6 e) size)))))))) |
| 1396 | struct))))) |
| 1397 | |
| 1398 | (defun org-list-send-item (item dest struct) |
| 1399 | "Send ITEM to destination DEST. |
| 1400 | |
| 1401 | STRUCT is the list structure. |
| 1402 | |
| 1403 | DEST can have various values. |
| 1404 | |
| 1405 | If DEST is a buffer position, the function will assume it points |
| 1406 | to another item in the same list as ITEM, and will move the |
| 1407 | latter just before the former. |
| 1408 | |
| 1409 | If DEST is `begin' (respectively `end'), ITEM will be moved at |
| 1410 | the beginning (respectively end) of the list it belongs to. |
| 1411 | |
| 1412 | If DEST is a string like \"N\", where N is an integer, ITEM will |
| 1413 | be moved at the Nth position in the list. |
| 1414 | |
| 1415 | If DEST is `kill', ITEM will be deleted and its body will be |
| 1416 | added to the kill-ring. |
| 1417 | |
| 1418 | If DEST is `delete', ITEM will be deleted. |
| 1419 | |
| 1420 | Visibility of item is preserved. |
| 1421 | |
| 1422 | This function returns, destructively, the new list structure." |
| 1423 | (let* ((prevs (org-list-prevs-alist struct)) |
| 1424 | (item-end (org-list-get-item-end item struct)) |
| 1425 | ;; Grab full item body minus its bullet. |
| 1426 | (body (org-trim |
| 1427 | (buffer-substring |
| 1428 | (save-excursion |
| 1429 | (goto-char item) |
| 1430 | (looking-at |
| 1431 | (concat "[ \t]*" |
| 1432 | (regexp-quote (org-list-get-bullet item struct)))) |
| 1433 | (match-end 0)) |
| 1434 | item-end))) |
| 1435 | ;; Change DEST into a buffer position. A trick is needed |
| 1436 | ;; when ITEM is meant to be sent at the end of the list. |
| 1437 | ;; Indeed, by setting locally `org-M-RET-may-split-line' to |
| 1438 | ;; nil and insertion point (INS-POINT) to the first line's |
| 1439 | ;; end of the last item, we ensure the new item will be |
| 1440 | ;; inserted after the last item, and not after any of its |
| 1441 | ;; hypothetical sub-items. |
| 1442 | (ins-point (cond |
| 1443 | ((or (eq dest 'kill) (eq dest 'delete))) |
| 1444 | ((eq dest 'begin) |
| 1445 | (setq dest (org-list-get-list-begin item struct prevs))) |
| 1446 | ((eq dest 'end) |
| 1447 | (setq dest (org-list-get-list-end item struct prevs)) |
| 1448 | (save-excursion |
| 1449 | (goto-char (org-list-get-last-item item struct prevs)) |
| 1450 | (point-at-eol))) |
| 1451 | ((string-match "\\`[0-9]+\\'" dest) |
| 1452 | (let* ((all (org-list-get-all-items item struct prevs)) |
| 1453 | (len (length all)) |
| 1454 | (index (mod (string-to-number dest) len))) |
| 1455 | (if (not (zerop index)) |
| 1456 | (setq dest (nth (1- index) all)) |
| 1457 | ;; Send ITEM at the end of the list. |
| 1458 | (setq dest (org-list-get-list-end item struct prevs)) |
| 1459 | (save-excursion |
| 1460 | (goto-char |
| 1461 | (org-list-get-last-item item struct prevs)) |
| 1462 | (point-at-eol))))) |
| 1463 | (t dest))) |
| 1464 | (org-M-RET-may-split-line nil) |
| 1465 | ;; Store visibility. |
| 1466 | (visibility (overlays-in item item-end))) |
| 1467 | (cond |
| 1468 | ((eq dest 'delete) (org-list-delete-item item struct)) |
| 1469 | ((eq dest 'kill) |
| 1470 | (kill-new body) |
| 1471 | (org-list-delete-item item struct)) |
| 1472 | ((and (integerp dest) (/= item ins-point)) |
| 1473 | (setq item (copy-marker item)) |
| 1474 | (setq struct (org-list-insert-item ins-point struct prevs nil body)) |
| 1475 | ;; 1. Structure returned by `org-list-insert-item' may not be |
| 1476 | ;; accurate, as it cannot see sub-items included in BODY. |
| 1477 | ;; Thus, first compute the real structure so far. |
| 1478 | (let ((moved-items |
| 1479 | (cons (marker-position item) |
| 1480 | (org-list-get-subtree (marker-position item) struct))) |
| 1481 | (new-end (org-list-get-item-end (point) struct)) |
| 1482 | (old-end (org-list-get-item-end (marker-position item) struct)) |
| 1483 | (new-item (point)) |
| 1484 | (shift (- (point) item))) |
| 1485 | ;; 1.1. Remove the item just created in structure. |
| 1486 | (setq struct (delete (assq new-item struct) struct)) |
| 1487 | ;; 1.2. Copy ITEM and any of its sub-items at NEW-ITEM. |
| 1488 | (setq struct (sort |
| 1489 | (append |
| 1490 | struct |
| 1491 | (mapcar (lambda (e) |
| 1492 | (let* ((cell (assq e struct)) |
| 1493 | (pos (car cell)) |
| 1494 | (end (nth 6 cell))) |
| 1495 | (cons (+ pos shift) |
| 1496 | (append (butlast (cdr cell)) |
| 1497 | (list (if (= end old-end) |
| 1498 | new-end |
| 1499 | (+ end shift))))))) |
| 1500 | moved-items)) |
| 1501 | (lambda (e1 e2) (< (car e1) (car e2)))))) |
| 1502 | ;; 2. Restore visibility. |
| 1503 | (mapc (lambda (ov) |
| 1504 | (move-overlay ov |
| 1505 | (+ (overlay-start ov) (- (point) item)) |
| 1506 | (+ (overlay-end ov) (- (point) item)))) |
| 1507 | visibility) |
| 1508 | ;; 3. Eventually delete extra copy of the item and clean marker. |
| 1509 | (prog1 (org-list-delete-item (marker-position item) struct) |
| 1510 | (move-marker item nil))) |
| 1511 | (t struct)))) |
| 1512 | |
| 1513 | (defun org-list-struct-outdent (start end struct parents) |
| 1514 | "Outdent items between positions START and END. |
| 1515 | |
| 1516 | STRUCT is the list structure. PARENTS is the alist of items' |
| 1517 | parents, as returned by `org-list-parents-alist'. |
| 1518 | |
| 1519 | START is included, END excluded." |
| 1520 | (let* (acc |
| 1521 | (out (lambda (cell) |
| 1522 | (let* ((item (car cell)) |
| 1523 | (parent (cdr cell))) |
| 1524 | (cond |
| 1525 | ;; Item not yet in zone: keep association. |
| 1526 | ((< item start) cell) |
| 1527 | ;; Item out of zone: follow associations in ACC. |
| 1528 | ((>= item end) |
| 1529 | (let ((convert (and parent (assq parent acc)))) |
| 1530 | (if convert (cons item (cdr convert)) cell))) |
| 1531 | ;; Item has no parent: error |
| 1532 | ((not parent) |
| 1533 | (error "Cannot outdent top-level items")) |
| 1534 | ;; Parent is outdented: keep association. |
| 1535 | ((>= parent start) |
| 1536 | (push (cons parent item) acc) cell) |
| 1537 | (t |
| 1538 | ;; Parent isn't outdented: reparent to grand-parent. |
| 1539 | (let ((grand-parent (org-list-get-parent |
| 1540 | parent struct parents))) |
| 1541 | (push (cons parent item) acc) |
| 1542 | (cons item grand-parent)))))))) |
| 1543 | (mapcar out parents))) |
| 1544 | |
| 1545 | (defun org-list-struct-indent (start end struct parents prevs) |
| 1546 | "Indent items between positions START and END. |
| 1547 | |
| 1548 | STRUCT is the list structure. PARENTS is the alist of parents |
| 1549 | and PREVS is the alist of previous items, returned by, |
| 1550 | respectively, `org-list-parents-alist' and |
| 1551 | `org-list-prevs-alist'. |
| 1552 | |
| 1553 | START is included and END excluded. |
| 1554 | |
| 1555 | STRUCT may be modified if `org-list-demote-modify-bullet' matches |
| 1556 | bullets between START and END." |
| 1557 | (let* (acc |
| 1558 | (set-assoc (lambda (cell) (push cell acc) cell)) |
| 1559 | (change-bullet-maybe |
| 1560 | (function |
| 1561 | (lambda (item) |
| 1562 | (let ((new-bul-p |
| 1563 | (cdr (assoc |
| 1564 | ;; Normalize ordered bullets. |
| 1565 | (let ((bul (org-trim |
| 1566 | (org-list-get-bullet item struct)))) |
| 1567 | (cond ((string-match "[A-Z]\\." bul) "A.") |
| 1568 | ((string-match "[A-Z])" bul) "A)") |
| 1569 | ((string-match "[a-z]\\." bul) "a.") |
| 1570 | ((string-match "[a-z])" bul) "a)") |
| 1571 | ((string-match "[0-9]\\." bul) "1.") |
| 1572 | ((string-match "[0-9])" bul) "1)") |
| 1573 | (t bul))) |
| 1574 | org-list-demote-modify-bullet)))) |
| 1575 | (when new-bul-p (org-list-set-bullet item struct new-bul-p)))))) |
| 1576 | (ind |
| 1577 | (lambda (cell) |
| 1578 | (let* ((item (car cell)) |
| 1579 | (parent (cdr cell))) |
| 1580 | (cond |
| 1581 | ;; Item not yet in zone: keep association. |
| 1582 | ((< item start) cell) |
| 1583 | ((>= item end) |
| 1584 | ;; Item out of zone: follow associations in ACC. |
| 1585 | (let ((convert (assq parent acc))) |
| 1586 | (if convert (cons item (cdr convert)) cell))) |
| 1587 | (t |
| 1588 | ;; Item is in zone... |
| 1589 | (let ((prev (org-list-get-prev-item item struct prevs))) |
| 1590 | ;; Check if bullet needs to be changed. |
| 1591 | (funcall change-bullet-maybe item) |
| 1592 | (cond |
| 1593 | ;; First item indented but not parent: error |
| 1594 | ((and (not prev) (< parent start)) |
| 1595 | (error "Cannot indent the first item of a list")) |
| 1596 | ;; First item and parent indented: keep same |
| 1597 | ;; parent. |
| 1598 | ((not prev) (funcall set-assoc cell)) |
| 1599 | ;; Previous item not indented: reparent to it. |
| 1600 | ((< prev start) (funcall set-assoc (cons item prev))) |
| 1601 | ;; Previous item indented: reparent like it. |
| 1602 | (t |
| 1603 | (funcall set-assoc |
| 1604 | (cons item (cdr (assq prev acc))))))))))))) |
| 1605 | (mapcar ind parents))) |
| 1606 | |
| 1607 | |
| 1608 | \f |
| 1609 | ;;; Repairing structures |
| 1610 | |
| 1611 | (defun org-list-use-alpha-bul-p (first struct prevs) |
| 1612 | "Non-nil if list starting at FIRST can have alphabetical bullets. |
| 1613 | |
| 1614 | STRUCT is list structure. PREVS is the alist of previous items, |
| 1615 | as returned by `org-list-prevs-alist'." |
| 1616 | (and org-alphabetical-lists |
| 1617 | (catch 'exit |
| 1618 | (let ((item first) (ascii 64) (case-fold-search nil)) |
| 1619 | ;; Pretend that bullets are uppercase and check if alphabet |
| 1620 | ;; is sufficient, taking counters into account. |
| 1621 | (while item |
| 1622 | (let ((bul (org-list-get-bullet item struct)) |
| 1623 | (count (org-list-get-counter item struct))) |
| 1624 | ;; Virtually determine current bullet |
| 1625 | (if (and count (string-match "[a-zA-Z]" count)) |
| 1626 | ;; Counters are not case-sensitive. |
| 1627 | (setq ascii (string-to-char (upcase count))) |
| 1628 | (setq ascii (1+ ascii))) |
| 1629 | ;; Test if bullet would be over z or Z. |
| 1630 | (if (> ascii 90) |
| 1631 | (throw 'exit nil) |
| 1632 | (setq item (org-list-get-next-item item struct prevs))))) |
| 1633 | ;; All items checked. All good. |
| 1634 | t)))) |
| 1635 | |
| 1636 | (defun org-list-inc-bullet-maybe (bullet) |
| 1637 | "Increment BULLET if applicable." |
| 1638 | (let ((case-fold-search nil)) |
| 1639 | (cond |
| 1640 | ;; Num bullet: increment it. |
| 1641 | ((string-match "[0-9]+" bullet) |
| 1642 | (replace-match |
| 1643 | (number-to-string (1+ (string-to-number (match-string 0 bullet)))) |
| 1644 | nil nil bullet)) |
| 1645 | ;; Alpha bullet: increment it. |
| 1646 | ((string-match "[A-Za-z]" bullet) |
| 1647 | (replace-match |
| 1648 | (char-to-string (1+ (string-to-char (match-string 0 bullet)))) |
| 1649 | nil nil bullet)) |
| 1650 | ;; Unordered bullet: leave it. |
| 1651 | (t bullet)))) |
| 1652 | |
| 1653 | (defun org-list-struct-fix-bul (struct prevs) |
| 1654 | "Verify and correct bullets in STRUCT. |
| 1655 | PREVS is the alist of previous items, as returned by |
| 1656 | `org-list-prevs-alist'. |
| 1657 | |
| 1658 | This function modifies STRUCT." |
| 1659 | (let ((case-fold-search nil) |
| 1660 | (fix-bul |
| 1661 | (function |
| 1662 | ;; Set bullet of ITEM in STRUCT, depending on the type of |
| 1663 | ;; first item of the list, the previous bullet and counter |
| 1664 | ;; if any. |
| 1665 | (lambda (item) |
| 1666 | (let* ((prev (org-list-get-prev-item item struct prevs)) |
| 1667 | (prev-bul (and prev (org-list-get-bullet prev struct))) |
| 1668 | (counter (org-list-get-counter item struct)) |
| 1669 | (bullet (org-list-get-bullet item struct)) |
| 1670 | (alphap (and (not prev) |
| 1671 | (org-list-use-alpha-bul-p item struct prevs)))) |
| 1672 | (org-list-set-bullet |
| 1673 | item struct |
| 1674 | (org-list-bullet-string |
| 1675 | (cond |
| 1676 | ;; Alpha counter in alpha list: use counter. |
| 1677 | ((and prev counter |
| 1678 | (string-match "[a-zA-Z]" counter) |
| 1679 | (string-match "[a-zA-Z]" prev-bul)) |
| 1680 | ;; Use cond to be sure `string-match' is used in |
| 1681 | ;; both cases. |
| 1682 | (let ((real-count |
| 1683 | (cond |
| 1684 | ((string-match "[a-z]" prev-bul) (downcase counter)) |
| 1685 | ((string-match "[A-Z]" prev-bul) (upcase counter))))) |
| 1686 | (replace-match real-count nil nil prev-bul))) |
| 1687 | ;; Num counter in a num list: use counter. |
| 1688 | ((and prev counter |
| 1689 | (string-match "[0-9]+" counter) |
| 1690 | (string-match "[0-9]+" prev-bul)) |
| 1691 | (replace-match counter nil nil prev-bul)) |
| 1692 | ;; No counter: increase, if needed, previous bullet. |
| 1693 | (prev |
| 1694 | (org-list-inc-bullet-maybe (org-list-get-bullet prev struct))) |
| 1695 | ;; Alpha counter at first item: use counter. |
| 1696 | ((and counter (org-list-use-alpha-bul-p item struct prevs) |
| 1697 | (string-match "[A-Za-z]" counter) |
| 1698 | (string-match "[A-Za-z]" bullet)) |
| 1699 | (let ((real-count |
| 1700 | (cond |
| 1701 | ((string-match "[a-z]" bullet) (downcase counter)) |
| 1702 | ((string-match "[A-Z]" bullet) (upcase counter))))) |
| 1703 | (replace-match real-count nil nil bullet))) |
| 1704 | ;; Num counter at first item: use counter. |
| 1705 | ((and counter |
| 1706 | (string-match "[0-9]+" counter) |
| 1707 | (string-match "[0-9]+" bullet)) |
| 1708 | (replace-match counter nil nil bullet)) |
| 1709 | ;; First bullet is alpha uppercase: use "A". |
| 1710 | ((and alphap (string-match "[A-Z]" bullet)) |
| 1711 | (replace-match "A" nil nil bullet)) |
| 1712 | ;; First bullet is alpha lowercase: use "a". |
| 1713 | ((and alphap (string-match "[a-z]" bullet)) |
| 1714 | (replace-match "a" nil nil bullet)) |
| 1715 | ;; First bullet is num: use "1". |
| 1716 | ((string-match "\\([0-9]+\\|[A-Za-z]\\)" bullet) |
| 1717 | (replace-match "1" nil nil bullet)) |
| 1718 | ;; Not an ordered list: keep bullet. |
| 1719 | (t bullet))))))))) |
| 1720 | (mapc fix-bul (mapcar 'car struct)))) |
| 1721 | |
| 1722 | (defun org-list-struct-fix-ind (struct parents &optional bullet-size) |
| 1723 | "Verify and correct indentation in STRUCT. |
| 1724 | |
| 1725 | PARENTS is the alist of parents, as returned by |
| 1726 | `org-list-parents-alist'. |
| 1727 | |
| 1728 | If numeric optional argument BULLET-SIZE is set, assume all |
| 1729 | bullets in list have this length to determine new indentation. |
| 1730 | |
| 1731 | This function modifies STRUCT." |
| 1732 | (let* ((ancestor (org-list-get-top-point struct)) |
| 1733 | (top-ind (org-list-get-ind ancestor struct)) |
| 1734 | (new-ind |
| 1735 | (lambda (item) |
| 1736 | (let ((parent (org-list-get-parent item struct parents))) |
| 1737 | (if parent |
| 1738 | ;; Indent like parent + length of parent's bullet + |
| 1739 | ;; sub-list offset. |
| 1740 | (org-list-set-ind |
| 1741 | item struct (+ (or bullet-size |
| 1742 | (length |
| 1743 | (org-list-get-bullet parent struct))) |
| 1744 | (org-list-get-ind parent struct) |
| 1745 | org-list-indent-offset)) |
| 1746 | ;; If no parent, indent like top-point. |
| 1747 | (org-list-set-ind item struct top-ind)))))) |
| 1748 | (mapc new-ind (mapcar 'car (cdr struct))))) |
| 1749 | |
| 1750 | (defun org-list-struct-fix-box (struct parents prevs &optional ordered) |
| 1751 | "Verify and correct checkboxes in STRUCT. |
| 1752 | |
| 1753 | PARENTS is the alist of parents and PREVS is the alist of |
| 1754 | previous items, as returned by, respectively, |
| 1755 | `org-list-parents-alist' and `org-list-prevs-alist'. |
| 1756 | |
| 1757 | If ORDERED is non-nil, a checkbox can only be checked when every |
| 1758 | checkbox before it is checked too. If there was an attempt to |
| 1759 | break this rule, the function will return the blocking item. In |
| 1760 | all others cases, the return value will be nil. |
| 1761 | |
| 1762 | This function modifies STRUCT." |
| 1763 | (let ((all-items (mapcar 'car struct)) |
| 1764 | (set-parent-box |
| 1765 | (function |
| 1766 | (lambda (item) |
| 1767 | (let* ((box-list |
| 1768 | (mapcar (lambda (child) |
| 1769 | (org-list-get-checkbox child struct)) |
| 1770 | (org-list-get-children item struct parents)))) |
| 1771 | (org-list-set-checkbox |
| 1772 | item struct |
| 1773 | (cond |
| 1774 | ((and (member "[ ]" box-list) (member "[X]" box-list)) "[-]") |
| 1775 | ((member "[-]" box-list) "[-]") |
| 1776 | ((member "[X]" box-list) "[X]") |
| 1777 | ((member "[ ]" box-list) "[ ]") |
| 1778 | ;; Parent has no boxed child: leave box as-is. |
| 1779 | (t (org-list-get-checkbox item struct)))))))) |
| 1780 | parent-list) |
| 1781 | ;; 1. List all parents with a checkbox. |
| 1782 | (mapc |
| 1783 | (lambda (e) |
| 1784 | (let* ((parent (org-list-get-parent e struct parents)) |
| 1785 | (parent-box-p (org-list-get-checkbox parent struct))) |
| 1786 | (when (and parent-box-p (not (memq parent parent-list))) |
| 1787 | (push parent parent-list)))) |
| 1788 | all-items) |
| 1789 | ;; 2. Sort those parents by decreasing indentation. |
| 1790 | (setq parent-list (sort parent-list |
| 1791 | (lambda (e1 e2) |
| 1792 | (> (org-list-get-ind e1 struct) |
| 1793 | (org-list-get-ind e2 struct))))) |
| 1794 | ;; 3. For each parent, get all children's checkboxes to determine |
| 1795 | ;; and set its checkbox accordingly. |
| 1796 | (mapc set-parent-box parent-list) |
| 1797 | ;; 4. If ORDERED is set, see if we need to uncheck some boxes. |
| 1798 | (when ordered |
| 1799 | (let* ((box-list |
| 1800 | (mapcar (lambda (e) (org-list-get-checkbox e struct)) all-items)) |
| 1801 | (after-unchecked (member "[ ]" box-list))) |
| 1802 | ;; There are boxes checked after an unchecked one: fix that. |
| 1803 | (when (member "[X]" after-unchecked) |
| 1804 | (let ((index (- (length struct) (length after-unchecked)))) |
| 1805 | (mapc (lambda (e) (org-list-set-checkbox e struct "[ ]")) |
| 1806 | (nthcdr index all-items)) |
| 1807 | ;; Verify once again the structure, without ORDERED. |
| 1808 | (org-list-struct-fix-box struct parents prevs nil) |
| 1809 | ;; Return blocking item. |
| 1810 | (nth index all-items))))))) |
| 1811 | |
| 1812 | (defun org-list-struct-fix-item-end (struct) |
| 1813 | "Verify and correct each item end position in STRUCT. |
| 1814 | |
| 1815 | This function modifies STRUCT." |
| 1816 | (let (end-list acc-end) |
| 1817 | (mapc (lambda (e) |
| 1818 | (let* ((pos (car e)) |
| 1819 | (ind-pos (org-list-get-ind pos struct)) |
| 1820 | (end-pos (org-list-get-item-end pos struct))) |
| 1821 | (unless (assq end-pos struct) |
| 1822 | ;; To determine real ind of an ending position that is |
| 1823 | ;; not at an item, we have to find the item it belongs |
| 1824 | ;; to: it is the last item (ITEM-UP), whose ending is |
| 1825 | ;; further than the position we're interested in. |
| 1826 | (let ((item-up (assoc-default end-pos acc-end '>))) |
| 1827 | (push (cons |
| 1828 | ;; Else part is for the bottom point. |
| 1829 | (if item-up (+ (org-list-get-ind item-up struct) 2) 0) |
| 1830 | end-pos) |
| 1831 | end-list))) |
| 1832 | (push (cons ind-pos pos) end-list) |
| 1833 | (push (cons end-pos pos) acc-end))) |
| 1834 | struct) |
| 1835 | (setq end-list (sort end-list (lambda (e1 e2) (< (cdr e1) (cdr e2))))) |
| 1836 | (org-list-struct-assoc-end struct end-list))) |
| 1837 | |
| 1838 | (defun org-list-struct-apply-struct (struct old-struct) |
| 1839 | "Apply set difference between STRUCT and OLD-STRUCT to the buffer. |
| 1840 | |
| 1841 | OLD-STRUCT is the structure before any modifications, and STRUCT |
| 1842 | the structure to be applied. The function will only modify parts |
| 1843 | of the list which have changed. |
| 1844 | |
| 1845 | Initial position of cursor is restored after the changes." |
| 1846 | (let* ((origin (point-marker)) |
| 1847 | (inlinetask-re (and (featurep 'org-inlinetask) |
| 1848 | (org-inlinetask-outline-regexp))) |
| 1849 | (item-re (org-item-re)) |
| 1850 | (shift-body-ind |
| 1851 | (function |
| 1852 | ;; Shift the indentation between END and BEG by DELTA. |
| 1853 | ;; Start from the line before END. |
| 1854 | (lambda (end beg delta) |
| 1855 | (goto-char end) |
| 1856 | (skip-chars-backward " \r\t\n") |
| 1857 | (beginning-of-line) |
| 1858 | (while (or (> (point) beg) |
| 1859 | (and (= (point) beg) |
| 1860 | (not (looking-at item-re)))) |
| 1861 | (cond |
| 1862 | ;; Skip inline tasks. |
| 1863 | ((and inlinetask-re (looking-at inlinetask-re)) |
| 1864 | (org-inlinetask-goto-beginning)) |
| 1865 | ;; Shift only non-empty lines. |
| 1866 | ((org-looking-at-p "^[ \t]*\\S-") |
| 1867 | (let ((i (org-get-indentation))) |
| 1868 | (org-indent-line-to (+ i delta))))) |
| 1869 | (forward-line -1))))) |
| 1870 | (modify-item |
| 1871 | (function |
| 1872 | ;; Replace ITEM first line elements with new elements from |
| 1873 | ;; STRUCT, if appropriate. |
| 1874 | (lambda (item) |
| 1875 | (goto-char item) |
| 1876 | (let* ((new-ind (org-list-get-ind item struct)) |
| 1877 | (old-ind (org-get-indentation)) |
| 1878 | (new-bul (org-list-bullet-string |
| 1879 | (org-list-get-bullet item struct))) |
| 1880 | (old-bul (org-list-get-bullet item old-struct)) |
| 1881 | (new-box (org-list-get-checkbox item struct))) |
| 1882 | (looking-at org-list-full-item-re) |
| 1883 | ;; a. Replace bullet |
| 1884 | (unless (equal old-bul new-bul) |
| 1885 | (replace-match new-bul nil nil nil 1)) |
| 1886 | ;; b. Replace checkbox. |
| 1887 | (cond |
| 1888 | ((equal (match-string 3) new-box)) |
| 1889 | ((and (match-string 3) new-box) |
| 1890 | (replace-match new-box nil nil nil 3)) |
| 1891 | ((match-string 3) |
| 1892 | (looking-at ".*?\\([ \t]*\\[[ X-]\\]\\)") |
| 1893 | (replace-match "" nil nil nil 1)) |
| 1894 | (t (let ((counterp (match-end 2))) |
| 1895 | (goto-char (if counterp (1+ counterp) (match-end 1))) |
| 1896 | (insert (concat new-box (unless counterp " ")))))) |
| 1897 | ;; c. Indent item to appropriate column. |
| 1898 | (unless (= new-ind old-ind) |
| 1899 | (delete-region (goto-char (point-at-bol)) |
| 1900 | (progn (skip-chars-forward " \t") (point))) |
| 1901 | (indent-to new-ind))))))) |
| 1902 | ;; 1. First get list of items and position endings. We maintain |
| 1903 | ;; two alists: ITM-SHIFT, determining indentation shift needed |
| 1904 | ;; at item, and END-POS, a pseudo-alist where key is ending |
| 1905 | ;; position and value point. |
| 1906 | (let (end-list acc-end itm-shift all-ends sliced-struct) |
| 1907 | (mapc (lambda (e) |
| 1908 | (let* ((pos (car e)) |
| 1909 | (ind-pos (org-list-get-ind pos struct)) |
| 1910 | (ind-old (org-list-get-ind pos old-struct)) |
| 1911 | (bul-pos (org-list-get-bullet pos struct)) |
| 1912 | (bul-old (org-list-get-bullet pos old-struct)) |
| 1913 | (ind-shift (- (+ ind-pos (length bul-pos)) |
| 1914 | (+ ind-old (length bul-old)))) |
| 1915 | (end-pos (org-list-get-item-end pos old-struct))) |
| 1916 | (push (cons pos ind-shift) itm-shift) |
| 1917 | (unless (assq end-pos old-struct) |
| 1918 | ;; To determine real ind of an ending position that |
| 1919 | ;; is not at an item, we have to find the item it |
| 1920 | ;; belongs to: it is the last item (ITEM-UP), whose |
| 1921 | ;; ending is further than the position we're |
| 1922 | ;; interested in. |
| 1923 | (let ((item-up (assoc-default end-pos acc-end '>))) |
| 1924 | (push (cons end-pos item-up) end-list))) |
| 1925 | (push (cons end-pos pos) acc-end))) |
| 1926 | old-struct) |
| 1927 | ;; 2. Slice the items into parts that should be shifted by the |
| 1928 | ;; same amount of indentation. The slices are returned in |
| 1929 | ;; reverse order so changes modifying buffer do not change |
| 1930 | ;; positions they refer to. |
| 1931 | (setq all-ends (sort (append (mapcar 'car itm-shift) |
| 1932 | (org-uniquify (mapcar 'car end-list))) |
| 1933 | '<)) |
| 1934 | (while (cdr all-ends) |
| 1935 | (let* ((up (pop all-ends)) |
| 1936 | (down (car all-ends)) |
| 1937 | (ind (if (assq up struct) |
| 1938 | (cdr (assq up itm-shift)) |
| 1939 | (cdr (assq (cdr (assq up end-list)) itm-shift))))) |
| 1940 | (push (list down up ind) sliced-struct))) |
| 1941 | ;; 3. Shift each slice in buffer, provided delta isn't 0, from |
| 1942 | ;; end to beginning. Take a special action when beginning is |
| 1943 | ;; at item bullet. |
| 1944 | (mapc (lambda (e) |
| 1945 | (unless (zerop (nth 2 e)) (apply shift-body-ind e)) |
| 1946 | (let* ((beg (nth 1 e)) |
| 1947 | (cell (assq beg struct))) |
| 1948 | (unless (or (not cell) (equal cell (assq beg old-struct))) |
| 1949 | (funcall modify-item beg)))) |
| 1950 | sliced-struct)) |
| 1951 | ;; 4. Go back to initial position and clean marker. |
| 1952 | (goto-char origin) |
| 1953 | (move-marker origin nil))) |
| 1954 | |
| 1955 | (defun org-list-write-struct (struct parents &optional old-struct) |
| 1956 | "Correct bullets, checkboxes and indentation in list at point. |
| 1957 | |
| 1958 | STRUCT is the list structure. PARENTS is the alist of parents, |
| 1959 | as returned by `org-list-parents-alist'. |
| 1960 | |
| 1961 | When non-nil, optional argument OLD-STRUCT is the reference |
| 1962 | structure of the list. It should be provided whenever STRUCT |
| 1963 | doesn't correspond anymore to the real list in buffer." |
| 1964 | ;; Order of functions matters here: checkboxes and endings need |
| 1965 | ;; correct indentation to be set, and indentation needs correct |
| 1966 | ;; bullets. |
| 1967 | ;; |
| 1968 | ;; 0. Save a copy of structure before modifications |
| 1969 | (let ((old-struct (or old-struct (copy-tree struct)))) |
| 1970 | ;; 1. Set a temporary, but coherent with PARENTS, indentation in |
| 1971 | ;; order to get items endings and bullets properly |
| 1972 | (org-list-struct-fix-ind struct parents 2) |
| 1973 | ;; 2. Fix each item end to get correct prevs alist. |
| 1974 | (org-list-struct-fix-item-end struct) |
| 1975 | ;; 3. Get bullets right. |
| 1976 | (let ((prevs (org-list-prevs-alist struct))) |
| 1977 | (org-list-struct-fix-bul struct prevs) |
| 1978 | ;; 4. Now get real indentation. |
| 1979 | (org-list-struct-fix-ind struct parents) |
| 1980 | ;; 5. Eventually fix checkboxes. |
| 1981 | (org-list-struct-fix-box struct parents prevs)) |
| 1982 | ;; 6. Apply structure modifications to buffer. |
| 1983 | (org-list-struct-apply-struct struct old-struct))) |
| 1984 | |
| 1985 | |
| 1986 | \f |
| 1987 | ;;; Misc Tools |
| 1988 | |
| 1989 | (defun org-apply-on-list (function init-value &rest args) |
| 1990 | "Call FUNCTION on each item of the list at point. |
| 1991 | FUNCTION must be called with at least one argument: INIT-VALUE, |
| 1992 | that will contain the value returned by the function at the |
| 1993 | previous item, plus ARGS extra arguments. |
| 1994 | |
| 1995 | FUNCTION is applied on items in reverse order. |
| 1996 | |
| 1997 | As an example, \(org-apply-on-list \(lambda \(result\) \(1+ result\)\) 0\) |
| 1998 | will return the number of items in the current list. |
| 1999 | |
| 2000 | Sublists of the list are skipped. Cursor is always at the |
| 2001 | beginning of the item." |
| 2002 | (let* ((struct (org-list-struct)) |
| 2003 | (prevs (org-list-prevs-alist struct)) |
| 2004 | (item (copy-marker (point-at-bol))) |
| 2005 | (all (org-list-get-all-items (marker-position item) struct prevs)) |
| 2006 | (value init-value)) |
| 2007 | (mapc (lambda (e) |
| 2008 | (goto-char e) |
| 2009 | (setq value (apply function value args))) |
| 2010 | (nreverse all)) |
| 2011 | (goto-char item) |
| 2012 | (move-marker item nil) |
| 2013 | value)) |
| 2014 | |
| 2015 | (defun org-list-set-item-visibility (item struct view) |
| 2016 | "Set visibility of ITEM in STRUCT to VIEW. |
| 2017 | |
| 2018 | Possible values are: `folded', `children' or `subtree'. See |
| 2019 | `org-cycle' for more information." |
| 2020 | (cond |
| 2021 | ((eq view 'folded) |
| 2022 | (let ((item-end (org-list-get-item-end-before-blank item struct))) |
| 2023 | ;; Hide from eol |
| 2024 | (outline-flag-region (save-excursion (goto-char item) (point-at-eol)) |
| 2025 | item-end t))) |
| 2026 | ((eq view 'children) |
| 2027 | ;; First show everything. |
| 2028 | (org-list-set-item-visibility item struct 'subtree) |
| 2029 | ;; Then fold every child. |
| 2030 | (let* ((parents (org-list-parents-alist struct)) |
| 2031 | (children (org-list-get-children item struct parents))) |
| 2032 | (mapc (lambda (e) |
| 2033 | (org-list-set-item-visibility e struct 'folded)) |
| 2034 | children))) |
| 2035 | ((eq view 'subtree) |
| 2036 | ;; Show everything |
| 2037 | (let ((item-end (org-list-get-item-end item struct))) |
| 2038 | (outline-flag-region item item-end nil))))) |
| 2039 | |
| 2040 | (defun org-list-item-body-column (item) |
| 2041 | "Return column at which body of ITEM should start." |
| 2042 | (let (bpos bcol tpos tcol) |
| 2043 | (save-excursion |
| 2044 | (goto-char item) |
| 2045 | (looking-at "[ \t]*\\(\\S-+\\)\\(.*[ \t]+::\\)?\\([ \t]+\\|$\\)") |
| 2046 | (setq bpos (match-beginning 1) tpos (match-end 0) |
| 2047 | bcol (progn (goto-char bpos) (current-column)) |
| 2048 | tcol (progn (goto-char tpos) (current-column))) |
| 2049 | (when (> tcol (+ bcol org-description-max-indent)) |
| 2050 | (setq tcol (+ bcol 5)))) |
| 2051 | tcol)) |
| 2052 | |
| 2053 | |
| 2054 | \f |
| 2055 | ;;; Interactive functions |
| 2056 | |
| 2057 | (defalias 'org-list-get-item-begin 'org-in-item-p) |
| 2058 | |
| 2059 | (defun org-beginning-of-item () |
| 2060 | "Go to the beginning of the current item. |
| 2061 | Throw an error when not in a list." |
| 2062 | (interactive) |
| 2063 | (let ((begin (org-in-item-p))) |
| 2064 | (if begin (goto-char begin) (error "Not in an item")))) |
| 2065 | |
| 2066 | (defun org-beginning-of-item-list () |
| 2067 | "Go to the beginning item of the current list or sublist. |
| 2068 | Throw an error when not in a list." |
| 2069 | (interactive) |
| 2070 | (let ((begin (org-in-item-p))) |
| 2071 | (if (not begin) |
| 2072 | (error "Not in an item") |
| 2073 | (goto-char begin) |
| 2074 | (let* ((struct (org-list-struct)) |
| 2075 | (prevs (org-list-prevs-alist struct))) |
| 2076 | (goto-char (org-list-get-list-begin begin struct prevs)))))) |
| 2077 | |
| 2078 | (defun org-end-of-item-list () |
| 2079 | "Go to the end of the current list or sublist. |
| 2080 | Throw an error when not in a list." |
| 2081 | (interactive) |
| 2082 | (let ((begin (org-in-item-p))) |
| 2083 | (if (not begin) |
| 2084 | (error "Not in an item") |
| 2085 | (goto-char begin) |
| 2086 | (let* ((struct (org-list-struct)) |
| 2087 | (prevs (org-list-prevs-alist struct))) |
| 2088 | (goto-char (org-list-get-list-end begin struct prevs)))))) |
| 2089 | |
| 2090 | (defun org-end-of-item () |
| 2091 | "Go to the end of the current item. |
| 2092 | Throw an error when not in a list." |
| 2093 | (interactive) |
| 2094 | (let ((begin (org-in-item-p))) |
| 2095 | (if (not begin) |
| 2096 | (error "Not in an item") |
| 2097 | (goto-char begin) |
| 2098 | (let ((struct (org-list-struct))) |
| 2099 | (goto-char (org-list-get-item-end begin struct)))))) |
| 2100 | |
| 2101 | (defun org-previous-item () |
| 2102 | "Move to the beginning of the previous item. |
| 2103 | Throw an error when not in a list. Also throw an error when at |
| 2104 | first item, unless `org-list-use-circular-motion' is non-nil." |
| 2105 | (interactive) |
| 2106 | (let ((item (org-in-item-p))) |
| 2107 | (if (not item) |
| 2108 | (error "Not in an item") |
| 2109 | (goto-char item) |
| 2110 | (let* ((struct (org-list-struct)) |
| 2111 | (prevs (org-list-prevs-alist struct)) |
| 2112 | (prevp (org-list-get-prev-item item struct prevs))) |
| 2113 | (cond |
| 2114 | (prevp (goto-char prevp)) |
| 2115 | (org-list-use-circular-motion |
| 2116 | (goto-char (org-list-get-last-item item struct prevs))) |
| 2117 | (t (error "On first item"))))))) |
| 2118 | |
| 2119 | (defun org-next-item () |
| 2120 | "Move to the beginning of the next item. |
| 2121 | Throw an error when not in a list. Also throw an error when at |
| 2122 | last item, unless `org-list-use-circular-motion' is non-nil." |
| 2123 | (interactive) |
| 2124 | (let ((item (org-in-item-p))) |
| 2125 | (if (not item) |
| 2126 | (error "Not in an item") |
| 2127 | (goto-char item) |
| 2128 | (let* ((struct (org-list-struct)) |
| 2129 | (prevs (org-list-prevs-alist struct)) |
| 2130 | (prevp (org-list-get-next-item item struct prevs))) |
| 2131 | (cond |
| 2132 | (prevp (goto-char prevp)) |
| 2133 | (org-list-use-circular-motion |
| 2134 | (goto-char (org-list-get-first-item item struct prevs))) |
| 2135 | (t (error "On last item"))))))) |
| 2136 | |
| 2137 | (defun org-move-item-down () |
| 2138 | "Move the item at point down, i.e. swap with following item. |
| 2139 | Sub-items (items with larger indentation) are considered part of |
| 2140 | the item, so this really moves item trees." |
| 2141 | (interactive) |
| 2142 | (unless (org-at-item-p) (error "Not at an item")) |
| 2143 | (let* ((col (current-column)) |
| 2144 | (item (point-at-bol)) |
| 2145 | (struct (org-list-struct)) |
| 2146 | (prevs (org-list-prevs-alist struct)) |
| 2147 | (next-item (org-list-get-next-item (point-at-bol) struct prevs))) |
| 2148 | (unless (or next-item org-list-use-circular-motion) |
| 2149 | (error "Cannot move this item further down")) |
| 2150 | (if (not next-item) |
| 2151 | (setq struct (org-list-send-item item 'begin struct)) |
| 2152 | (setq struct (org-list-swap-items item next-item struct)) |
| 2153 | (goto-char |
| 2154 | (org-list-get-next-item item struct (org-list-prevs-alist struct)))) |
| 2155 | (org-list-write-struct struct (org-list-parents-alist struct)) |
| 2156 | (org-move-to-column col))) |
| 2157 | |
| 2158 | (defun org-move-item-up () |
| 2159 | "Move the item at point up, i.e. swap with previous item. |
| 2160 | Sub-items (items with larger indentation) are considered part of |
| 2161 | the item, so this really moves item trees." |
| 2162 | (interactive) |
| 2163 | (unless (org-at-item-p) (error "Not at an item")) |
| 2164 | (let* ((col (current-column)) |
| 2165 | (item (point-at-bol)) |
| 2166 | (struct (org-list-struct)) |
| 2167 | (prevs (org-list-prevs-alist struct)) |
| 2168 | (prev-item (org-list-get-prev-item (point-at-bol) struct prevs))) |
| 2169 | (unless (or prev-item org-list-use-circular-motion) |
| 2170 | (error "Cannot move this item further up")) |
| 2171 | (if (not prev-item) |
| 2172 | (setq struct (org-list-send-item item 'end struct)) |
| 2173 | (setq struct (org-list-swap-items prev-item item struct))) |
| 2174 | (org-list-write-struct struct (org-list-parents-alist struct)) |
| 2175 | (org-move-to-column col))) |
| 2176 | |
| 2177 | (defun org-insert-item (&optional checkbox) |
| 2178 | "Insert a new item at the current level. |
| 2179 | If cursor is before first character after bullet of the item, the |
| 2180 | new item will be created before the current one. |
| 2181 | |
| 2182 | If CHECKBOX is non-nil, add a checkbox next to the bullet. |
| 2183 | |
| 2184 | Return t when things worked, nil when we are not in an item, or |
| 2185 | item is invisible." |
| 2186 | (let ((itemp (org-in-item-p)) |
| 2187 | (pos (point))) |
| 2188 | ;; If cursor isn't is a list or if list is invisible, return nil. |
| 2189 | (unless (or (not itemp) |
| 2190 | (save-excursion |
| 2191 | (goto-char itemp) |
| 2192 | (outline-invisible-p))) |
| 2193 | (if (save-excursion |
| 2194 | (goto-char itemp) |
| 2195 | (org-at-item-timer-p)) |
| 2196 | ;; Timer list: delegate to `org-timer-item'. |
| 2197 | (progn (org-timer-item) t) |
| 2198 | (let* ((struct (save-excursion (goto-char itemp) |
| 2199 | (org-list-struct))) |
| 2200 | (prevs (org-list-prevs-alist struct)) |
| 2201 | ;; If we're in a description list, ask for the new term. |
| 2202 | (desc (when (eq (org-list-get-list-type itemp struct prevs) |
| 2203 | 'descriptive) |
| 2204 | (concat (read-string "Term: ") " :: ")))) |
| 2205 | (setq struct |
| 2206 | (org-list-insert-item pos struct prevs checkbox desc)) |
| 2207 | (org-list-write-struct struct (org-list-parents-alist struct)) |
| 2208 | (when checkbox (org-update-checkbox-count-maybe)) |
| 2209 | (looking-at org-list-full-item-re) |
| 2210 | (goto-char (if (and (match-beginning 4) |
| 2211 | (save-match-data |
| 2212 | (string-match "[.)]" (match-string 1)))) |
| 2213 | (match-beginning 4) |
| 2214 | (match-end 0))) |
| 2215 | t))))) |
| 2216 | |
| 2217 | (defun org-list-repair () |
| 2218 | "Fix indentation, bullets and checkboxes is the list at point." |
| 2219 | (interactive) |
| 2220 | (unless (org-at-item-p) (error "This is not a list")) |
| 2221 | (let* ((struct (org-list-struct)) |
| 2222 | (parents (org-list-parents-alist struct))) |
| 2223 | (org-list-write-struct struct parents))) |
| 2224 | |
| 2225 | (defun org-cycle-list-bullet (&optional which) |
| 2226 | "Cycle through the different itemize/enumerate bullets. |
| 2227 | This cycle the entire list level through the sequence: |
| 2228 | |
| 2229 | `-' -> `+' -> `*' -> `1.' -> `1)' |
| 2230 | |
| 2231 | If WHICH is a valid string, use that as the new bullet. If WHICH |
| 2232 | is an integer, 0 means `-', 1 means `+' etc. If WHICH is |
| 2233 | `previous', cycle backwards." |
| 2234 | (interactive "P") |
| 2235 | (unless (org-at-item-p) (error "Not at an item")) |
| 2236 | (save-excursion |
| 2237 | (beginning-of-line) |
| 2238 | (let* ((struct (org-list-struct)) |
| 2239 | (parents (org-list-parents-alist struct)) |
| 2240 | (prevs (org-list-prevs-alist struct)) |
| 2241 | (list-beg (org-list-get-first-item (point) struct prevs)) |
| 2242 | (bullet (org-list-get-bullet list-beg struct)) |
| 2243 | (alpha-p (org-list-use-alpha-bul-p list-beg struct prevs)) |
| 2244 | (case-fold-search nil) |
| 2245 | (current (cond |
| 2246 | ((string-match "[a-z]\\." bullet) "a.") |
| 2247 | ((string-match "[a-z])" bullet) "a)") |
| 2248 | ((string-match "[A-Z]\\." bullet) "A.") |
| 2249 | ((string-match "[A-Z])" bullet) "A)") |
| 2250 | ((string-match "\\." bullet) "1.") |
| 2251 | ((string-match ")" bullet) "1)") |
| 2252 | (t (org-trim bullet)))) |
| 2253 | ;; Compute list of possible bullets, depending on context. |
| 2254 | (bullet-list |
| 2255 | (append '("-" "+" ) |
| 2256 | ;; *-bullets are not allowed at column 0. |
| 2257 | (unless (looking-at "\\S-") '("*")) |
| 2258 | ;; Description items cannot be numbered. |
| 2259 | (unless (or (eq org-plain-list-ordered-item-terminator ?\)) |
| 2260 | (org-at-item-description-p)) |
| 2261 | '("1.")) |
| 2262 | (unless (or (eq org-plain-list-ordered-item-terminator ?.) |
| 2263 | (org-at-item-description-p)) |
| 2264 | '("1)")) |
| 2265 | (unless (or (not alpha-p) |
| 2266 | (eq org-plain-list-ordered-item-terminator ?\)) |
| 2267 | (org-at-item-description-p)) |
| 2268 | '("a." "A.")) |
| 2269 | (unless (or (not alpha-p) |
| 2270 | (eq org-plain-list-ordered-item-terminator ?.) |
| 2271 | (org-at-item-description-p)) |
| 2272 | '("a)" "A)")))) |
| 2273 | (len (length bullet-list)) |
| 2274 | (item-index (- len (length (member current bullet-list)))) |
| 2275 | (get-value (lambda (index) (nth (mod index len) bullet-list))) |
| 2276 | (new (cond |
| 2277 | ((member which bullet-list) which) |
| 2278 | ((numberp which) (funcall get-value which)) |
| 2279 | ((eq 'previous which) (funcall get-value (1- item-index))) |
| 2280 | (t (funcall get-value (1+ item-index)))))) |
| 2281 | ;; Use a short variation of `org-list-write-struct' as there's |
| 2282 | ;; no need to go through all the steps. |
| 2283 | (let ((old-struct (copy-tree struct))) |
| 2284 | (org-list-set-bullet list-beg struct (org-list-bullet-string new)) |
| 2285 | (org-list-struct-fix-bul struct prevs) |
| 2286 | (org-list-struct-fix-ind struct parents) |
| 2287 | (org-list-struct-apply-struct struct old-struct))))) |
| 2288 | |
| 2289 | (defun org-toggle-checkbox (&optional toggle-presence) |
| 2290 | "Toggle the checkbox in the current line. |
| 2291 | With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. With |
| 2292 | double prefix, set checkbox to [-]. |
| 2293 | |
| 2294 | When there is an active region, toggle status or presence of the |
| 2295 | first checkbox there, and make every item inside have the same |
| 2296 | status or presence, respectively. |
| 2297 | |
| 2298 | If the cursor is in a headline, apply this to all checkbox items |
| 2299 | in the text below the heading, taking as reference the first item |
| 2300 | in subtree, ignoring drawers." |
| 2301 | (interactive "P") |
| 2302 | (save-excursion |
| 2303 | (let* (singlep |
| 2304 | block-item |
| 2305 | lim-up |
| 2306 | lim-down |
| 2307 | (drawer-re (concat "^[ \t]*:\\(" |
| 2308 | (mapconcat 'regexp-quote org-drawers "\\|") |
| 2309 | "\\):[ \t]*$")) |
| 2310 | (keyword-re (concat "^[ \t]*\\<\\(" org-scheduled-string |
| 2311 | "\\|" org-deadline-string |
| 2312 | "\\|" org-closed-string |
| 2313 | "\\|" org-clock-string "\\)" |
| 2314 | " *[[<]\\([^]>]+\\)[]>]")) |
| 2315 | (orderedp (org-entry-get nil "ORDERED")) |
| 2316 | (bounds |
| 2317 | ;; In a region, start at first item in region. |
| 2318 | (cond |
| 2319 | ((org-region-active-p) |
| 2320 | (let ((limit (region-end))) |
| 2321 | (goto-char (region-beginning)) |
| 2322 | (if (org-list-search-forward (org-item-beginning-re) limit t) |
| 2323 | (setq lim-up (point-at-bol)) |
| 2324 | (error "No item in region")) |
| 2325 | (setq lim-down (copy-marker limit)))) |
| 2326 | ((org-at-heading-p) |
| 2327 | ;; On an heading, start at first item after drawers and |
| 2328 | ;; time-stamps (scheduled, etc.). |
| 2329 | (let ((limit (save-excursion (outline-next-heading) (point)))) |
| 2330 | (forward-line 1) |
| 2331 | (while (or (looking-at drawer-re) (looking-at keyword-re)) |
| 2332 | (if (looking-at keyword-re) |
| 2333 | (forward-line 1) |
| 2334 | (re-search-forward "^[ \t]*:END:" limit nil))) |
| 2335 | (if (org-list-search-forward (org-item-beginning-re) limit t) |
| 2336 | (setq lim-up (point-at-bol)) |
| 2337 | (error "No item in subtree")) |
| 2338 | (setq lim-down (copy-marker limit)))) |
| 2339 | ;; Just one item: set SINGLEP flag. |
| 2340 | ((org-at-item-p) |
| 2341 | (setq singlep t) |
| 2342 | (setq lim-up (point-at-bol) |
| 2343 | lim-down (copy-marker (point-at-eol)))) |
| 2344 | (t (error "Not at an item or heading, and no active region")))) |
| 2345 | ;; Determine the checkbox going to be applied to all items |
| 2346 | ;; within bounds. |
| 2347 | (ref-checkbox |
| 2348 | (progn |
| 2349 | (goto-char lim-up) |
| 2350 | (let ((cbox (and (org-at-item-checkbox-p) (match-string 1)))) |
| 2351 | (cond |
| 2352 | ((equal toggle-presence '(16)) "[-]") |
| 2353 | ((equal toggle-presence '(4)) |
| 2354 | (unless cbox "[ ]")) |
| 2355 | ((equal "[X]" cbox) "[ ]") |
| 2356 | (t "[X]")))))) |
| 2357 | ;; When an item is found within bounds, grab the full list at |
| 2358 | ;; point structure, then: (1) set check-box of all its items |
| 2359 | ;; within bounds to REF-CHECKBOX, (2) fix check-boxes of the |
| 2360 | ;; whole list, (3) move point after the list. |
| 2361 | (goto-char lim-up) |
| 2362 | (while (and (< (point) lim-down) |
| 2363 | (org-list-search-forward (org-item-beginning-re) |
| 2364 | lim-down 'move)) |
| 2365 | (let* ((struct (org-list-struct)) |
| 2366 | (struct-copy (copy-tree struct)) |
| 2367 | (parents (org-list-parents-alist struct)) |
| 2368 | (prevs (org-list-prevs-alist struct)) |
| 2369 | (bottom (copy-marker (org-list-get-bottom-point struct))) |
| 2370 | (items-to-toggle (org-remove-if |
| 2371 | (lambda (e) (or (< e lim-up) (> e lim-down))) |
| 2372 | (mapcar 'car struct)))) |
| 2373 | (mapc (lambda (e) (org-list-set-checkbox |
| 2374 | e struct |
| 2375 | ;; If there is no box at item, leave as-is |
| 2376 | ;; unless function was called with C-u prefix. |
| 2377 | (let ((cur-box (org-list-get-checkbox e struct))) |
| 2378 | (if (or cur-box (equal toggle-presence '(4))) |
| 2379 | ref-checkbox |
| 2380 | cur-box)))) |
| 2381 | items-to-toggle) |
| 2382 | (setq block-item (org-list-struct-fix-box |
| 2383 | struct parents prevs orderedp)) |
| 2384 | ;; Report some problems due to ORDERED status of subtree. |
| 2385 | ;; If only one box was being checked, throw an error, else, |
| 2386 | ;; only signal problems. |
| 2387 | (cond |
| 2388 | ((and singlep block-item (> lim-up block-item)) |
| 2389 | (error |
| 2390 | "Checkbox blocked because of unchecked box at line %d" |
| 2391 | (org-current-line block-item))) |
| 2392 | (block-item |
| 2393 | (message |
| 2394 | "Checkboxes were removed due to unchecked box at line %d" |
| 2395 | (org-current-line block-item)))) |
| 2396 | (goto-char bottom) |
| 2397 | (move-marker bottom nil) |
| 2398 | (org-list-struct-apply-struct struct struct-copy))) |
| 2399 | (move-marker lim-down nil))) |
| 2400 | (org-update-checkbox-count-maybe)) |
| 2401 | |
| 2402 | (defun org-reset-checkbox-state-subtree () |
| 2403 | "Reset all checkboxes in an entry subtree." |
| 2404 | (interactive "*") |
| 2405 | (if (org-before-first-heading-p) |
| 2406 | (error "Not inside a tree") |
| 2407 | (save-restriction |
| 2408 | (save-excursion |
| 2409 | (org-narrow-to-subtree) |
| 2410 | (org-show-subtree) |
| 2411 | (goto-char (point-min)) |
| 2412 | (let ((end (point-max))) |
| 2413 | (while (< (point) end) |
| 2414 | (when (org-at-item-checkbox-p) |
| 2415 | (replace-match "[ ]" t t nil 1)) |
| 2416 | (beginning-of-line 2))) |
| 2417 | (org-update-checkbox-count-maybe 'all))))) |
| 2418 | |
| 2419 | (defun org-update-checkbox-count (&optional all) |
| 2420 | "Update the checkbox statistics in the current section. |
| 2421 | This will find all statistic cookies like [57%] and [6/12] and |
| 2422 | update them with the current numbers. |
| 2423 | |
| 2424 | With optional prefix argument ALL, do this for the whole buffer." |
| 2425 | (interactive "P") |
| 2426 | (save-excursion |
| 2427 | (let ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") |
| 2428 | (box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\(\\[[- X]\\]\\)") |
| 2429 | (recursivep |
| 2430 | (or (not org-hierarchical-checkbox-statistics) |
| 2431 | (string-match "\\<recursive\\>" |
| 2432 | (or (org-entry-get nil "COOKIE_DATA") "")))) |
| 2433 | (bounds (if all |
| 2434 | (cons (point-min) (point-max)) |
| 2435 | (cons (or (ignore-errors (org-back-to-heading t) (point)) |
| 2436 | (point-min)) |
| 2437 | (save-excursion (outline-next-heading) (point))))) |
| 2438 | (count-boxes |
| 2439 | (function |
| 2440 | ;; Return number of checked boxes and boxes of all types |
| 2441 | ;; in all structures in STRUCTS. If RECURSIVEP is |
| 2442 | ;; non-nil, also count boxes in sub-lists. If ITEM is |
| 2443 | ;; nil, count across the whole structure, else count only |
| 2444 | ;; across subtree whose ancestor is ITEM. |
| 2445 | (lambda (item structs recursivep) |
| 2446 | (let ((c-on 0) (c-all 0)) |
| 2447 | (mapc |
| 2448 | (lambda (s) |
| 2449 | (let* ((pre (org-list-prevs-alist s)) |
| 2450 | (par (org-list-parents-alist s)) |
| 2451 | (items |
| 2452 | (cond |
| 2453 | ((and recursivep item) (org-list-get-subtree item s)) |
| 2454 | (recursivep (mapcar 'car s)) |
| 2455 | (item (org-list-get-children item s par)) |
| 2456 | (t (org-list-get-all-items |
| 2457 | (org-list-get-top-point s) s pre)))) |
| 2458 | (cookies (delq nil (mapcar |
| 2459 | (lambda (e) |
| 2460 | (org-list-get-checkbox e s)) |
| 2461 | items)))) |
| 2462 | (setq c-all (+ (length cookies) c-all) |
| 2463 | c-on (+ (org-count "[X]" cookies) c-on)))) |
| 2464 | structs) |
| 2465 | (cons c-on c-all))))) |
| 2466 | (backup-end 1) |
| 2467 | cookies-list structs-bak box-num) |
| 2468 | (goto-char (car bounds)) |
| 2469 | ;; 1. Build an alist for each cookie found within BOUNDS. The |
| 2470 | ;; key will be position at beginning of cookie and values |
| 2471 | ;; ending position, format of cookie, and a cell whose car is |
| 2472 | ;; number of checked boxes to report, and cdr total number of |
| 2473 | ;; boxes. |
| 2474 | (while (re-search-forward cookie-re (cdr bounds) t) |
| 2475 | (catch 'skip |
| 2476 | (save-excursion |
| 2477 | (push |
| 2478 | (list |
| 2479 | (match-beginning 1) ; cookie start |
| 2480 | (match-end 1) ; cookie end |
| 2481 | (match-string 2) ; percent? |
| 2482 | (cond ; boxes count |
| 2483 | ;; Cookie is at an heading, but specifically for todo, |
| 2484 | ;; not for checkboxes: skip it. |
| 2485 | ((and (org-at-heading-p) |
| 2486 | (string-match "\\<todo\\>" |
| 2487 | (downcase |
| 2488 | (or (org-entry-get nil "COOKIE_DATA") "")))) |
| 2489 | (throw 'skip nil)) |
| 2490 | ;; Cookie is at an heading, but all lists before next |
| 2491 | ;; heading already have been read. Use data collected |
| 2492 | ;; in STRUCTS-BAK. This should only happen when |
| 2493 | ;; heading has more than one cookie on it. |
| 2494 | ((and (org-at-heading-p) |
| 2495 | (<= (save-excursion (outline-next-heading) (point)) |
| 2496 | backup-end)) |
| 2497 | (funcall count-boxes nil structs-bak recursivep)) |
| 2498 | ;; Cookie is at a fresh heading. Grab structure of |
| 2499 | ;; every list containing a checkbox between point and |
| 2500 | ;; next headline, and save them in STRUCTS-BAK. |
| 2501 | ((org-at-heading-p) |
| 2502 | (setq backup-end (save-excursion |
| 2503 | (outline-next-heading) (point)) |
| 2504 | structs-bak nil) |
| 2505 | (while (org-list-search-forward box-re backup-end 'move) |
| 2506 | (let* ((struct (org-list-struct)) |
| 2507 | (bottom (org-list-get-bottom-point struct))) |
| 2508 | (push struct structs-bak) |
| 2509 | (goto-char bottom))) |
| 2510 | (funcall count-boxes nil structs-bak recursivep)) |
| 2511 | ;; Cookie is at an item, and we already have list |
| 2512 | ;; structure stored in STRUCTS-BAK. |
| 2513 | ((and (org-at-item-p) |
| 2514 | (< (point-at-bol) backup-end) |
| 2515 | ;; Only lists in no special context are stored. |
| 2516 | (not (nth 2 (org-list-context)))) |
| 2517 | (funcall count-boxes (point-at-bol) structs-bak recursivep)) |
| 2518 | ;; Cookie is at an item, but we need to compute list |
| 2519 | ;; structure. |
| 2520 | ((org-at-item-p) |
| 2521 | (let ((struct (org-list-struct))) |
| 2522 | (setq backup-end (org-list-get-bottom-point struct) |
| 2523 | structs-bak (list struct))) |
| 2524 | (funcall count-boxes (point-at-bol) structs-bak recursivep)) |
| 2525 | ;; Else, cookie found is at a wrong place. Skip it. |
| 2526 | (t (throw 'skip nil)))) |
| 2527 | cookies-list)))) |
| 2528 | ;; 2. Apply alist to buffer, in reverse order so positions stay |
| 2529 | ;; unchanged after cookie modifications. |
| 2530 | (mapc (lambda (cookie) |
| 2531 | (let* ((beg (car cookie)) |
| 2532 | (end (nth 1 cookie)) |
| 2533 | (percentp (nth 2 cookie)) |
| 2534 | (checked (car (nth 3 cookie))) |
| 2535 | (total (cdr (nth 3 cookie))) |
| 2536 | (new (if percentp |
| 2537 | (format "[%d%%]" (/ (* 100 checked) |
| 2538 | (max 1 total))) |
| 2539 | (format "[%d/%d]" checked total)))) |
| 2540 | (goto-char beg) |
| 2541 | (insert new) |
| 2542 | (delete-region (point) (+ (point) (- end beg))) |
| 2543 | (when org-auto-align-tags (org-fix-tags-on-the-fly)))) |
| 2544 | cookies-list)))) |
| 2545 | |
| 2546 | (defun org-get-checkbox-statistics-face () |
| 2547 | "Select the face for checkbox statistics. |
| 2548 | The face will be `org-done' when all relevant boxes are checked. |
| 2549 | Otherwise it will be `org-todo'." |
| 2550 | (if (match-end 1) |
| 2551 | (if (equal (match-string 1) "100%") |
| 2552 | 'org-checkbox-statistics-done |
| 2553 | 'org-checkbox-statistics-todo) |
| 2554 | (if (and (> (match-end 2) (match-beginning 2)) |
| 2555 | (equal (match-string 2) (match-string 3))) |
| 2556 | 'org-checkbox-statistics-done |
| 2557 | 'org-checkbox-statistics-todo))) |
| 2558 | |
| 2559 | (defun org-update-checkbox-count-maybe (&optional all) |
| 2560 | "Update checkbox statistics unless turned off by user. |
| 2561 | With an optional argument ALL, update them in the whole buffer." |
| 2562 | (when (cdr (assq 'checkbox org-list-automatic-rules)) |
| 2563 | (org-update-checkbox-count all)) |
| 2564 | (run-hooks 'org-checkbox-statistics-hook)) |
| 2565 | |
| 2566 | (defvar org-last-indent-begin-marker (make-marker)) |
| 2567 | (defvar org-last-indent-end-marker (make-marker)) |
| 2568 | (defun org-list-indent-item-generic (arg no-subtree struct) |
| 2569 | "Indent a local list item including its children. |
| 2570 | When number ARG is a negative, item will be outdented, otherwise |
| 2571 | it will be indented. |
| 2572 | |
| 2573 | If a region is active, all items inside will be moved. |
| 2574 | |
| 2575 | If NO-SUBTREE is non-nil, only indent the item itself, not its |
| 2576 | children. |
| 2577 | |
| 2578 | STRUCT is the list structure. |
| 2579 | |
| 2580 | Return t if successful." |
| 2581 | (save-excursion |
| 2582 | (let* ((regionp (org-region-active-p)) |
| 2583 | (rbeg (and regionp (region-beginning))) |
| 2584 | (rend (and regionp (region-end))) |
| 2585 | (top (org-list-get-top-point struct)) |
| 2586 | (parents (org-list-parents-alist struct)) |
| 2587 | (prevs (org-list-prevs-alist struct)) |
| 2588 | ;; Are we going to move the whole list? |
| 2589 | (specialp |
| 2590 | (and (not regionp) |
| 2591 | (= top (point-at-bol)) |
| 2592 | (cdr (assq 'indent org-list-automatic-rules)) |
| 2593 | (if no-subtree |
| 2594 | (error |
| 2595 | "First item of list cannot move without its subtree") |
| 2596 | t)))) |
| 2597 | ;; Determine begin and end points of zone to indent. If moving |
| 2598 | ;; more than one item, save them for subsequent moves. |
| 2599 | (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) |
| 2600 | (memq this-command '(org-shiftmetaright org-shiftmetaleft))) |
| 2601 | (if regionp |
| 2602 | (progn |
| 2603 | (set-marker org-last-indent-begin-marker rbeg) |
| 2604 | (set-marker org-last-indent-end-marker rend)) |
| 2605 | (set-marker org-last-indent-begin-marker (point-at-bol)) |
| 2606 | (set-marker org-last-indent-end-marker |
| 2607 | (cond |
| 2608 | (specialp (org-list-get-bottom-point struct)) |
| 2609 | (no-subtree (1+ (point-at-bol))) |
| 2610 | (t (org-list-get-item-end (point-at-bol) struct)))))) |
| 2611 | (let* ((beg (marker-position org-last-indent-begin-marker)) |
| 2612 | (end (marker-position org-last-indent-end-marker))) |
| 2613 | (cond |
| 2614 | ;; Special case: moving top-item with indent rule. |
| 2615 | (specialp |
| 2616 | (let* ((level-skip (org-level-increment)) |
| 2617 | (offset (if (< arg 0) (- level-skip) level-skip)) |
| 2618 | (top-ind (org-list-get-ind beg struct)) |
| 2619 | (old-struct (copy-tree struct))) |
| 2620 | (if (< (+ top-ind offset) 0) |
| 2621 | (error "Cannot outdent beyond margin") |
| 2622 | ;; Change bullet if necessary. |
| 2623 | (when (and (= (+ top-ind offset) 0) |
| 2624 | (string-match "*" |
| 2625 | (org-list-get-bullet beg struct))) |
| 2626 | (org-list-set-bullet beg struct |
| 2627 | (org-list-bullet-string "-"))) |
| 2628 | ;; Shift every item by OFFSET and fix bullets. Then |
| 2629 | ;; apply changes to buffer. |
| 2630 | (mapc (lambda (e) |
| 2631 | (let ((ind (org-list-get-ind (car e) struct))) |
| 2632 | (org-list-set-ind (car e) struct (+ ind offset)))) |
| 2633 | struct) |
| 2634 | (org-list-struct-fix-bul struct prevs) |
| 2635 | (org-list-struct-apply-struct struct old-struct)))) |
| 2636 | ;; Forbidden move: |
| 2637 | ((and (< arg 0) |
| 2638 | ;; If only one item is moved, it mustn't have a child. |
| 2639 | (or (and no-subtree |
| 2640 | (not regionp) |
| 2641 | (org-list-has-child-p beg struct)) |
| 2642 | ;; If a subtree or region is moved, the last item |
| 2643 | ;; of the subtree mustn't have a child. |
| 2644 | (let ((last-item (caar |
| 2645 | (reverse |
| 2646 | (org-remove-if |
| 2647 | (lambda (e) (>= (car e) end)) |
| 2648 | struct))))) |
| 2649 | (org-list-has-child-p last-item struct)))) |
| 2650 | (error "Cannot outdent an item without its children")) |
| 2651 | ;; Normal shifting |
| 2652 | (t |
| 2653 | (let* ((new-parents |
| 2654 | (if (< arg 0) |
| 2655 | (org-list-struct-outdent beg end struct parents) |
| 2656 | (org-list-struct-indent beg end struct parents prevs)))) |
| 2657 | (org-list-write-struct struct new-parents)) |
| 2658 | (org-update-checkbox-count-maybe)))))) |
| 2659 | t) |
| 2660 | |
| 2661 | (defun org-outdent-item () |
| 2662 | "Outdent a local list item, but not its children. |
| 2663 | If a region is active, all items inside will be moved." |
| 2664 | (interactive) |
| 2665 | (let ((regionp (org-region-active-p))) |
| 2666 | (cond |
| 2667 | ((or (org-at-item-p) |
| 2668 | (and regionp |
| 2669 | (save-excursion (goto-char (region-beginning)) |
| 2670 | (org-at-item-p)))) |
| 2671 | (let ((struct (if (not regionp) (org-list-struct) |
| 2672 | (save-excursion (goto-char (region-beginning)) |
| 2673 | (org-list-struct))))) |
| 2674 | (org-list-indent-item-generic -1 t struct))) |
| 2675 | (regionp (error "Region not starting at an item")) |
| 2676 | (t (error "Not at an item"))))) |
| 2677 | |
| 2678 | (defun org-indent-item () |
| 2679 | "Indent a local list item, but not its children. |
| 2680 | If a region is active, all items inside will be moved." |
| 2681 | (interactive) |
| 2682 | (let ((regionp (org-region-active-p))) |
| 2683 | (cond |
| 2684 | ((or (org-at-item-p) |
| 2685 | (and regionp |
| 2686 | (save-excursion (goto-char (region-beginning)) |
| 2687 | (org-at-item-p)))) |
| 2688 | (let ((struct (if (not regionp) (org-list-struct) |
| 2689 | (save-excursion (goto-char (region-beginning)) |
| 2690 | (org-list-struct))))) |
| 2691 | (org-list-indent-item-generic 1 t struct))) |
| 2692 | (regionp (error "Region not starting at an item")) |
| 2693 | (t (error "Not at an item"))))) |
| 2694 | |
| 2695 | (defun org-outdent-item-tree () |
| 2696 | "Outdent a local list item including its children. |
| 2697 | If a region is active, all items inside will be moved." |
| 2698 | (interactive) |
| 2699 | (let ((regionp (org-region-active-p))) |
| 2700 | (cond |
| 2701 | ((or (org-at-item-p) |
| 2702 | (and regionp |
| 2703 | (save-excursion (goto-char (region-beginning)) |
| 2704 | (org-at-item-p)))) |
| 2705 | (let ((struct (if (not regionp) (org-list-struct) |
| 2706 | (save-excursion (goto-char (region-beginning)) |
| 2707 | (org-list-struct))))) |
| 2708 | (org-list-indent-item-generic -1 nil struct))) |
| 2709 | (regionp (error "Region not starting at an item")) |
| 2710 | (t (error "Not at an item"))))) |
| 2711 | |
| 2712 | (defun org-indent-item-tree () |
| 2713 | "Indent a local list item including its children. |
| 2714 | If a region is active, all items inside will be moved." |
| 2715 | (interactive) |
| 2716 | (let ((regionp (org-region-active-p))) |
| 2717 | (cond |
| 2718 | ((or (org-at-item-p) |
| 2719 | (and regionp |
| 2720 | (save-excursion (goto-char (region-beginning)) |
| 2721 | (org-at-item-p)))) |
| 2722 | (let ((struct (if (not regionp) (org-list-struct) |
| 2723 | (save-excursion (goto-char (region-beginning)) |
| 2724 | (org-list-struct))))) |
| 2725 | (org-list-indent-item-generic 1 nil struct))) |
| 2726 | (regionp (error "Region not starting at an item")) |
| 2727 | (t (error "Not at an item"))))) |
| 2728 | |
| 2729 | (defvar org-tab-ind-state) |
| 2730 | (defun org-cycle-item-indentation () |
| 2731 | "Cycle levels of indentation of an empty item. |
| 2732 | The first run indents the item, if applicable. Subsequent runs |
| 2733 | outdent it at meaningful levels in the list. When done, item is |
| 2734 | put back at its original position with its original bullet. |
| 2735 | |
| 2736 | Return t at each successful move." |
| 2737 | (when (org-at-item-p) |
| 2738 | (let* ((org-adapt-indentation nil) |
| 2739 | (struct (org-list-struct)) |
| 2740 | (ind (org-list-get-ind (point-at-bol) struct)) |
| 2741 | (bullet (org-trim (buffer-substring (point-at-bol) (point-at-eol))))) |
| 2742 | ;; Accept empty items or if cycle has already started. |
| 2743 | (when (or (eq last-command 'org-cycle-item-indentation) |
| 2744 | (and (save-excursion |
| 2745 | (beginning-of-line) |
| 2746 | (looking-at org-list-full-item-re)) |
| 2747 | (>= (match-end 0) (save-excursion |
| 2748 | (goto-char (org-list-get-item-end |
| 2749 | (point-at-bol) struct)) |
| 2750 | (skip-chars-backward " \r\t\n") |
| 2751 | (point))))) |
| 2752 | (setq this-command 'org-cycle-item-indentation) |
| 2753 | ;; When in the middle of the cycle, try to outdent first. If |
| 2754 | ;; it fails, and point is still at initial position, indent. |
| 2755 | ;; Else, re-create it at its original position. |
| 2756 | (if (eq last-command 'org-cycle-item-indentation) |
| 2757 | (cond |
| 2758 | ((ignore-errors (org-list-indent-item-generic -1 t struct))) |
| 2759 | ((and (= ind (car org-tab-ind-state)) |
| 2760 | (ignore-errors (org-list-indent-item-generic 1 t struct)))) |
| 2761 | (t (delete-region (point-at-bol) (point-at-eol)) |
| 2762 | (org-indent-to-column (car org-tab-ind-state)) |
| 2763 | (insert (cdr org-tab-ind-state) " ") |
| 2764 | ;; Break cycle |
| 2765 | (setq this-command 'identity))) |
| 2766 | ;; If a cycle is starting, remember indentation and bullet, |
| 2767 | ;; then try to indent. If it fails, try to outdent. |
| 2768 | (setq org-tab-ind-state (cons ind bullet)) |
| 2769 | (cond |
| 2770 | ((ignore-errors (org-list-indent-item-generic 1 t struct))) |
| 2771 | ((ignore-errors (org-list-indent-item-generic -1 t struct))) |
| 2772 | (t (error "Cannot move item")))) |
| 2773 | t)))) |
| 2774 | |
| 2775 | (defun org-sort-list (&optional with-case sorting-type getkey-func compare-func) |
| 2776 | "Sort list items. |
| 2777 | The cursor may be at any item of the list that should be sorted. |
| 2778 | Sublists are not sorted. Checkboxes, if any, are ignored. |
| 2779 | |
| 2780 | Sorting can be alphabetically, numerically, by date/time as given |
| 2781 | by a time stamp, by a property or by priority. |
| 2782 | |
| 2783 | Comparing entries ignores case by default. However, with an |
| 2784 | optional argument WITH-CASE, the sorting considers case as well. |
| 2785 | |
| 2786 | The command prompts for the sorting type unless it has been given |
| 2787 | to the function through the SORTING-TYPE argument, which needs to |
| 2788 | be a character, \(?n ?N ?a ?A ?t ?T ?f ?F). Here is the precise |
| 2789 | meaning of each character: |
| 2790 | |
| 2791 | n Numerically, by converting the beginning of the item to a number. |
| 2792 | a Alphabetically. Only the first line of item is checked. |
| 2793 | t By date/time, either the first active time stamp in the entry, if |
| 2794 | any, or by the first inactive one. In a timer list, sort the timers. |
| 2795 | |
| 2796 | Capital letters will reverse the sort order. |
| 2797 | |
| 2798 | If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies |
| 2799 | a function to be called with point at the beginning of the |
| 2800 | record. It must return either a string or a number that should |
| 2801 | serve as the sorting key for that record. It will then use |
| 2802 | COMPARE-FUNC to compare entries." |
| 2803 | (interactive "P") |
| 2804 | (let* ((case-func (if with-case 'identity 'downcase)) |
| 2805 | (struct (org-list-struct)) |
| 2806 | (prevs (org-list-prevs-alist struct)) |
| 2807 | (start (org-list-get-list-begin (point-at-bol) struct prevs)) |
| 2808 | (end (org-list-get-list-end (point-at-bol) struct prevs)) |
| 2809 | (sorting-type |
| 2810 | (progn |
| 2811 | (message |
| 2812 | "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:") |
| 2813 | (read-char-exclusive))) |
| 2814 | (getkey-func (and (= (downcase sorting-type) ?f) |
| 2815 | (intern (org-icompleting-read "Sort using function: " |
| 2816 | obarray 'fboundp t nil nil))))) |
| 2817 | (message "Sorting items...") |
| 2818 | (save-restriction |
| 2819 | (narrow-to-region start end) |
| 2820 | (goto-char (point-min)) |
| 2821 | (let* ((dcst (downcase sorting-type)) |
| 2822 | (case-fold-search nil) |
| 2823 | (now (current-time)) |
| 2824 | (sort-func (cond |
| 2825 | ((= dcst ?a) 'string<) |
| 2826 | ((= dcst ?f) compare-func) |
| 2827 | ((= dcst ?t) '<))) |
| 2828 | (next-record (lambda () |
| 2829 | (skip-chars-forward " \r\t\n") |
| 2830 | (beginning-of-line))) |
| 2831 | (end-record (lambda () |
| 2832 | (goto-char (org-list-get-item-end-before-blank |
| 2833 | (point) struct)))) |
| 2834 | (value-to-sort |
| 2835 | (lambda () |
| 2836 | (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+") |
| 2837 | (cond |
| 2838 | ((= dcst ?n) |
| 2839 | (string-to-number (buffer-substring (match-end 0) |
| 2840 | (point-at-eol)))) |
| 2841 | ((= dcst ?a) |
| 2842 | (funcall case-func |
| 2843 | (buffer-substring (match-end 0) (point-at-eol)))) |
| 2844 | ((= dcst ?t) |
| 2845 | (cond |
| 2846 | ;; If it is a timer list, convert timer to seconds |
| 2847 | ((org-at-item-timer-p) |
| 2848 | (org-timer-hms-to-secs (match-string 1))) |
| 2849 | ((or (re-search-forward org-ts-regexp (point-at-eol) t) |
| 2850 | (re-search-forward org-ts-regexp-both |
| 2851 | (point-at-eol) t)) |
| 2852 | (org-time-string-to-seconds (match-string 0))) |
| 2853 | (t (org-float-time now)))) |
| 2854 | ((= dcst ?f) |
| 2855 | (if getkey-func |
| 2856 | (let ((value (funcall getkey-func))) |
| 2857 | (if (stringp value) |
| 2858 | (funcall case-func value) |
| 2859 | value)) |
| 2860 | (error "Invalid key function `%s'" getkey-func))) |
| 2861 | (t (error "Invalid sorting type `%c'" sorting-type))))))) |
| 2862 | (sort-subr (/= dcst sorting-type) |
| 2863 | next-record |
| 2864 | end-record |
| 2865 | value-to-sort |
| 2866 | nil |
| 2867 | sort-func) |
| 2868 | ;; Read and fix list again, as `sort-subr' probably destroyed |
| 2869 | ;; its structure. |
| 2870 | (org-list-repair) |
| 2871 | (run-hooks 'org-after-sorting-entries-or-items-hook) |
| 2872 | (message "Sorting items...done"))))) |
| 2873 | |
| 2874 | |
| 2875 | \f |
| 2876 | ;;; Send and receive lists |
| 2877 | |
| 2878 | (defun org-list-parse-list (&optional delete) |
| 2879 | "Parse the list at point and maybe DELETE it. |
| 2880 | |
| 2881 | Return a list whose car is a symbol of list type, among |
| 2882 | `ordered', `unordered' and `descriptive'. Then, each item is |
| 2883 | a list whose car is counter, and cdr are strings and other |
| 2884 | sub-lists. Inside strings, check-boxes are replaced by |
| 2885 | \"[CBON]\", \"[CBOFF]\" and \"[CBTRANS]\". |
| 2886 | |
| 2887 | For example, the following list: |
| 2888 | |
| 2889 | 1. first item |
| 2890 | + sub-item one |
| 2891 | + [X] sub-item two |
| 2892 | more text in first item |
| 2893 | 2. [@3] last item |
| 2894 | |
| 2895 | will be parsed as: |
| 2896 | |
| 2897 | \(ordered |
| 2898 | \(nil \"first item\" |
| 2899 | \(unordered |
| 2900 | \(nil \"sub-item one\"\) |
| 2901 | \(nil \"[CBON] sub-item two\"\)\) |
| 2902 | \"more text in first item\"\) |
| 2903 | \(3 \"last item\"\)\) |
| 2904 | |
| 2905 | Point is left at list end." |
| 2906 | (let* ((struct (org-list-struct)) |
| 2907 | (prevs (org-list-prevs-alist struct)) |
| 2908 | (parents (org-list-parents-alist struct)) |
| 2909 | (top (org-list-get-top-point struct)) |
| 2910 | (bottom (org-list-get-bottom-point struct)) |
| 2911 | out |
| 2912 | parse-item ; for byte-compiler |
| 2913 | (get-text |
| 2914 | (function |
| 2915 | ;; Return text between BEG and END, trimmed, with |
| 2916 | ;; checkboxes replaced. |
| 2917 | (lambda (beg end) |
| 2918 | (let ((text (org-trim (buffer-substring beg end)))) |
| 2919 | (if (string-match "\\`\\[\\([-X ]\\)\\]" text) |
| 2920 | (replace-match |
| 2921 | (let ((box (match-string 1 text))) |
| 2922 | (cond |
| 2923 | ((equal box " ") "CBOFF") |
| 2924 | ((equal box "-") "CBTRANS") |
| 2925 | (t "CBON"))) |
| 2926 | t nil text 1) |
| 2927 | text))))) |
| 2928 | (parse-sublist |
| 2929 | (function |
| 2930 | ;; Return a list whose car is list type and cdr a list of |
| 2931 | ;; items' body. |
| 2932 | (lambda (e) |
| 2933 | (cons (org-list-get-list-type (car e) struct prevs) |
| 2934 | (mapcar parse-item e))))) |
| 2935 | (parse-item |
| 2936 | (function |
| 2937 | ;; Return a list containing counter of item, if any, text |
| 2938 | ;; and any sublist inside it. |
| 2939 | (lambda (e) |
| 2940 | (let ((start (save-excursion |
| 2941 | (goto-char e) |
| 2942 | (looking-at "[ \t]*\\S-+\\([ \t]+\\[@\\(start:\\)?\\([0-9]+\\|[a-zA-Z]\\)\\]\\)?[ \t]*") |
| 2943 | (match-end 0))) |
| 2944 | ;; Get counter number. For alphabetic counter, get |
| 2945 | ;; its position in the alphabet. |
| 2946 | (counter (let ((c (org-list-get-counter e struct))) |
| 2947 | (cond |
| 2948 | ((not c) nil) |
| 2949 | ((string-match "[A-Za-z]" c) |
| 2950 | (- (string-to-char (upcase (match-string 0 c))) |
| 2951 | 64)) |
| 2952 | ((string-match "[0-9]+" c) |
| 2953 | (string-to-number (match-string 0 c)))))) |
| 2954 | (childp (org-list-has-child-p e struct)) |
| 2955 | (end (org-list-get-item-end e struct))) |
| 2956 | ;; If item has a child, store text between bullet and |
| 2957 | ;; next child, then recursively parse all sublists. At |
| 2958 | ;; the end of each sublist, check for the presence of |
| 2959 | ;; text belonging to the original item. |
| 2960 | (if childp |
| 2961 | (let* ((children (org-list-get-children e struct parents)) |
| 2962 | (body (list (funcall get-text start childp)))) |
| 2963 | (while children |
| 2964 | (let* ((first (car children)) |
| 2965 | (sub (org-list-get-all-items first struct prevs)) |
| 2966 | (last-c (car (last sub))) |
| 2967 | (last-end (org-list-get-item-end last-c struct))) |
| 2968 | (push (funcall parse-sublist sub) body) |
| 2969 | ;; Remove children from the list just parsed. |
| 2970 | (setq children (cdr (member last-c children))) |
| 2971 | ;; There is a chunk of text belonging to the |
| 2972 | ;; item if last child doesn't end where next |
| 2973 | ;; child starts or where item ends. |
| 2974 | (unless (= (or (car children) end) last-end) |
| 2975 | (push (funcall get-text |
| 2976 | last-end (or (car children) end)) |
| 2977 | body)))) |
| 2978 | (cons counter (nreverse body))) |
| 2979 | (list counter (funcall get-text start end)))))))) |
| 2980 | ;; Store output, take care of cursor position and deletion of |
| 2981 | ;; list, then return output. |
| 2982 | (setq out (funcall parse-sublist (org-list-get-all-items top struct prevs))) |
| 2983 | (goto-char top) |
| 2984 | (when delete |
| 2985 | (delete-region top bottom) |
| 2986 | (when (and (not (looking-at "[ \t]*$")) (looking-at org-list-end-re)) |
| 2987 | (replace-match ""))) |
| 2988 | out)) |
| 2989 | |
| 2990 | (defun org-list-make-subtree () |
| 2991 | "Convert the plain list at point into a subtree." |
| 2992 | (interactive) |
| 2993 | (if (not (ignore-errors (goto-char (org-in-item-p)))) |
| 2994 | (error "Not in a list") |
| 2995 | (let ((list (save-excursion (org-list-parse-list t)))) |
| 2996 | (insert (org-list-to-subtree list))))) |
| 2997 | |
| 2998 | (defun org-list-insert-radio-list () |
| 2999 | "Insert a radio list template appropriate for this major mode." |
| 3000 | (interactive) |
| 3001 | (let* ((e (assq major-mode org-list-radio-list-templates)) |
| 3002 | (txt (nth 1 e)) |
| 3003 | name pos) |
| 3004 | (unless e (error "No radio list setup defined for %s" major-mode)) |
| 3005 | (setq name (read-string "List name: ")) |
| 3006 | (while (string-match "%n" txt) |
| 3007 | (setq txt (replace-match name t t txt))) |
| 3008 | (or (bolp) (insert "\n")) |
| 3009 | (setq pos (point)) |
| 3010 | (insert txt) |
| 3011 | (goto-char pos))) |
| 3012 | |
| 3013 | (defun org-list-send-list (&optional maybe) |
| 3014 | "Send a transformed version of this list to the receiver position. |
| 3015 | With argument MAYBE, fail quietly if no transformation is defined |
| 3016 | for this list." |
| 3017 | (interactive) |
| 3018 | (catch 'exit |
| 3019 | (unless (org-at-item-p) (error "Not at a list item")) |
| 3020 | (save-excursion |
| 3021 | (re-search-backward "#\\+ORGLST" nil t) |
| 3022 | (unless (looking-at "[ \t]*#\\+ORGLST[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?") |
| 3023 | (if maybe |
| 3024 | (throw 'exit nil) |
| 3025 | (error "Don't know how to transform this list")))) |
| 3026 | (let* ((name (match-string 1)) |
| 3027 | (transform (intern (match-string 2))) |
| 3028 | (bottom-point |
| 3029 | (save-excursion |
| 3030 | (re-search-forward |
| 3031 | "\\(\\\\end{comment}\\|@end ignore\\|-->\\)" nil t) |
| 3032 | (match-beginning 0))) |
| 3033 | (top-point |
| 3034 | (progn |
| 3035 | (re-search-backward "#\\+ORGLST" nil t) |
| 3036 | (re-search-forward (org-item-beginning-re) bottom-point t) |
| 3037 | (match-beginning 0))) |
| 3038 | (list (save-restriction |
| 3039 | (narrow-to-region top-point bottom-point) |
| 3040 | (org-list-parse-list))) |
| 3041 | beg txt) |
| 3042 | (unless (fboundp transform) |
| 3043 | (error "No such transformation function %s" transform)) |
| 3044 | (let ((txt (funcall transform list))) |
| 3045 | ;; Find the insertion place |
| 3046 | (save-excursion |
| 3047 | (goto-char (point-min)) |
| 3048 | (unless (re-search-forward |
| 3049 | (concat "BEGIN RECEIVE ORGLST +" |
| 3050 | name |
| 3051 | "\\([ \t]\\|$\\)") nil t) |
| 3052 | (error "Don't know where to insert translated list")) |
| 3053 | (goto-char (match-beginning 0)) |
| 3054 | (beginning-of-line 2) |
| 3055 | (setq beg (point)) |
| 3056 | (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t) |
| 3057 | (error "Cannot find end of insertion region")) |
| 3058 | (delete-region beg (point-at-bol)) |
| 3059 | (goto-char beg) |
| 3060 | (insert txt "\n"))) |
| 3061 | (message "List converted and installed at receiver location")))) |
| 3062 | |
| 3063 | (defsubst org-list-item-trim-br (item) |
| 3064 | "Trim line breaks in a list ITEM." |
| 3065 | (setq item (replace-regexp-in-string "\n +" " " item))) |
| 3066 | |
| 3067 | (defun org-list-to-generic (list params) |
| 3068 | "Convert a LIST parsed through `org-list-parse-list' to other formats. |
| 3069 | Valid parameters PARAMS are: |
| 3070 | |
| 3071 | :ustart String to start an unordered list |
| 3072 | :uend String to end an unordered list |
| 3073 | |
| 3074 | :ostart String to start an ordered list |
| 3075 | :oend String to end an ordered list |
| 3076 | |
| 3077 | :dstart String to start a descriptive list |
| 3078 | :dend String to end a descriptive list |
| 3079 | :dtstart String to start a descriptive term |
| 3080 | :dtend String to end a descriptive term |
| 3081 | :ddstart String to start a description |
| 3082 | :ddend String to end a description |
| 3083 | |
| 3084 | :splice When set to t, return only list body lines, don't wrap |
| 3085 | them into :[u/o]start and :[u/o]end. Default is nil. |
| 3086 | |
| 3087 | :istart String to start a list item. |
| 3088 | :icount String to start an item with a counter. |
| 3089 | :iend String to end a list item |
| 3090 | :isep String to separate items |
| 3091 | :lsep String to separate sublists |
| 3092 | :csep String to separate text from a sub-list |
| 3093 | |
| 3094 | :cboff String to insert for an unchecked check-box |
| 3095 | :cbon String to insert for a checked check-box |
| 3096 | :cbtrans String to insert for a check-box in transitional state |
| 3097 | |
| 3098 | :nobr Non-nil means remove line breaks in lists items. |
| 3099 | |
| 3100 | Alternatively, each parameter can also be a form returning |
| 3101 | a string. These sexp can use keywords `counter' and `depth', |
| 3102 | representing respectively counter associated to the current |
| 3103 | item, and depth of the current sub-list, starting at 0. |
| 3104 | Obviously, `counter' is only available for parameters applying to |
| 3105 | items." |
| 3106 | (interactive) |
| 3107 | (let* ((p params) |
| 3108 | (splicep (plist-get p :splice)) |
| 3109 | (ostart (plist-get p :ostart)) |
| 3110 | (oend (plist-get p :oend)) |
| 3111 | (ustart (plist-get p :ustart)) |
| 3112 | (uend (plist-get p :uend)) |
| 3113 | (dstart (plist-get p :dstart)) |
| 3114 | (dend (plist-get p :dend)) |
| 3115 | (dtstart (plist-get p :dtstart)) |
| 3116 | (dtend (plist-get p :dtend)) |
| 3117 | (ddstart (plist-get p :ddstart)) |
| 3118 | (ddend (plist-get p :ddend)) |
| 3119 | (istart (plist-get p :istart)) |
| 3120 | (icount (plist-get p :icount)) |
| 3121 | (iend (plist-get p :iend)) |
| 3122 | (isep (plist-get p :isep)) |
| 3123 | (lsep (plist-get p :lsep)) |
| 3124 | (csep (plist-get p :csep)) |
| 3125 | (cbon (plist-get p :cbon)) |
| 3126 | (cboff (plist-get p :cboff)) |
| 3127 | (cbtrans (plist-get p :cbtrans)) |
| 3128 | (nobr (plist-get p :nobr)) |
| 3129 | export-sublist ; for byte-compiler |
| 3130 | (export-item |
| 3131 | (function |
| 3132 | ;; Export an item ITEM of type TYPE, at DEPTH. First |
| 3133 | ;; string in item is treated in a special way as it can |
| 3134 | ;; bring extra information that needs to be processed. |
| 3135 | (lambda (item type depth) |
| 3136 | (let* ((counter (pop item)) |
| 3137 | (fmt (concat |
| 3138 | (cond |
| 3139 | ((eq type 'descriptive) |
| 3140 | ;; Stick DTSTART to ISTART by |
| 3141 | ;; left-trimming the latter. |
| 3142 | (concat (let ((s (eval istart))) |
| 3143 | (or (and (string-match "[ \t\n\r]+\\'" s) |
| 3144 | (replace-match "" t t s)) |
| 3145 | istart)) |
| 3146 | "%s" (eval ddend))) |
| 3147 | ((and counter (eq type 'ordered)) |
| 3148 | (concat (eval icount) "%s")) |
| 3149 | (t (concat (eval istart) "%s"))) |
| 3150 | (eval iend))) |
| 3151 | (first (car item))) |
| 3152 | ;; Replace checkbox if any is found. |
| 3153 | (cond |
| 3154 | ((string-match "\\[CBON\\]" first) |
| 3155 | (setq first (replace-match cbon t t first))) |
| 3156 | ((string-match "\\[CBOFF\\]" first) |
| 3157 | (setq first (replace-match cboff t t first))) |
| 3158 | ((string-match "\\[CBTRANS\\]" first) |
| 3159 | (setq first (replace-match cbtrans t t first)))) |
| 3160 | ;; Replace line breaks if required |
| 3161 | (when nobr (setq first (org-list-item-trim-br first))) |
| 3162 | ;; Insert descriptive term if TYPE is `descriptive'. |
| 3163 | (when (eq type 'descriptive) |
| 3164 | (let* ((complete (string-match "^\\(.*\\)[ \t]+::" first)) |
| 3165 | (term (if complete |
| 3166 | (save-match-data |
| 3167 | (org-trim (match-string 1 first))) |
| 3168 | "???")) |
| 3169 | (desc (if complete |
| 3170 | (org-trim (substring first (match-end 0))) |
| 3171 | first))) |
| 3172 | (setq first (concat (eval dtstart) term (eval dtend) |
| 3173 | (eval ddstart) desc)))) |
| 3174 | (setcar item first) |
| 3175 | (format fmt |
| 3176 | (mapconcat (lambda (e) |
| 3177 | (if (stringp e) e |
| 3178 | (funcall export-sublist e (1+ depth)))) |
| 3179 | item (or (eval csep) ""))))))) |
| 3180 | (export-sublist |
| 3181 | (function |
| 3182 | ;; Export sublist SUB at DEPTH. |
| 3183 | (lambda (sub depth) |
| 3184 | (let* ((type (car sub)) |
| 3185 | (items (cdr sub)) |
| 3186 | (fmt (concat (cond |
| 3187 | (splicep "%s") |
| 3188 | ((eq type 'ordered) |
| 3189 | (concat (eval ostart) "%s" (eval oend))) |
| 3190 | ((eq type 'descriptive) |
| 3191 | (concat (eval dstart) "%s" (eval dend))) |
| 3192 | (t (concat (eval ustart) "%s" (eval uend)))) |
| 3193 | (eval lsep)))) |
| 3194 | (format fmt (mapconcat (lambda (e) |
| 3195 | (funcall export-item e type depth)) |
| 3196 | items (or (eval isep) "")))))))) |
| 3197 | (concat (funcall export-sublist list 0) "\n"))) |
| 3198 | |
| 3199 | (defun org-list-to-latex (list &optional params) |
| 3200 | "Convert LIST into a LaTeX list. |
| 3201 | LIST is as returned by `org-list-parse-list'. PARAMS is a property list |
| 3202 | with overruling parameters for `org-list-to-generic'." |
| 3203 | (org-list-to-generic |
| 3204 | list |
| 3205 | (org-combine-plists |
| 3206 | '(:splice nil :ostart "\\begin{enumerate}\n" :oend "\\end{enumerate}" |
| 3207 | :ustart "\\begin{itemize}\n" :uend "\\end{itemize}" |
| 3208 | :dstart "\\begin{description}\n" :dend "\\end{description}" |
| 3209 | :dtstart "[" :dtend "] " |
| 3210 | :istart "\\item " :iend "\n" |
| 3211 | :icount (let ((enum (nth depth '("i" "ii" "iii" "iv")))) |
| 3212 | (if enum |
| 3213 | ;; LaTeX increments counter just before |
| 3214 | ;; using it, so set it to the desired |
| 3215 | ;; value, minus one. |
| 3216 | (format "\\setcounter{enum%s}{%s}\n\\item " |
| 3217 | enum (1- counter)) |
| 3218 | "\\item ")) |
| 3219 | :csep "\n" |
| 3220 | :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}" |
| 3221 | :cbtrans "\\texttt{[-]}") |
| 3222 | params))) |
| 3223 | |
| 3224 | (defun org-list-to-html (list &optional params) |
| 3225 | "Convert LIST into a HTML list. |
| 3226 | LIST is as returned by `org-list-parse-list'. PARAMS is a property list |
| 3227 | with overruling parameters for `org-list-to-generic'." |
| 3228 | (org-list-to-generic |
| 3229 | list |
| 3230 | (org-combine-plists |
| 3231 | '(:splice nil :ostart "<ol>\n" :oend "\n</ol>" |
| 3232 | :ustart "<ul>\n" :uend "\n</ul>" |
| 3233 | :dstart "<dl>\n" :dend "\n</dl>" |
| 3234 | :dtstart "<dt>" :dtend "</dt>\n" |
| 3235 | :ddstart "<dd>" :ddend "</dd>" |
| 3236 | :istart "<li>" :iend "</li>" |
| 3237 | :icount (format "<li value=\"%s\">" counter) |
| 3238 | :isep "\n" :lsep "\n" :csep "\n" |
| 3239 | :cbon "<code>[X]</code>" :cboff "<code>[ ]</code>" |
| 3240 | :cbtrans "<code>[-]</code>") |
| 3241 | params))) |
| 3242 | |
| 3243 | (defun org-list-to-texinfo (list &optional params) |
| 3244 | "Convert LIST into a Texinfo list. |
| 3245 | LIST is as returned by `org-list-parse-list'. PARAMS is a property list |
| 3246 | with overruling parameters for `org-list-to-generic'." |
| 3247 | (org-list-to-generic |
| 3248 | list |
| 3249 | (org-combine-plists |
| 3250 | '(:splice nil :ostart "@itemize @minus\n" :oend "@end itemize" |
| 3251 | :ustart "@enumerate\n" :uend "@end enumerate" |
| 3252 | :dstart "@table @asis\n" :dend "@end table" |
| 3253 | :dtstart " " :dtend "\n" |
| 3254 | :istart "@item\n" :iend "\n" |
| 3255 | :icount "@item\n" |
| 3256 | :csep "\n" |
| 3257 | :cbon "@code{[X]}" :cboff "@code{[ ]}" |
| 3258 | :cbtrans "@code{[-]}") |
| 3259 | params))) |
| 3260 | |
| 3261 | (defun org-list-to-subtree (list &optional params) |
| 3262 | "Convert LIST into an Org subtree. |
| 3263 | LIST is as returned by `org-list-parse-list'. PARAMS is a property list |
| 3264 | with overruling parameters for `org-list-to-generic'." |
| 3265 | (let* ((rule (cdr (assq 'heading org-blank-before-new-entry))) |
| 3266 | (level (org-reduced-level (or (org-current-level) 0))) |
| 3267 | (blankp (or (eq rule t) |
| 3268 | (and (eq rule 'auto) |
| 3269 | (save-excursion |
| 3270 | (outline-previous-heading) |
| 3271 | (org-previous-line-empty-p))))) |
| 3272 | (get-stars |
| 3273 | (function |
| 3274 | ;; Return the string for the heading, depending on depth D |
| 3275 | ;; of current sub-list. |
| 3276 | (lambda (d) |
| 3277 | (let ((oddeven-level (+ level d 1))) |
| 3278 | (concat (make-string (if org-odd-levels-only |
| 3279 | (1- (* 2 oddeven-level)) |
| 3280 | oddeven-level) |
| 3281 | ?*) |
| 3282 | " ")))))) |
| 3283 | (org-list-to-generic |
| 3284 | list |
| 3285 | (org-combine-plists |
| 3286 | '(:splice t |
| 3287 | :dtstart " " :dtend " " |
| 3288 | :istart (funcall get-stars depth) |
| 3289 | :icount (funcall get-stars depth) |
| 3290 | :isep (if blankp "\n\n" "\n") |
| 3291 | :csep (if blankp "\n\n" "\n") |
| 3292 | :cbon "DONE" :cboff "TODO" :cbtrans "TODO") |
| 3293 | params)))) |
| 3294 | |
| 3295 | (provide 'org-list) |
| 3296 | |
| 3297 | ;;; org-list.el ends here |