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