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