Commit | Line | Data |
---|---|---|
47ffc456 CD |
1 | ;;; org-list.el --- Plain lists for Org-mode |
2 | ;; | |
95df8112 | 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 | |
acedf35c | 9 | ;; Version: 7.4 |
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 | ||
31 | ;;; Code: | |
32 | ||
86fbb8ca CD |
33 | (eval-when-compile |
34 | (require 'cl)) | |
47ffc456 CD |
35 | (require 'org-macs) |
36 | (require 'org-compat) | |
37 | ||
38 | (defvar org-blank-before-new-entry) | |
39 | (defvar org-M-RET-may-split-line) | |
c8d0cf5c CD |
40 | (defvar org-complex-heading-regexp) |
41 | (defvar org-odd-levels-only) | |
afe98dfa CD |
42 | (defvar org-outline-regexp) |
43 | (defvar org-ts-regexp) | |
44 | (defvar org-ts-regexp-both) | |
47ffc456 CD |
45 | |
46 | (declare-function org-invisible-p "org" ()) | |
47 | (declare-function org-on-heading-p "org" (&optional invisible-ok)) | |
9fc10007 | 48 | (declare-function outline-next-heading "outline" ()) |
47ffc456 CD |
49 | (declare-function org-back-to-heading "org" (&optional invisible-ok)) |
50 | (declare-function org-back-over-empty-lines "org" ()) | |
47ffc456 CD |
51 | (declare-function org-trim "org" (s)) |
52 | (declare-function org-get-indentation "org" (&optional line)) | |
ff4be292 | 53 | (declare-function org-timer-item "org-timer" (&optional arg)) |
afe98dfa | 54 | (declare-function org-timer-hms-to-secs "org-timer" (hms)) |
0bd48b37 | 55 | (declare-function org-combine-plists "org" (&rest plists)) |
f1eee0b6 GM |
56 | (declare-function org-entry-get "org" |
57 | (pom property &optional inherit literal-nil)) | |
c8d0cf5c CD |
58 | (declare-function org-narrow-to-subtree "org" ()) |
59 | (declare-function org-show-subtree "org" ()) | |
afe98dfa CD |
60 | (declare-function org-in-regexps-block-p "org" |
61 | (start-re end-re &optional bound)) | |
62 | (declare-function org-level-increment "org" ()) | |
63 | (declare-function org-at-heading-p "org" (&optional ignored)) | |
64 | (declare-function outline-previous-heading "outline" ()) | |
65 | (declare-function org-icompleting-read "org" (&rest args)) | |
66 | (declare-function org-time-string-to-seconds "org" (s)) | |
47ffc456 CD |
67 | |
68 | (defgroup org-plain-lists nil | |
69 | "Options concerning plain lists in Org-mode." | |
70 | :tag "Org Plain lists" | |
71 | :group 'org-structure) | |
72 | ||
c8d0cf5c CD |
73 | (defcustom org-cycle-include-plain-lists t |
74 | "When t, make TAB cycle visibility on plain list items. | |
c8d0cf5c CD |
75 | Cycling plain lists works only when the cursor is on a plain list |
76 | item. When the cursor is on an outline heading, plain lists are | |
77 | treated as text. This is the most stable way of handling this, | |
78 | which is why it is the default. | |
79 | ||
80 | When this is the symbol `integrate', then during cycling, plain | |
81 | list items will *temporarily* be interpreted as outline headlines | |
82 | with a level given by 1000+i where i is the indentation of the | |
83 | bullet. This setting can lead to strange effects when switching | |
84 | visibility to `children', because the first \"child\" in a | |
85 | subtree decides what children should be listed. If that first | |
86 | \"child\" is a plain list item with an implied large level | |
87 | number, all true children and grand children of the outline | |
88 | heading will be exposed in a children' view." | |
47ffc456 | 89 | :group 'org-plain-lists |
c8d0cf5c CD |
90 | :type '(choice |
91 | (const :tag "Never" nil) | |
92 | (const :tag "With cursor in plain list (recommended)" t) | |
93 | (const :tag "As children of outline headings" integrate))) | |
94 | ||
95 | (defcustom org-list-demote-modify-bullet nil | |
96 | "Default bullet type installed when demoting an item. | |
97 | This is an association list, for each bullet type, this alist will point | |
86fbb8ca CD |
98 | to the bullet that should be used when this item is demoted. |
99 | For example, | |
100 | ||
101 | (setq org-list-demote-modify-bullet | |
102 | '((\"+\" . \"-\") (\"-\" . \"+\") (\"*\" . \"+\"))) | |
103 | ||
104 | will make | |
105 | ||
106 | + Movies | |
107 | + Silence of the Lambs | |
108 | + My Cousin Vinny | |
109 | + Books | |
110 | + The Hunt for Red October | |
111 | + The Road to Omaha | |
112 | ||
113 | into | |
114 | ||
115 | + Movies | |
116 | - Silence of the Lambs | |
117 | - My Cousin Vinny | |
118 | + Books | |
119 | - The Hunt for Red October | |
120 | - The Road to Omaha" | |
c8d0cf5c CD |
121 | :group 'org-plain-lists |
122 | :type '(repeat | |
123 | (cons | |
124 | (choice :tag "If the current bullet is " | |
125 | (const "-") | |
126 | (const "+") | |
127 | (const "*") | |
128 | (const "1.") | |
129 | (const "1)")) | |
130 | (choice :tag "demotion will change it to" | |
131 | (const "-") | |
132 | (const "+") | |
133 | (const "*") | |
134 | (const "1.") | |
135 | (const "1)"))))) | |
47ffc456 CD |
136 | |
137 | (defcustom org-plain-list-ordered-item-terminator t | |
138 | "The character that makes a line with leading number an ordered list item. | |
139 | Valid values are ?. and ?\). To get both terminators, use t. While | |
140 | ?. may look nicer, it creates the danger that a line with leading | |
141 | number may be incorrectly interpreted as an item. ?\) therefore is | |
142 | the safe choice." | |
143 | :group 'org-plain-lists | |
144 | :type '(choice (const :tag "dot like in \"2.\"" ?.) | |
145 | (const :tag "paren like in \"2)\"" ?\)) | |
146 | (const :tab "both" t))) | |
147 | ||
ce4fdcb9 CD |
148 | (defcustom org-list-two-spaces-after-bullet-regexp nil |
149 | "A regular expression matching bullets that should have 2 spaces after them. | |
150 | When nil, no bullet will have two spaces after them. | |
afe98dfa CD |
151 | When a string, it will be used as a regular expression. When the |
152 | bullet type of a list is changed, the new bullet type will be | |
153 | matched against this regexp. If it matches, there will be two | |
154 | spaces instead of one after the bullet in each item of the list." | |
86fbb8ca | 155 | :group 'org-plain-lists |
ce4fdcb9 CD |
156 | :type '(choice |
157 | (const :tag "never" nil) | |
158 | (regexp))) | |
159 | ||
afe98dfa CD |
160 | (defcustom org-list-ending-method 'both |
161 | "Determine where plain lists should end. | |
162 | Valid values are: `regexp', `indent' or `both'. | |
163 | ||
164 | When set to `regexp', Org will look into two variables, | |
165 | `org-empty-line-terminates-plain-lists' and the more general | |
166 | `org-list-end-regexp', to determine what will end lists. This is | |
167 | the fastest method. | |
168 | ||
169 | When set to `indent', a list will end whenever a line following | |
170 | an item, but not starting one, is less or equally indented than | |
171 | it. | |
172 | ||
173 | When set to `both', each of the preceding methods is applied to | |
174 | determine lists endings. This is the default method." | |
47ffc456 | 175 | :group 'org-plain-lists |
afe98dfa CD |
176 | :type '(choice |
177 | (const :tag "With a regexp defining ending" regexp) | |
178 | (const :tag "With indentation of regular (no bullet) text" indent) | |
179 | (const :tag "With both methods" both))) | |
47ffc456 | 180 | |
afe98dfa CD |
181 | (defcustom org-empty-line-terminates-plain-lists nil |
182 | "Non-nil means an empty line ends all plain list levels. | |
183 | This variable only makes sense if `org-list-ending-method' is set | |
184 | to `regexp' or `both'. This is then equivalent to set | |
185 | `org-list-end-regexp' to \"^[ \\t]*$\"." | |
47ffc456 CD |
186 | :group 'org-plain-lists |
187 | :type 'boolean) | |
188 | ||
afe98dfa CD |
189 | (defcustom org-list-end-regexp "^[ \t]*\n[ \t]*\n" |
190 | "Regexp matching the end of all plain list levels. | |
191 | It must start with \"^\" and end with \"\\n\". It defaults to 2 | |
192 | blank lines. `org-empty-line-terminates-plain-lists' has | |
193 | precedence over it." | |
c8d0cf5c | 194 | :group 'org-plain-lists |
afe98dfa CD |
195 | :type 'string) |
196 | ||
197 | (defcustom org-list-automatic-rules '((bullet . t) | |
198 | (checkbox . t) | |
199 | (indent . t) | |
200 | (insert . t)) | |
201 | "Non-nil means apply set of rules when acting on lists. | |
202 | By default, automatic actions are taken when using | |
203 | \\[org-meta-return], \\[org-metaright], \\[org-metaleft], | |
204 | \\[org-shiftmetaright], \\[org-shiftmetaleft], | |
205 | \\[org-ctrl-c-minus], \\[org-toggle-checkbox] or | |
206 | \\[org-insert-todo-heading]. You can disable individually these | |
207 | rules by setting them to nil. Valid rules are: | |
208 | ||
209 | bullet when non-nil, cycling bullet do not allow lists at | |
210 | column 0 to have * as a bullet and descriptions lists | |
211 | to be numbered. | |
212 | checkbox when non-nil, checkbox statistics is updated each time | |
213 | you either insert a new checkbox or toggle a checkbox. | |
214 | It also prevents from inserting a checkbox in a | |
215 | description item. | |
216 | indent when non-nil, indenting or outdenting list top-item | |
217 | with its subtree will move the whole list and | |
218 | outdenting a list whose bullet is * to column 0 will | |
219 | change that bullet to - | |
220 | insert when non-nil, trying to insert an item inside a block | |
221 | will insert it right before the block instead of | |
222 | throwing an error." | |
223 | :group 'org-plain-lists | |
224 | :type '(alist :tag "Sets of rules" | |
225 | :key-type | |
226 | (choice | |
227 | (const :tag "Bullet" bullet) | |
228 | (const :tag "Checkbox" checkbox) | |
229 | (const :tag "Indent" indent) | |
230 | (const :tag "Insert" insert)) | |
231 | :value-type | |
232 | (boolean :tag "Activate" :value t))) | |
c8d0cf5c CD |
233 | |
234 | (defcustom org-hierarchical-checkbox-statistics t | |
ed21c5c8 | 235 | "Non-nil means checkbox statistics counts only the state of direct children. |
54a0dee5 | 236 | When nil, all boxes below the cookie are counted. |
8bfe682a | 237 | This can be set to nil on a per-node basis using a COOKIE_DATA property |
54a0dee5 | 238 | with the word \"recursive\" in the value." |
47ffc456 CD |
239 | :group 'org-plain-lists |
240 | :type 'boolean) | |
241 | ||
242 | (defcustom org-description-max-indent 20 | |
243 | "Maximum indentation for the second line of a description list. | |
244 | When the indentation would be larger than this, it will become | |
245 | 5 characters instead." | |
246 | :group 'org-plain-lists | |
247 | :type 'integer) | |
248 | ||
47ffc456 CD |
249 | (defcustom org-list-radio-list-templates |
250 | '((latex-mode "% BEGIN RECEIVE ORGLST %n | |
251 | % END RECEIVE ORGLST %n | |
252 | \\begin{comment} | |
253 | #+ORGLST: SEND %n org-list-to-latex | |
86fbb8ca | 254 | - |
47ffc456 CD |
255 | \\end{comment}\n") |
256 | (texinfo-mode "@c BEGIN RECEIVE ORGLST %n | |
257 | @c END RECEIVE ORGLST %n | |
258 | @ignore | |
259 | #+ORGLST: SEND %n org-list-to-texinfo | |
86fbb8ca | 260 | - |
47ffc456 CD |
261 | @end ignore\n") |
262 | (html-mode "<!-- BEGIN RECEIVE ORGLST %n --> | |
263 | <!-- END RECEIVE ORGLST %n --> | |
264 | <!-- | |
265 | #+ORGLST: SEND %n org-list-to-html | |
86fbb8ca | 266 | - |
47ffc456 CD |
267 | -->\n")) |
268 | "Templates for radio lists in different major modes. | |
269 | All occurrences of %n in a template will be replaced with the name of the | |
270 | list, obtained by prompting the user." | |
271 | :group 'org-plain-lists | |
272 | :type '(repeat | |
273 | (list (symbol :tag "Major mode") | |
274 | (string :tag "Format")))) | |
275 | ||
afe98dfa | 276 | ;;; Internal functions |
47ffc456 | 277 | |
afe98dfa CD |
278 | (defun org-list-end-re () |
279 | "Return the regex corresponding to the end of a list. | |
280 | It depends on `org-empty-line-terminates-plain-lists'." | |
281 | (if org-empty-line-terminates-plain-lists | |
282 | "^[ \t]*\n" | |
283 | org-list-end-regexp)) | |
47ffc456 | 284 | |
86fbb8ca CD |
285 | (defun org-item-re (&optional general) |
286 | "Return the correct regular expression for plain lists. | |
287 | If GENERAL is non-nil, return the general regexp independent of the value | |
288 | of `org-plain-list-ordered-item-terminator'." | |
289 | (cond | |
290 | ((or general (eq org-plain-list-ordered-item-terminator t)) | |
afe98dfa | 291 | "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)") |
86fbb8ca | 292 | ((= org-plain-list-ordered-item-terminator ?.) |
afe98dfa | 293 | "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)") |
86fbb8ca | 294 | ((= org-plain-list-ordered-item-terminator ?\)) |
afe98dfa | 295 | "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)") |
86fbb8ca CD |
296 | (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))) |
297 | ||
afe98dfa CD |
298 | (defconst org-item-beginning-re (concat "^" (org-item-re)) |
299 | "Regexp matching the beginning of a plain list item.") | |
300 | ||
301 | (defun org-list-ending-between (min max &optional firstp) | |
302 | "Find the position of a list ending between MIN and MAX, or nil. | |
303 | This function looks for `org-list-end-re' outside a block. | |
304 | ||
305 | If FIRSTP in non-nil, return the point at the beginning of the | |
306 | nearest valid terminator from MIN. Otherwise, return the point at | |
307 | the end of the nearest terminator from MAX." | |
308 | (save-excursion | |
309 | (let* ((start (if firstp min max)) | |
310 | (end (if firstp max min)) | |
311 | (search-fun (if firstp | |
312 | #'org-search-forward-unenclosed | |
313 | #'org-search-backward-unenclosed)) | |
314 | (list-end-p (progn | |
315 | (goto-char start) | |
316 | (funcall search-fun (org-list-end-re) end t)))) | |
317 | ;; Is there a valid list ending somewhere ? | |
318 | (and list-end-p | |
319 | ;; we want to be on the first line of the list ender | |
320 | (match-beginning 0))))) | |
321 | ||
322 | (defun org-list-maybe-skip-block (search limit) | |
323 | "Return non-nil value if point is in a block, skipping it on the way. | |
324 | It looks for the boundary of the block in SEARCH direction, | |
325 | stopping at LIMIT." | |
326 | (save-match-data | |
327 | (let ((case-fold-search t) | |
328 | (boundary (if (eq search 're-search-forward) 3 5))) | |
329 | (when (save-excursion | |
330 | (and (funcall search "^[ \t]*#\\+\\(begin\\|end\\)_" limit t) | |
331 | (= (length (match-string 1)) boundary))) | |
332 | ;; We're in a block: get out of it | |
333 | (goto-char (match-beginning 0)))))) | |
334 | ||
335 | (defun org-list-search-unenclosed-generic (search re bound noerr) | |
336 | "Search a string outside blocks and protected places. | |
337 | Arguments SEARCH, RE, BOUND and NOERR are similar to those in | |
338 | `search-forward', `search-backward', `re-search-forward' and | |
339 | `re-search-backward'." | |
340 | (catch 'exit | |
341 | (let ((origin (point))) | |
342 | (while t | |
343 | ;; 1. No match: return to origin or bound, depending on NOERR. | |
344 | (unless (funcall search re bound noerr) | |
345 | (throw 'exit (and (goto-char (if (memq noerr '(t nil)) origin bound)) | |
346 | nil))) | |
347 | ;; 2. Match not in block or protected: return point. Else | |
348 | ;; skip the block and carry on. | |
349 | (unless (or (get-text-property (match-beginning 0) 'org-protected) | |
350 | (org-list-maybe-skip-block search bound)) | |
351 | (throw 'exit (point))))))) | |
352 | ||
353 | (defun org-search-backward-unenclosed (regexp &optional bound noerror) | |
354 | "Like `re-search-backward' but don't stop inside blocks or protected places. | |
355 | Arguments REGEXP, BOUND and NOERROR are similar to those used in | |
356 | `re-search-backward'." | |
357 | (org-list-search-unenclosed-generic | |
358 | #'re-search-backward regexp (or bound (point-min)) noerror)) | |
359 | ||
360 | (defun org-search-forward-unenclosed (regexp &optional bound noerror) | |
361 | "Like `re-search-forward' but don't stop inside blocks or protected places. | |
362 | Arguments REGEXP, BOUND and NOERROR are similar to those used in | |
363 | `re-search-forward'." | |
364 | (org-list-search-unenclosed-generic | |
365 | #'re-search-forward regexp (or bound (point-max)) noerror)) | |
366 | ||
367 | (defun org-list-in-item-p-with-indent (limit) | |
368 | "Is the cursor inside a plain list? | |
369 | Plain lists are considered ending when a non-blank line is less | |
370 | indented than the previous item within LIMIT." | |
371 | (save-excursion | |
372 | (beginning-of-line) | |
373 | (cond | |
374 | ;; do not start searching inside a block... | |
375 | ((org-list-maybe-skip-block #'re-search-backward limit)) | |
376 | ;; ... or at a blank line | |
377 | ((looking-at "^[ \t]*$") | |
378 | (skip-chars-backward " \r\t\n") | |
379 | (beginning-of-line))) | |
380 | (beginning-of-line) | |
381 | (or (org-at-item-p) | |
382 | (let* ((case-fold-search t) | |
383 | (ind-ref (org-get-indentation)) | |
384 | ;; Ensure there is at least an item above | |
385 | (up-item-p (save-excursion | |
386 | (org-search-backward-unenclosed | |
387 | org-item-beginning-re limit t)))) | |
388 | (and up-item-p | |
389 | (catch 'exit | |
390 | (while t | |
391 | (cond | |
392 | ((org-at-item-p) | |
393 | (throw 'exit (< (org-get-indentation) ind-ref))) | |
394 | ((looking-at "^[ \t]*$") | |
395 | (skip-chars-backward " \r\t\n") | |
396 | (beginning-of-line)) | |
397 | ((looking-at "^[ \t]*#\\+end_") | |
398 | (re-search-backward "^[ \t]*#\\+begin_")) | |
399 | (t | |
400 | (setq ind-ref (min (org-get-indentation) ind-ref)) | |
401 | (forward-line -1)))))))))) | |
402 | ||
403 | (defun org-list-in-item-p-with-regexp (limit) | |
404 | "Is the cursor inside a plain list? | |
405 | Plain lists end when `org-list-end-regexp' is matched, or at a | |
406 | blank line if `org-empty-line-terminates-plain-lists' is true. | |
407 | ||
408 | Argument LIMIT specifies the upper-bound of the search." | |
409 | (save-excursion | |
410 | (let* ((actual-pos (goto-char (point-at-eol))) | |
411 | ;; Moved to eol so current line can be matched by | |
412 | ;; `org-item-re'. | |
413 | (last-item-start (save-excursion | |
414 | (org-search-backward-unenclosed | |
415 | org-item-beginning-re limit t))) | |
416 | (list-ender (org-list-ending-between | |
417 | last-item-start actual-pos))) | |
418 | ;; We are in a list when we are on an item line or when we can | |
419 | ;; find an item before point and there is no valid list ender | |
420 | ;; between it and the point. | |
421 | (and last-item-start (not list-ender))))) | |
422 | ||
423 | (defun org-list-top-point-with-regexp (limit) | |
424 | "Return point at the top level item in a list. | |
425 | Argument LIMIT specifies the upper-bound of the search. | |
426 | ||
427 | List ending is determined by regexp. See | |
428 | `org-list-ending-method'. for more information." | |
429 | (save-excursion | |
430 | (let ((pos (point-at-eol))) | |
431 | ;; Is there some list above this one ? If so, go to its ending. | |
432 | ;; Otherwise, go back to the heading above or bob. | |
433 | (goto-char (or (org-list-ending-between limit pos) limit)) | |
434 | ;; From there, search down our list. | |
435 | (org-search-forward-unenclosed org-item-beginning-re pos t) | |
436 | (point-at-bol)))) | |
437 | ||
438 | (defun org-list-bottom-point-with-regexp (limit) | |
439 | "Return point just before list ending. | |
440 | Argument LIMIT specifies the lower-bound of the search. | |
441 | ||
442 | List ending is determined by regexp. See | |
443 | `org-list-ending-method'. for more information." | |
444 | (save-excursion | |
445 | (let ((pos (org-get-item-beginning))) | |
446 | ;; The list ending is either first point matching | |
447 | ;; `org-list-end-re', point at first white-line before next | |
448 | ;; heading, or eob. | |
449 | (or (org-list-ending-between (min pos limit) limit t) limit)))) | |
450 | ||
451 | (defun org-list-top-point-with-indent (limit) | |
452 | "Return point at the top level in a list. | |
453 | Argument LIMIT specifies the upper-bound of the search. | |
454 | ||
455 | List ending is determined by indentation of text. See | |
456 | `org-list-ending-method'. for more information." | |
457 | (save-excursion | |
458 | (let ((case-fold-search t)) | |
459 | (let ((item-ref (goto-char (org-get-item-beginning))) | |
460 | (ind-ref 10000)) | |
461 | (forward-line -1) | |
462 | (catch 'exit | |
463 | (while t | |
acedf35c CD |
464 | (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0) |
465 | (org-get-indentation)))) | |
afe98dfa CD |
466 | (cond |
467 | ((looking-at "^[ \t]*:END:") | |
468 | (throw 'exit item-ref)) | |
469 | ((<= (point) limit) | |
470 | (throw 'exit | |
471 | (if (and (org-at-item-p) (< ind ind-ref)) | |
472 | (point-at-bol) | |
473 | item-ref))) | |
474 | ((looking-at "^[ \t]*$") | |
475 | (skip-chars-backward " \r\t\n") | |
476 | (beginning-of-line)) | |
477 | ((looking-at "^[ \t]*#\\+end_") | |
478 | (re-search-backward "^[ \t]*#\\+begin_")) | |
479 | ((not (org-at-item-p)) | |
480 | (setq ind-ref (min ind ind-ref)) | |
481 | (forward-line -1)) | |
482 | ((>= ind ind-ref) | |
483 | (throw 'exit item-ref)) | |
484 | (t | |
485 | (setq item-ref (point-at-bol) ind-ref 10000) | |
486 | (forward-line -1)))))))))) | |
487 | ||
488 | (defun org-list-bottom-point-with-indent (limit) | |
489 | "Return point just before list ending or nil if not in a list. | |
490 | Argument LIMIT specifies the lower-bound of the search. | |
491 | ||
492 | List ending is determined by the indentation of text. See | |
493 | `org-list-ending-method' for more information." | |
494 | (save-excursion | |
495 | (let ((ind-ref (progn | |
496 | (goto-char (org-get-item-beginning)) | |
497 | (org-get-indentation))) | |
498 | (case-fold-search t)) | |
499 | ;; do not start inside a block | |
500 | (org-list-maybe-skip-block #'re-search-forward limit) | |
501 | (beginning-of-line) | |
502 | (catch 'exit | |
503 | (while t | |
504 | (skip-chars-forward " \t") | |
acedf35c CD |
505 | (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0) |
506 | (org-get-indentation)))) | |
afe98dfa CD |
507 | (cond |
508 | ((or (>= (point) limit) | |
509 | (looking-at ":END:")) | |
510 | (throw 'exit (progn | |
511 | ;; Ensure bottom is just after a | |
512 | ;; non-blank line. | |
513 | (skip-chars-backward " \r\t\n") | |
514 | (min (point-max) (1+ (point-at-eol)))))) | |
515 | ((= (point) (point-at-eol)) | |
516 | (skip-chars-forward " \r\t\n") | |
517 | (beginning-of-line)) | |
518 | ((org-at-item-p) | |
519 | (setq ind-ref ind) | |
520 | (forward-line 1)) | |
521 | ((<= ind ind-ref) | |
acedf35c CD |
522 | (throw 'exit (progn |
523 | ;; Again, ensure bottom is just after a | |
524 | ;; non-blank line. | |
525 | (skip-chars-backward " \r\t\n") | |
526 | (min (point-max) (1+ (point-at-eol)))))) | |
afe98dfa CD |
527 | ((looking-at "#\\+begin_") |
528 | (re-search-forward "[ \t]*#\\+end_") | |
529 | (forward-line 1)) | |
530 | (t (forward-line 1))))))))) | |
531 | ||
532 | (defun org-list-at-regexp-after-bullet-p (regexp) | |
533 | "Is point at a list item with REGEXP after bullet?" | |
534 | (and (org-at-item-p) | |
535 | (save-excursion | |
536 | (goto-char (match-end 0)) | |
537 | ;; Ignore counter if any | |
538 | (when (looking-at "\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?") | |
539 | (goto-char (match-end 0))) | |
540 | (looking-at regexp)))) | |
541 | ||
542 | (defun org-list-get-item-same-level (search-fun pos limit pre-move) | |
543 | "Return point at the beginning of next item at the same level. | |
544 | Search items using function SEARCH-FUN, from POS to LIMIT. It | |
545 | uses PRE-MOVE before search. Return nil if no item was found." | |
546 | (save-excursion | |
547 | (goto-char pos) | |
548 | (let* ((start (org-get-item-beginning)) | |
549 | (ind (progn (goto-char start) (org-get-indentation)))) | |
550 | ;; We don't want to match the current line. | |
551 | (funcall pre-move) | |
552 | ;; Skip any sublist on the way | |
553 | (while (and (funcall search-fun org-item-beginning-re limit t) | |
554 | (> (org-get-indentation) ind))) | |
555 | (when (and (/= (point-at-bol) start) ; Have we moved ? | |
556 | (= (org-get-indentation) ind)) | |
557 | (point-at-bol))))) | |
558 | ||
559 | (defun org-list-separating-blank-lines-number (pos top bottom) | |
560 | "Return number of blank lines that should separate items in list. | |
561 | POS is the position of point to be considered. | |
562 | ||
563 | TOP and BOTTOM are respectively position of list beginning and | |
564 | list ending. | |
565 | ||
566 | Assume point is at item's beginning. If the item is alone, apply | |
567 | some heuristics to guess the result." | |
568 | (save-excursion | |
569 | (let ((insert-blank-p | |
570 | (cdr (assq 'plain-list-item org-blank-before-new-entry))) | |
571 | usr-blank) | |
572 | (cond | |
573 | ;; Trivial cases where there should be none. | |
574 | ((or (and (not (eq org-list-ending-method 'indent)) | |
575 | org-empty-line-terminates-plain-lists) | |
576 | (not insert-blank-p)) 0) | |
577 | ;; When `org-blank-before-new-entry' says so, it is 1. | |
578 | ((eq insert-blank-p t) 1) | |
579 | ;; plain-list-item is 'auto. Count blank lines separating | |
580 | ;; neighbours items in list. | |
581 | (t (let ((next-p (org-get-next-item (point) bottom))) | |
582 | (cond | |
583 | ;; Is there a next item? | |
584 | (next-p (goto-char next-p) | |
585 | (org-back-over-empty-lines)) | |
586 | ;; Is there a previous item? | |
587 | ((org-get-previous-item (point) top) | |
588 | (org-back-over-empty-lines)) | |
589 | ;; User inserted blank lines, trust him | |
590 | ((and (> pos (org-end-of-item-before-blank bottom)) | |
591 | (> (save-excursion | |
592 | (goto-char pos) | |
593 | (skip-chars-backward " \t") | |
594 | (setq usr-blank (org-back-over-empty-lines))) 0)) | |
595 | usr-blank) | |
596 | ;; Are there blank lines inside the item ? | |
597 | ((save-excursion | |
598 | (org-search-forward-unenclosed | |
599 | "^[ \t]*$" (org-end-of-item-before-blank bottom) t)) 1) | |
600 | ;; No parent: no blank line. | |
601 | (t 0)))))))) | |
602 | ||
603 | (defun org-list-insert-item-generic (pos &optional checkbox after-bullet) | |
604 | "Insert a new list item at POS. | |
605 | If POS is before first character after bullet of the item, the | |
606 | new item will be created before the current one. | |
607 | ||
608 | Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET | |
609 | after the bullet. Cursor will be after this text once the | |
610 | function ends." | |
611 | (goto-char pos) | |
612 | ;; Is point in a special block? | |
613 | (when (org-in-regexps-block-p | |
614 | "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)" | |
615 | '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2))) | |
616 | (if (not (cdr (assq 'insert org-list-automatic-rules))) | |
617 | ;; Rule in `org-list-automatic-rules' forbids insertion. | |
618 | (error "Cannot insert item inside a block") | |
619 | ;; Else, move before it prior to add a new item. | |
620 | (end-of-line) | |
621 | (re-search-backward "^[ \t]*#\\+\\(begin\\|BEGIN\\)_" nil t) | |
622 | (end-of-line 0))) | |
623 | (let* ((true-pos (point)) | |
624 | (top (org-list-top-point)) | |
625 | (bottom (copy-marker (org-list-bottom-point))) | |
626 | (bullet (and (goto-char (org-get-item-beginning)) | |
627 | (org-list-bullet-string (org-get-bullet)))) | |
628 | (ind (org-get-indentation)) | |
629 | (before-p (progn | |
630 | ;; Description item: text starts after colons. | |
631 | (or (org-at-item-description-p) | |
632 | ;; At a checkbox: text starts after it. | |
633 | (org-at-item-checkbox-p) | |
634 | ;; Otherwise, text starts after bullet. | |
635 | (org-at-item-p)) | |
636 | (<= true-pos (match-end 0)))) | |
637 | (blank-lines-nb (org-list-separating-blank-lines-number | |
638 | true-pos top bottom)) | |
639 | (insert-fun | |
640 | (lambda (text) | |
641 | ;; insert bullet above item in order to avoid bothering | |
642 | ;; with possible blank lines ending last item. | |
643 | (goto-char (org-get-item-beginning)) | |
acedf35c | 644 | (org-indent-to-column ind) |
afe98dfa CD |
645 | (insert (concat bullet (when checkbox "[ ] ") after-bullet)) |
646 | ;; Stay between after-bullet and before text. | |
647 | (save-excursion | |
648 | (insert (concat text (make-string (1+ blank-lines-nb) ?\n)))) | |
649 | (unless before-p | |
650 | ;; store bottom: exchanging items doesn't change list | |
651 | ;; bottom point but will modify marker anyway | |
652 | (setq bottom (marker-position bottom)) | |
653 | (let ((col (current-column))) | |
654 | (org-list-exchange-items | |
655 | (org-get-item-beginning) (org-get-next-item (point) bottom) | |
656 | bottom) | |
657 | ;; recompute next-item: last sexp modified list | |
658 | (goto-char (org-get-next-item (point) bottom)) | |
659 | (org-move-to-column col))) | |
660 | ;; checkbox update might modify bottom point, so use a | |
661 | ;; marker here | |
662 | (setq bottom (copy-marker bottom)) | |
663 | (when checkbox (org-update-checkbox-count-maybe)) | |
664 | (org-list-repair nil top bottom)))) | |
665 | (goto-char true-pos) | |
666 | (cond | |
667 | (before-p (funcall insert-fun nil) t) | |
668 | ;; Can't split item: insert bullet at the end of item. | |
669 | ((not (org-get-alist-option org-M-RET-may-split-line 'item)) | |
670 | (funcall insert-fun nil) t) | |
671 | ;; else, insert a new bullet along with everything from point | |
672 | ;; down to last non-blank line of item. | |
673 | (t | |
674 | (delete-horizontal-space) | |
675 | ;; Get pos again in case previous command modified line. | |
676 | (let* ((pos (point)) | |
677 | (end-before-blank (org-end-of-item-before-blank bottom)) | |
678 | (after-text | |
679 | (when (< pos end-before-blank) | |
680 | (prog1 | |
681 | (delete-and-extract-region pos end-before-blank) | |
682 | ;; delete any blank line at and before point. | |
683 | (beginning-of-line) | |
684 | (while (looking-at "^[ \t]*$") | |
685 | (delete-region (point-at-bol) (1+ (point-at-eol))) | |
686 | (beginning-of-line 0)))))) | |
687 | (funcall insert-fun after-text) t))))) | |
688 | ||
689 | (defvar org-last-indent-begin-marker (make-marker)) | |
690 | (defvar org-last-indent-end-marker (make-marker)) | |
691 | ||
692 | (defun org-list-indent-item-generic (arg no-subtree top bottom) | |
693 | "Indent a local list item including its children. | |
694 | When number ARG is a negative, item will be outdented, otherwise | |
695 | it will be indented. | |
696 | ||
697 | If a region is active, all items inside will be moved. | |
698 | ||
699 | If NO-SUBTREE is non-nil, only indent the item itself, not its | |
700 | children. | |
701 | ||
702 | TOP and BOTTOM are respectively position at item beginning and at | |
703 | item ending. | |
704 | ||
705 | Return t if successful." | |
706 | (let* ((regionp (org-region-active-p)) | |
707 | (rbeg (and regionp (region-beginning))) | |
708 | (rend (and regionp (region-end)))) | |
709 | (cond | |
710 | ((and regionp | |
711 | (goto-char rbeg) | |
712 | (not (org-search-forward-unenclosed org-item-beginning-re rend t))) | |
713 | (error "No item in region")) | |
714 | ((not (org-at-item-p)) | |
715 | (error "Not on an item")) | |
716 | (t | |
717 | ;; Are we going to move the whole list? | |
718 | (let* ((specialp (and (cdr (assq 'indent org-list-automatic-rules)) | |
719 | (not no-subtree) | |
720 | (= top (point-at-bol))))) | |
721 | ;; Determine begin and end points of zone to indent. If moving | |
722 | ;; more than one item, ensure we keep them on subsequent moves. | |
723 | (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) | |
724 | (memq this-command '(org-shiftmetaright org-shiftmetaleft))) | |
725 | (if regionp | |
726 | (progn | |
727 | (set-marker org-last-indent-begin-marker rbeg) | |
728 | (set-marker org-last-indent-end-marker rend)) | |
729 | (set-marker org-last-indent-begin-marker (point-at-bol)) | |
730 | (set-marker org-last-indent-end-marker | |
731 | (save-excursion | |
732 | (cond | |
733 | (specialp bottom) | |
734 | (no-subtree (org-end-of-item-or-at-child bottom)) | |
735 | (t (org-get-end-of-item bottom))))))) | |
736 | ;; Get everything ready | |
737 | (let* ((beg (marker-position org-last-indent-begin-marker)) | |
738 | (end (marker-position org-last-indent-end-marker)) | |
739 | (struct (org-list-struct | |
740 | beg end top (if specialp end bottom) (< arg 0))) | |
741 | (origins (org-list-struct-origins struct)) | |
742 | (beg-item (assq beg struct))) | |
743 | (cond | |
744 | ;; Special case: moving top-item with indent rule | |
745 | (specialp | |
746 | (let* ((level-skip (org-level-increment)) | |
747 | (offset (if (< arg 0) (- level-skip) level-skip)) | |
748 | (top-ind (nth 1 beg-item))) | |
749 | (if (< (+ top-ind offset) 0) | |
750 | (error "Cannot outdent beyond margin") | |
751 | ;; Change bullet if necessary | |
752 | (when (and (= (+ top-ind offset) 0) | |
753 | (string-match "*" (nth 2 beg-item))) | |
754 | (setcdr beg-item (list (nth 1 beg-item) | |
755 | (org-list-bullet-string "-")))) | |
756 | ;; Shift ancestor | |
757 | (let ((anc (car struct))) | |
758 | (setcdr anc (list (+ (nth 1 anc) offset) "" nil))) | |
759 | (org-list-struct-fix-struct struct origins) | |
760 | (org-list-struct-apply-struct struct end)))) | |
761 | ;; Forbidden move | |
762 | ((and (< arg 0) | |
763 | (or (and no-subtree | |
764 | (not regionp) | |
765 | (org-list-struct-get-child beg-item struct)) | |
766 | (let ((last-item (save-excursion | |
767 | (goto-char end) | |
768 | (skip-chars-backward " \r\t\n") | |
769 | (goto-char (org-get-item-beginning)) | |
770 | (org-list-struct-assoc-at-point)))) | |
771 | (org-list-struct-get-child last-item struct)))) | |
772 | (error "Cannot outdent an item without its children")) | |
773 | ;; Normal shifting | |
774 | (t | |
775 | (let* ((shifted-ori (if (< arg 0) | |
776 | (org-list-struct-outdent beg end origins) | |
777 | (org-list-struct-indent beg end origins struct)))) | |
778 | (org-list-struct-fix-struct struct shifted-ori) | |
779 | (org-list-struct-apply-struct struct bottom)))))))))) | |
780 | ||
781 | ;;; Predicates | |
782 | ||
783 | (defun org-in-item-p () | |
784 | "Is the cursor inside a plain list? | |
785 | This checks `org-list-ending-method'." | |
786 | (unless (let ((outline-regexp org-outline-regexp)) (org-at-heading-p)) | |
787 | (let* ((prev-head (save-excursion (outline-previous-heading))) | |
788 | (bound (if prev-head | |
789 | (or (save-excursion | |
790 | (let ((case-fold-search t)) | |
791 | (re-search-backward "^[ \t]*:END:" prev-head t))) | |
792 | prev-head) | |
793 | (point-min)))) | |
794 | (cond | |
795 | ((eq org-list-ending-method 'regexp) | |
796 | (org-list-in-item-p-with-regexp bound)) | |
797 | ((eq org-list-ending-method 'indent) | |
798 | (org-list-in-item-p-with-indent bound)) | |
799 | (t (and (org-list-in-item-p-with-regexp bound) | |
800 | (org-list-in-item-p-with-indent bound))))))) | |
801 | ||
802 | (defun org-list-first-item-p (top) | |
803 | "Is this item the first item in a plain list? | |
804 | Assume point is at an item. | |
805 | ||
806 | TOP is the position of list's top-item." | |
807 | (save-excursion | |
808 | (beginning-of-line) | |
809 | (let ((ind (org-get-indentation))) | |
810 | (or (not (org-search-backward-unenclosed org-item-beginning-re top t)) | |
811 | (< (org-get-indentation) ind))))) | |
812 | ||
47ffc456 CD |
813 | (defun org-at-item-p () |
814 | "Is point in a line starting a hand-formatted item?" | |
86fbb8ca | 815 | (save-excursion |
afe98dfa | 816 | (beginning-of-line) (looking-at org-item-beginning-re))) |
47ffc456 | 817 | |
65c439fd CD |
818 | (defun org-at-item-bullet-p () |
819 | "Is point at the bullet of a plain list item?" | |
820 | (and (org-at-item-p) | |
821 | (not (member (char-after) '(?\ ?\t))) | |
822 | (< (point) (match-end 0)))) | |
823 | ||
afe98dfa CD |
824 | (defun org-at-item-timer-p () |
825 | "Is point at a line starting a plain list item with a timer?" | |
826 | (org-list-at-regexp-after-bullet-p | |
827 | "\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+::[ \t]+")) | |
47ffc456 | 828 | |
afe98dfa CD |
829 | (defun org-at-item-description-p () |
830 | "Is point at a description list item?" | |
831 | (org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::[ \t]+")) | |
47ffc456 CD |
832 | |
833 | (defun org-at-item-checkbox-p () | |
834 | "Is point at a line starting a plain-list item with a checklet?" | |
afe98dfa | 835 | (org-list-at-regexp-after-bullet-p "\\(\\[[- X]\\]\\)[ \t]+")) |
c8d0cf5c CD |
836 | |
837 | (defun org-checkbox-blocked-p () | |
838 | "Is the current checkbox blocked from for being checked now? | |
839 | A checkbox is blocked if all of the following conditions are fulfilled: | |
840 | ||
841 | 1. The checkbox is not checked already. | |
842 | 2. The current entry has the ORDERED property set. | |
843 | 3. There is an unchecked checkbox in this entry before the current line." | |
844 | (catch 'exit | |
845 | (save-match-data | |
846 | (save-excursion | |
847 | (unless (org-at-item-checkbox-p) (throw 'exit nil)) | |
afe98dfa | 848 | (when (equal (match-string 1) "[X]") |
c8d0cf5c CD |
849 | ;; the box is already checked! |
850 | (throw 'exit nil)) | |
851 | (let ((end (point-at-bol))) | |
852 | (condition-case nil (org-back-to-heading t) | |
853 | (error (throw 'exit nil))) | |
854 | (unless (org-entry-get nil "ORDERED") (throw 'exit nil)) | |
afe98dfa CD |
855 | (when (org-search-forward-unenclosed |
856 | "^[ \t]*[-+*0-9.)]+[ \t]+\\(\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\[[- ]\\]" end t) | |
857 | (org-current-line))))))) | |
858 | ||
859 | ;;; Navigate | |
860 | ||
861 | ;; Every interactive navigation function is derived from a | |
862 | ;; non-interactive one, which doesn't move point, assumes point is | |
863 | ;; already in a list and doesn't compute list boundaries. | |
864 | ||
865 | ;; If you plan to use more than one org-list function is some code, | |
866 | ;; you should therefore first check if point is in a list with | |
867 | ;; `org-in-item-p' or `org-at-item-p', then compute list boundaries | |
868 | ;; with `org-list-top-point' and `org-list-bottom-point', and make use | |
869 | ;; of non-interactive forms. | |
870 | ||
871 | (defun org-list-top-point () | |
872 | "Return point at the top level in a list. | |
873 | Assume point is in a list." | |
874 | (let* ((prev-head (save-excursion (outline-previous-heading))) | |
875 | (bound (if prev-head | |
876 | (or (save-excursion | |
877 | (let ((case-fold-search t)) | |
878 | (re-search-backward "^[ \t]*:END:" prev-head t))) | |
879 | prev-head) | |
880 | (point-min)))) | |
881 | (cond | |
882 | ((eq org-list-ending-method 'regexp) | |
883 | (org-list-top-point-with-regexp bound)) | |
884 | ((eq org-list-ending-method 'indent) | |
885 | (org-list-top-point-with-indent bound)) | |
886 | (t (let ((top-re (org-list-top-point-with-regexp bound))) | |
887 | (org-list-top-point-with-indent (or top-re bound))))))) | |
888 | ||
889 | (defun org-list-bottom-point () | |
890 | "Return point just before list ending. | |
891 | Assume point is in a list." | |
892 | (let* ((next-head (save-excursion | |
893 | (and (let ((outline-regexp org-outline-regexp)) | |
894 | ;; Use default regexp because folding | |
895 | ;; changes OUTLINE-REGEXP. | |
896 | (outline-next-heading))))) | |
897 | (limit (or (save-excursion | |
898 | (and (re-search-forward "^[ \t]*:END:" next-head t) | |
899 | (point-at-bol))) | |
900 | next-head | |
901 | (point-max)))) | |
902 | (cond | |
903 | ((eq org-list-ending-method 'regexp) | |
904 | (org-list-bottom-point-with-regexp limit)) | |
905 | ((eq org-list-ending-method 'indent) | |
906 | (org-list-bottom-point-with-indent limit)) | |
907 | (t (let ((bottom-re (org-list-bottom-point-with-regexp limit))) | |
908 | (org-list-bottom-point-with-indent (or bottom-re limit))))))) | |
909 | ||
910 | (defun org-get-item-beginning () | |
911 | "Return position of current item beginning." | |
912 | (save-excursion | |
913 | ;; possibly match current line | |
914 | (end-of-line) | |
915 | (org-search-backward-unenclosed org-item-beginning-re nil t) | |
916 | (point-at-bol))) | |
c8d0cf5c | 917 | |
afe98dfa CD |
918 | (defun org-beginning-of-item () |
919 | "Go to the beginning of the current hand-formatted item. | |
920 | If the cursor is not in an item, throw an error." | |
921 | (interactive) | |
922 | (if (org-in-item-p) | |
923 | (goto-char (org-get-item-beginning)) | |
924 | (error "Not in an item"))) | |
c8d0cf5c | 925 | |
afe98dfa CD |
926 | (defun org-get-beginning-of-list (top) |
927 | "Return position of the first item of the current list or sublist. | |
928 | TOP is the position at list beginning." | |
929 | (save-excursion | |
930 | (let (prev-p) | |
931 | (while (setq prev-p (org-get-previous-item (point) top)) | |
932 | (goto-char prev-p)) | |
933 | (point-at-bol)))) | |
47ffc456 | 934 | |
afe98dfa CD |
935 | (defun org-beginning-of-item-list () |
936 | "Go to the beginning item of the current list or sublist. | |
937 | Return an error if not in a list." | |
938 | (interactive) | |
939 | (if (org-in-item-p) | |
940 | (goto-char (org-get-beginning-of-list (org-list-top-point))) | |
941 | (error "Not in an item"))) | |
47ffc456 | 942 | |
afe98dfa CD |
943 | (defun org-get-end-of-list (bottom) |
944 | "Return position at the end of the current list or sublist. | |
945 | BOTTOM is the position at list ending." | |
946 | (save-excursion | |
947 | (goto-char (org-get-item-beginning)) | |
948 | (let ((ind (org-get-indentation))) | |
949 | (while (and (/= (point) bottom) | |
950 | (>= (org-get-indentation) ind)) | |
951 | (org-search-forward-unenclosed org-item-beginning-re bottom 'move)) | |
952 | (if (= (point) bottom) bottom (point-at-bol))))) | |
47ffc456 | 953 | |
afe98dfa CD |
954 | (defun org-end-of-item-list () |
955 | "Go to the end of the current list or sublist. | |
956 | If the cursor in not in an item, throw an error." | |
47ffc456 | 957 | (interactive) |
afe98dfa CD |
958 | (if (org-in-item-p) |
959 | (goto-char (org-get-end-of-list (org-list-bottom-point))) | |
960 | (error "Not in an item"))) | |
961 | ||
962 | (defun org-get-end-of-item (bottom) | |
963 | "Return position at the end of the current item. | |
964 | BOTTOM is the position at list ending." | |
965 | (or (org-get-next-item (point) bottom) | |
966 | (org-get-end-of-list bottom))) | |
47ffc456 CD |
967 | |
968 | (defun org-end-of-item () | |
969 | "Go to the end of the current hand-formatted item. | |
970 | If the cursor is not in an item, throw an error." | |
971 | (interactive) | |
afe98dfa CD |
972 | (if (org-in-item-p) |
973 | (goto-char (org-get-end-of-item (org-list-bottom-point))) | |
974 | (error "Not in an item"))) | |
975 | ||
976 | (defun org-end-of-item-or-at-child (bottom) | |
977 | "Move to the end of the item, stops before the first child if any. | |
978 | BOTTOM is the position at list ending." | |
979 | (end-of-line) | |
86fbb8ca | 980 | (goto-char |
afe98dfa CD |
981 | (if (org-search-forward-unenclosed org-item-beginning-re bottom t) |
982 | (point-at-bol) | |
983 | (org-get-end-of-item bottom)))) | |
86fbb8ca | 984 | |
afe98dfa CD |
985 | (defun org-end-of-item-before-blank (bottom) |
986 | "Return point at end of item, before any blank line. | |
987 | Point returned is at eol. | |
988 | ||
989 | BOTTOM is the position at list ending." | |
990 | (save-excursion | |
991 | (goto-char (org-get-end-of-item bottom)) | |
992 | (skip-chars-backward " \r\t\n") | |
993 | (point-at-eol))) | |
994 | ||
995 | (defun org-get-previous-item (pos limit) | |
996 | "Return point of the previous item at the same level as POS. | |
997 | Stop searching at LIMIT. Return nil if no item is found." | |
998 | (org-list-get-item-same-level | |
999 | #'org-search-backward-unenclosed pos limit #'beginning-of-line)) | |
47ffc456 CD |
1000 | |
1001 | (defun org-previous-item () | |
afe98dfa CD |
1002 | "Move to the beginning of the previous item. |
1003 | Item is at the same level in the current plain list. Error if not | |
1004 | in a plain list, or if this is the first item in the list." | |
47ffc456 | 1005 | (interactive) |
afe98dfa CD |
1006 | (if (not (org-in-item-p)) |
1007 | (error "Not in an item") | |
1008 | (let ((prev-p (org-get-previous-item (point) (org-list-top-point)))) | |
1009 | (if prev-p (goto-char prev-p) (error "On first item"))))) | |
1010 | ||
1011 | (defun org-get-next-item (pos limit) | |
1012 | "Return point of the next item at the same level as POS. | |
1013 | Stop searching at LIMIT. Return nil if no item is found." | |
1014 | (org-list-get-item-same-level | |
1015 | #'org-search-forward-unenclosed pos limit #'end-of-line)) | |
1016 | ||
1017 | (defun org-next-item () | |
1018 | "Move to the beginning of the next item. | |
1019 | Item is at the same level in the current plain list. Error if not | |
1020 | in a plain list, or if this is the last item in the list." | |
1021 | (interactive) | |
1022 | (if (not (org-in-item-p)) | |
1023 | (error "Not in an item") | |
1024 | (let ((next-p (org-get-next-item (point) (org-list-bottom-point)))) | |
1025 | (if next-p (goto-char next-p) (error "On last item"))))) | |
1026 | ||
1027 | ;;; Manipulate | |
1028 | ||
1029 | (defun org-list-exchange-items (beg-A beg-B bottom) | |
1030 | "Swap item starting at BEG-A with item starting at BEG-B. | |
1031 | Blank lines at the end of items are left in place. Assume BEG-A | |
1032 | is lesser than BEG-B. | |
1033 | ||
1034 | BOTTOM is the position at list ending." | |
c8d0cf5c | 1035 | (save-excursion |
afe98dfa CD |
1036 | (let* ((end-of-item-no-blank |
1037 | (lambda (pos) | |
1038 | (goto-char pos) | |
1039 | (goto-char (org-end-of-item-before-blank bottom)))) | |
1040 | (end-A-no-blank (funcall end-of-item-no-blank beg-A)) | |
1041 | (end-B-no-blank (funcall end-of-item-no-blank beg-B)) | |
1042 | (body-A (buffer-substring beg-A end-A-no-blank)) | |
1043 | (body-B (buffer-substring beg-B end-B-no-blank)) | |
1044 | (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B))) | |
1045 | (goto-char beg-A) | |
1046 | (delete-region beg-A end-B-no-blank) | |
1047 | (insert (concat body-B between-A-no-blank-and-B body-A))))) | |
47ffc456 CD |
1048 | |
1049 | (defun org-move-item-down () | |
1050 | "Move the plain list item at point down, i.e. swap with following item. | |
1051 | Subitems (items with larger indentation) are considered part of the item, | |
1052 | so this really moves item trees." | |
1053 | (interactive) | |
afe98dfa CD |
1054 | (if (not (org-at-item-p)) |
1055 | (error "Not at an item") | |
1056 | (let* ((pos (point)) | |
1057 | (col (current-column)) | |
1058 | (bottom (org-list-bottom-point)) | |
1059 | (actual-item (goto-char (org-get-item-beginning))) | |
1060 | (next-item (org-get-next-item (point) bottom))) | |
1061 | (if (not next-item) | |
1062 | (progn | |
1063 | (goto-char pos) | |
1064 | (error "Cannot move this item further down")) | |
1065 | (org-list-exchange-items actual-item next-item bottom) | |
1066 | (org-list-repair nil nil bottom) | |
1067 | (goto-char (org-get-next-item (point) bottom)) | |
acedf35c | 1068 | (org-move-to-column col))))) |
afe98dfa CD |
1069 | |
1070 | (defun org-move-item-up () | |
47ffc456 CD |
1071 | "Move the plain list item at point up, i.e. swap with previous item. |
1072 | Subitems (items with larger indentation) are considered part of the item, | |
1073 | so this really moves item trees." | |
47ffc456 | 1074 | (interactive) |
afe98dfa CD |
1075 | (if (not (org-at-item-p)) |
1076 | (error "Not at an item") | |
1077 | (let* ((pos (point)) | |
1078 | (col (current-column)) | |
1079 | (top (org-list-top-point)) | |
1080 | (bottom (org-list-bottom-point)) | |
1081 | (actual-item (goto-char (org-get-item-beginning))) | |
1082 | (prev-item (org-get-previous-item (point) top))) | |
1083 | (if (not prev-item) | |
1084 | (progn | |
1085 | (goto-char pos) | |
1086 | (error "Cannot move this item further up")) | |
1087 | (org-list-exchange-items prev-item actual-item bottom) | |
1088 | (org-list-repair nil top bottom) | |
acedf35c | 1089 | (org-move-to-column col))))) |
47ffc456 | 1090 | |
afe98dfa CD |
1091 | (defun org-insert-item (&optional checkbox) |
1092 | "Insert a new item at the current level. | |
1093 | If cursor is before first character after bullet of the item, the | |
1094 | new item will be created before the current one. | |
47ffc456 | 1095 | |
afe98dfa | 1096 | If CHECKBOX is non-nil, add a checkbox next to the bullet. |
47ffc456 | 1097 | |
afe98dfa CD |
1098 | Return t when things worked, nil when we are not in an item, or |
1099 | item is invisible." | |
1100 | (unless (or (not (org-in-item-p)) | |
1101 | (save-excursion | |
1102 | (goto-char (org-get-item-beginning)) | |
1103 | (org-invisible-p))) | |
1104 | (if (save-excursion | |
1105 | (goto-char (org-get-item-beginning)) | |
1106 | (org-at-item-timer-p)) | |
1107 | ;; Timer list: delegate to `org-timer-item'. | |
1108 | (progn (org-timer-item) t) | |
1109 | ;; if we're in a description list, ask for the new term. | |
1110 | (let ((desc-text (when (save-excursion | |
1111 | (and (goto-char (org-get-item-beginning)) | |
1112 | (org-at-item-description-p))) | |
1113 | (concat (read-string "Term: ") " :: ")))) | |
1114 | ;; Don't insert a checkbox if checkbox rule is applied and it | |
1115 | ;; is a description item. | |
1116 | (org-list-insert-item-generic | |
1117 | (point) (and checkbox | |
1118 | (or (not desc-text) | |
1119 | (not (cdr (assq 'checkbox org-list-automatic-rules))))) | |
1120 | desc-text))))) | |
1121 | ||
1122 | ;;; Structures | |
1123 | ||
1124 | ;; The idea behind structures is to avoid moving back and forth in the | |
1125 | ;; buffer on costly operations like indenting or fixing bullets. | |
1126 | ||
1127 | ;; It achieves this by taking a snapshot of an interesting part of the | |
1128 | ;; list, in the shape of an alist, using `org-list-struct'. | |
1129 | ||
1130 | ;; It then proceeds to changes directly on the alist, with the help of | |
1131 | ;; and `org-list-struct-origins'. When those are done, | |
1132 | ;; `org-list-struct-apply-struct' applies the changes to the buffer. | |
1133 | ||
1134 | (defun org-list-struct-assoc-at-point () | |
1135 | "Return the structure association at point. | |
1136 | It is a cons-cell whose key is point and values are indentation, | |
1137 | bullet string and bullet counter, if any." | |
1138 | (save-excursion | |
1139 | (beginning-of-line) | |
1140 | (list (point-at-bol) | |
1141 | (org-get-indentation) | |
1142 | (progn | |
1143 | (looking-at "^[ \t]*\\([-+*0-9.)]+[ \t]+\\)") | |
1144 | (match-string 1)) | |
1145 | (progn | |
1146 | (goto-char (match-end 0)) | |
1147 | (and (looking-at "\\[@\\(?:start:\\)?\\([0-9]+\\)\\]") | |
1148 | (match-string 1)))))) | |
1149 | ||
1150 | (defun org-list-struct (begin end top bottom &optional outdent) | |
1151 | "Return the structure containing the list between BEGIN and END. | |
1152 | A structure is an alist where key is point of item and values | |
1153 | are, in that order, indentation, bullet string and value of | |
1154 | counter, if any. A structure contains every list and sublist that | |
1155 | has items between BEGIN and END along with their common ancestor. | |
1156 | If no such ancestor can be found, the function will add a virtual | |
1157 | ancestor at position 0. | |
1158 | ||
1159 | TOP and BOTTOM are respectively the position of list beginning | |
1160 | and list ending. | |
1161 | ||
1162 | If OUTDENT is non-nil, it will also grab all of the parent list | |
1163 | and the grand-parent. Setting OUTDENT to t is mandatory when next | |
1164 | change is an outdent." | |
1165 | (save-excursion | |
1166 | (let* (struct | |
1167 | (extend | |
1168 | (lambda (struct) | |
1169 | (let* ((ind-min (apply 'min (mapcar 'cadr struct))) | |
1170 | (begin (caar struct)) | |
1171 | (end (caar (last struct))) | |
1172 | pre-list post-list) | |
1173 | (goto-char begin) | |
1174 | ;; Find beginning of most outdented list (min list) | |
1175 | (while (and (org-search-backward-unenclosed | |
1176 | org-item-beginning-re top t) | |
1177 | (>= (org-get-indentation) ind-min)) | |
1178 | (setq pre-list (cons (org-list-struct-assoc-at-point) | |
1179 | pre-list))) | |
1180 | ;; Now get the parent. If none, add a virtual ancestor | |
1181 | (if (< (org-get-indentation) ind-min) | |
1182 | (setq pre-list (cons (org-list-struct-assoc-at-point) | |
1183 | pre-list)) | |
1184 | (setq pre-list (cons (list 0 (org-get-indentation) "" nil) | |
1185 | pre-list))) | |
1186 | ;; Find end of min list | |
1187 | (goto-char end) | |
1188 | (end-of-line) | |
1189 | (while (and (org-search-forward-unenclosed | |
1190 | org-item-beginning-re bottom 'move) | |
1191 | (>= (org-get-indentation) ind-min)) | |
1192 | (setq post-list (cons (org-list-struct-assoc-at-point) | |
1193 | post-list))) | |
1194 | ;; Is list is malformed? If some items are less | |
1195 | ;; indented that top-item, add them anyhow. | |
1196 | (when (and (= (caar pre-list) 0) (< (point) bottom)) | |
1197 | (beginning-of-line) | |
1198 | (while (org-search-forward-unenclosed | |
1199 | org-item-beginning-re bottom t) | |
1200 | (setq post-list (cons (org-list-struct-assoc-at-point) | |
1201 | post-list)))) | |
1202 | (append pre-list struct (reverse post-list)))))) | |
1203 | ;; Here we start: first get the core zone... | |
1204 | (goto-char end) | |
1205 | (while (org-search-backward-unenclosed org-item-beginning-re begin t) | |
1206 | (setq struct (cons (org-list-struct-assoc-at-point) struct))) | |
1207 | ;; ... then, extend it to make it a structure... | |
1208 | (let ((extended (funcall extend struct))) | |
1209 | ;; ... twice when OUTDENT is non-nil and struct still can be | |
1210 | ;; extended | |
1211 | (if (and outdent (> (caar extended) 0)) | |
1212 | (funcall extend extended) | |
1213 | extended))))) | |
1214 | ||
1215 | (defun org-list-struct-origins (struct) | |
1216 | "Return an alist where key is item's position and value parent's. | |
1217 | STRUCT is the list's structure looked up." | |
1218 | (let* ((struct-rev (reverse struct)) | |
1219 | (acc (list (cons (nth 1 (car struct)) 0))) | |
1220 | (prev-item (lambda (item) | |
1221 | (car (nth 1 (member (assq item struct) struct-rev))))) | |
1222 | (get-origins | |
1223 | (lambda (item) | |
1224 | (let* ((item-pos (car item)) | |
1225 | (ind (nth 1 item)) | |
1226 | (prev-ind (caar acc))) | |
1227 | (cond | |
1228 | ;; List closing. | |
1229 | ((> prev-ind ind) | |
1230 | (let ((current-origin (or (member (assq ind acc) acc) | |
1231 | ;; needed if top-point is | |
1232 | ;; not the most outdented | |
1233 | (last acc)))) | |
1234 | (setq acc current-origin) | |
1235 | (cons item-pos (cdar acc)))) | |
1236 | ;; New list | |
1237 | ((< prev-ind ind) | |
1238 | (let ((origin (funcall prev-item item-pos))) | |
1239 | (setq acc (cons (cons ind origin) acc)) | |
1240 | (cons item-pos origin))) | |
1241 | ;; Current list going on | |
1242 | (t (cons item-pos (cdar acc)))))))) | |
1243 | (cons '(0 . 0) (mapcar get-origins (cdr struct))))) | |
1244 | ||
1245 | (defun org-list-struct-get-parent (item struct origins) | |
1246 | "Return parent association of ITEM in STRUCT or nil. | |
1247 | ORIGINS is the alist of parents. See `org-list-struct-origins'." | |
1248 | (let* ((parent-pos (cdr (assq (car item) origins)))) | |
1249 | (when (> parent-pos 0) (assq parent-pos struct)))) | |
1250 | ||
1251 | (defun org-list-struct-get-child (item struct) | |
1252 | "Return child association of ITEM in STRUCT or nil." | |
1253 | (let ((ind (nth 1 item)) | |
1254 | (next-item (cadr (member item struct)))) | |
1255 | (when (and next-item (> (nth 1 next-item) ind)) next-item))) | |
1256 | ||
1257 | (defun org-list-struct-fix-bul (struct origins) | |
1258 | "Verify and correct bullets for every association in STRUCT. | |
1259 | ORIGINS is the alist of parents. See `org-list-struct-origins'. | |
1260 | ||
1261 | This function modifies STRUCT." | |
1262 | (let* (acc | |
1263 | (init-bul (lambda (item) | |
1264 | (let ((counter (nth 3 item)) | |
1265 | (bullet (org-list-bullet-string (nth 2 item)))) | |
1266 | (cond | |
1267 | ((and (string-match "[0-9]+" bullet) counter) | |
1268 | (replace-match counter nil nil bullet)) | |
1269 | ((string-match "[0-9]+" bullet) | |
1270 | (replace-match "1" nil nil bullet)) | |
1271 | (t bullet))))) | |
1272 | (set-bul (lambda (item bullet) | |
1273 | (setcdr item (list (nth 1 item) bullet (nth 3 item))))) | |
1274 | (get-bul (lambda (item bullet) | |
1275 | (let* ((counter (nth 3 item))) | |
1276 | (if (and counter (string-match "[0-9]+" bullet)) | |
1277 | (replace-match counter nil nil bullet) | |
1278 | bullet)))) | |
1279 | (fix-bul | |
1280 | (lambda (item) struct | |
1281 | (let* ((parent (cdr (assq (car item) origins))) | |
1282 | (orig-ref (assq parent acc))) | |
1283 | (if orig-ref | |
1284 | ;; Continuing previous list | |
1285 | (let* ((prev-bul (cdr orig-ref)) | |
1286 | (new-bul (funcall get-bul item prev-bul))) | |
1287 | (setcdr orig-ref (org-list-inc-bullet-maybe new-bul)) | |
1288 | (funcall set-bul item new-bul)) | |
1289 | ;; A new list is starting | |
1290 | (let ((new-bul (funcall init-bul item))) | |
1291 | (funcall set-bul item new-bul) | |
1292 | (setq acc (cons (cons parent | |
1293 | (org-list-inc-bullet-maybe new-bul)) | |
1294 | acc)))))))) | |
1295 | (mapc fix-bul (cdr struct)))) | |
1296 | ||
1297 | (defun org-list-struct-fix-ind (struct origins) | |
1298 | "Verify and correct indentation for every association in STRUCT. | |
1299 | ORIGINS is the alist of parents. See `org-list-struct-origins'. | |
1300 | ||
1301 | This function modifies STRUCT." | |
1302 | (let* ((headless (cdr struct)) | |
1303 | (ancestor (car struct)) | |
1304 | (top-ind (+ (nth 1 ancestor) (length (nth 2 ancestor)))) | |
1305 | (new-ind | |
1306 | (lambda (item) | |
1307 | (let* ((parent (org-list-struct-get-parent item headless origins))) | |
1308 | (if parent | |
1309 | ;; Indent like parent + length of parent's bullet | |
1310 | (setcdr item (cons (+ (length (nth 2 parent)) (nth 1 parent)) | |
1311 | (cddr item))) | |
1312 | ;; If no parent, indent like top-point | |
1313 | (setcdr item (cons top-ind (cddr item)))))))) | |
1314 | (mapc new-ind headless))) | |
1315 | ||
1316 | (defun org-list-struct-fix-struct (struct origins) | |
1317 | "Return STRUCT with correct bullets and indentation. | |
1318 | ORIGINS is the alist of parents. See `org-list-struct-origins'. | |
1319 | ||
1320 | Only elements of STRUCT that have changed are returned." | |
1321 | (let ((old (copy-alist struct))) | |
1322 | (org-list-struct-fix-bul struct origins) | |
1323 | (org-list-struct-fix-ind struct origins) | |
1324 | (delq nil (mapcar (lambda (e) (when (not (equal (pop old) e)) e)) struct)))) | |
1325 | ||
1326 | (defun org-list-struct-outdent (start end origins) | |
1327 | "Outdent items in a structure. | |
1328 | Items are indented when their key is between START, included, and | |
1329 | END, excluded. | |
1330 | ||
1331 | ORIGINS is the alist of parents. See `org-list-struct-origins'. | |
1332 | ||
1333 | STRUCT is the concerned structure." | |
1334 | (let* (acc | |
1335 | (out (lambda (cell) | |
1336 | (let* ((item (car cell)) | |
1337 | (parent (cdr cell))) | |
1338 | (cond | |
1339 | ;; Item not yet in zone: keep association | |
1340 | ((< item start) cell) | |
1341 | ;; Item out of zone: follow associations in acc | |
1342 | ((>= item end) | |
1343 | (let ((convert (assq parent acc))) | |
1344 | (if convert (cons item (cdr convert)) cell))) | |
1345 | ;; Item has no parent: error | |
1346 | ((<= parent 0) | |
1347 | (error "Cannot outdent top-level items")) | |
1348 | ;; Parent is outdented: keep association | |
1349 | ((>= parent start) | |
1350 | (setq acc (cons (cons parent item) acc)) cell) | |
1351 | (t | |
1352 | ;; Parent isn't outdented: reparent to grand-parent | |
1353 | (let ((grand-parent (cdr (assq parent origins)))) | |
1354 | (setq acc (cons (cons parent item) acc)) | |
1355 | (cons item grand-parent)))))))) | |
1356 | (mapcar out origins))) | |
1357 | ||
1358 | (defun org-list-struct-indent (start end origins struct) | |
1359 | "Indent items in a structure. | |
1360 | Items are indented when their key is between START, included, and | |
1361 | END, excluded. | |
1362 | ||
1363 | ORIGINS is the alist of parents. See `org-list-struct-origins'. | |
1364 | ||
1365 | STRUCT is the concerned structure. It may be modified if | |
1366 | `org-list-demote-modify-bullet' matches bullets between START and | |
1367 | END." | |
1368 | (let* (acc | |
1369 | (orig-rev (reverse origins)) | |
1370 | (get-prev-item | |
1371 | (lambda (cell parent) | |
1372 | (car (rassq parent (cdr (memq cell orig-rev)))))) | |
1373 | (set-assoc | |
1374 | (lambda (cell) | |
1375 | (setq acc (cons cell acc)) cell)) | |
1376 | (change-bullet-maybe | |
1377 | (lambda (item) | |
1378 | (let* ((full-item (assq item struct)) | |
1379 | (item-bul (org-trim (nth 2 full-item))) | |
1380 | (new-bul-p (cdr (assoc item-bul org-list-demote-modify-bullet)))) | |
1381 | (when new-bul-p | |
1382 | ;; new bullet is stored without space to ensure item | |
1383 | ;; will be modified | |
1384 | (setcdr full-item | |
1385 | (list (nth 1 full-item) | |
1386 | new-bul-p | |
1387 | (nth 3 full-item))))))) | |
1388 | (ind | |
1389 | (lambda (cell) | |
1390 | (let* ((item (car cell)) | |
1391 | (parent (cdr cell))) | |
1392 | (cond | |
1393 | ;; Item not yet in zone: keep association | |
1394 | ((< item start) cell) | |
1395 | ((>= item end) | |
1396 | ;; Item out of zone: follow associations in acc | |
1397 | (let ((convert (assq parent acc))) | |
1398 | (if convert (cons item (cdr convert)) cell))) | |
1399 | (t | |
1400 | ;; Item is in zone... | |
1401 | (let ((prev (funcall get-prev-item cell parent))) | |
1402 | ;; Check if bullet needs to be changed | |
1403 | (funcall change-bullet-maybe item) | |
1404 | (cond | |
1405 | ;; First item indented but not parent: error | |
1406 | ((and (or (not prev) (= prev 0)) (< parent start)) | |
1407 | (error "Cannot indent the first item of a list")) | |
1408 | ;; First item and parent indented: keep same parent | |
1409 | ((or (not prev) (= prev 0)) | |
1410 | (funcall set-assoc cell)) | |
1411 | ;; Previous item not indented: reparent to it | |
1412 | ((< prev start) | |
1413 | (funcall set-assoc (cons item prev))) | |
1414 | ;; Previous item indented: reparent like it | |
1415 | (t | |
1416 | (funcall set-assoc (cons item | |
1417 | (cdr (assq prev acc))))))))))))) | |
1418 | (mapcar ind origins))) | |
1419 | ||
1420 | (defun org-list-struct-apply-struct (struct bottom) | |
1421 | "Apply modifications to list so it mirrors STRUCT. | |
1422 | BOTTOM is position at list ending. | |
1423 | ||
1424 | Initial position is restored after the changes." | |
1425 | (let* ((pos (copy-marker (point))) | |
1426 | (ancestor (caar struct)) | |
1427 | (modify | |
1428 | (lambda (item) | |
1429 | (goto-char (car item)) | |
1430 | (let* ((new-ind (nth 1 item)) | |
1431 | (new-bul (org-list-bullet-string (nth 2 item))) | |
1432 | (old-ind (org-get-indentation)) | |
1433 | (old-bul (progn | |
1434 | (looking-at "[ \t]*\\(\\S-+[ \t]*\\)") | |
1435 | (match-string 1))) | |
1436 | (old-body-ind (+ (length old-bul) old-ind)) | |
1437 | (new-body-ind (+ (length new-bul) new-ind))) | |
1438 | ;; 1. Shift item's body | |
1439 | (unless (= old-body-ind new-body-ind) | |
1440 | (org-shift-item-indentation | |
1441 | (- new-body-ind old-body-ind) bottom)) | |
1442 | ;; 2. Replace bullet | |
1443 | (unless (equal new-bul old-bul) | |
1444 | (save-excursion | |
1445 | (looking-at "[ \t]*\\(\\S-+[ \t]*\\)") | |
1446 | (replace-match new-bul nil nil nil 1))) | |
1447 | ;; 3. Indent item to appropriate column | |
1448 | (unless (= new-ind old-ind) | |
1449 | (delete-region (point-at-bol) | |
1450 | (progn | |
1451 | (skip-chars-forward " \t") | |
1452 | (point))) | |
1453 | (indent-to new-ind))))) | |
1454 | ;; Remove ancestor if it is left. | |
1455 | (struct-to-apply (if (or (not ancestor) (= 0 ancestor)) | |
1456 | (cdr struct) | |
1457 | struct))) | |
1458 | ;; Apply changes from bottom to top | |
1459 | (mapc modify (nreverse struct-to-apply)) | |
1460 | (goto-char pos))) | |
1461 | ||
1462 | ;;; Indentation | |
47ffc456 CD |
1463 | |
1464 | (defun org-get-string-indentation (s) | |
1465 | "What indentation has S due to SPACE and TAB at the beginning of the string?" | |
1466 | (let ((n -1) (i 0) (w tab-width) c) | |
1467 | (catch 'exit | |
1468 | (while (< (setq n (1+ n)) (length s)) | |
1469 | (setq c (aref s n)) | |
1470 | (cond ((= c ?\ ) (setq i (1+ i))) | |
1471 | ((= c ?\t) (setq i (* (/ (+ w i) w) w))) | |
1472 | (t (throw 'exit t))))) | |
1473 | i)) | |
1474 | ||
afe98dfa CD |
1475 | (defun org-shift-item-indentation (delta bottom) |
1476 | "Shift the indentation in current item by DELTA. | |
1477 | Sub-items are not moved. | |
1478 | ||
1479 | BOTTOM is position at list ending." | |
1480 | (save-excursion | |
1481 | (let ((beg (point-at-bol)) | |
1482 | (end (org-end-of-item-or-at-child bottom))) | |
1483 | (beginning-of-line (unless (eolp) 0)) | |
1484 | (while (> (point) beg) | |
1485 | (when (looking-at "[ \t]*\\S-") | |
1486 | ;; this is not an empty line | |
1487 | (let ((i (org-get-indentation))) | |
1488 | (when (and (> i 0) (> (+ i delta) 0)) | |
acedf35c | 1489 | (org-indent-line-to (+ i delta))))) |
afe98dfa CD |
1490 | (beginning-of-line 0))))) |
1491 | ||
1492 | (defun org-outdent-item () | |
1493 | "Outdent a local list item, but not its children. | |
1494 | If a region is active, all items inside will be moved." | |
47ffc456 | 1495 | (interactive) |
afe98dfa CD |
1496 | (org-list-indent-item-generic |
1497 | -1 t (org-list-top-point) (org-list-bottom-point))) | |
ce4fdcb9 | 1498 | |
afe98dfa CD |
1499 | (defun org-indent-item () |
1500 | "Indent a local list item, but not its children. | |
1501 | If a region is active, all items inside will be moved." | |
47ffc456 | 1502 | (interactive) |
afe98dfa CD |
1503 | (org-list-indent-item-generic |
1504 | 1 t (org-list-top-point) (org-list-bottom-point))) | |
47ffc456 | 1505 | |
afe98dfa CD |
1506 | (defun org-outdent-item-tree () |
1507 | "Outdent a local list item including its children. | |
1508 | If a region is active, all items inside will be moved." | |
47ffc456 | 1509 | (interactive) |
afe98dfa CD |
1510 | (org-list-indent-item-generic |
1511 | -1 nil (org-list-top-point) (org-list-bottom-point))) | |
1512 | ||
1513 | (defun org-indent-item-tree () | |
1514 | "Indent a local list item including its children. | |
1515 | If a region is active, all items inside will be moved." | |
1516 | (interactive) | |
1517 | (org-list-indent-item-generic | |
1518 | 1 nil (org-list-top-point) (org-list-bottom-point))) | |
1519 | ||
1520 | (defvar org-tab-ind-state) | |
1521 | (defun org-cycle-item-indentation () | |
1522 | "Cycle levels of indentation of an empty item. | |
1523 | The first run indent the item, if applicable. Subsequents runs | |
1524 | outdent it at meaningful levels in the list. When done, item is | |
1525 | put back at its original position with its original bullet. | |
1526 | ||
1527 | Return t at each successful move." | |
1528 | (let ((org-adapt-indentation nil) | |
33306645 | 1529 | (ind (org-get-indentation)) |
afe98dfa CD |
1530 | (bottom (and (org-at-item-p) (org-list-bottom-point)))) |
1531 | (when (and (or (org-at-item-description-p) | |
1532 | (org-at-item-checkbox-p) | |
1533 | (org-at-item-p)) | |
1534 | ;; Check that item is really empty | |
1535 | (>= (match-end 0) (save-excursion | |
1536 | (org-end-of-item-or-at-child bottom) | |
1537 | (skip-chars-backward " \r\t\n") | |
1538 | (point)))) | |
1539 | (setq this-command 'org-cycle-item-indentation) | |
1540 | (let ((top (org-list-top-point))) | |
1541 | ;; When in the middle of the cycle, try to outdent first. If it | |
1542 | ;; fails, and point is still at initial position, indent. Else, | |
1543 | ;; go back to original position. | |
1544 | (if (eq last-command 'org-cycle-item-indentation) | |
1545 | (cond | |
1546 | ((ignore-errors (org-list-indent-item-generic -1 t top bottom))) | |
1547 | ((and (= (org-get-indentation) (car org-tab-ind-state)) | |
1548 | (ignore-errors | |
1549 | (org-list-indent-item-generic 1 t top bottom)))) | |
1550 | (t (back-to-indentation) | |
acedf35c | 1551 | (org-indent-to-column (car org-tab-ind-state)) |
afe98dfa CD |
1552 | (end-of-line) |
1553 | (org-list-repair (cdr org-tab-ind-state)) | |
1554 | ;; Break cycle | |
1555 | (setq this-command 'identity))) | |
1556 | ;; If a cycle is starting, remember indentation and bullet, | |
1557 | ;; then try to indent. If it fails, try to outdent. | |
1558 | (setq org-tab-ind-state (cons ind (org-get-bullet))) | |
1559 | (cond | |
1560 | ((ignore-errors (org-list-indent-item-generic 1 t top bottom))) | |
1561 | ((ignore-errors (org-list-indent-item-generic -1 t top bottom))) | |
1562 | (t (error "Cannot move item"))))) | |
1563 | t))) | |
47ffc456 | 1564 | |
afe98dfa | 1565 | ;;; Bullets |
47ffc456 | 1566 | |
afe98dfa CD |
1567 | (defun org-get-bullet () |
1568 | "Return the bullet of the item at point. | |
1569 | Assume cursor is at an item." | |
1570 | (save-excursion | |
1571 | (beginning-of-line) | |
1572 | (and (looking-at "[ \t]*\\(\\S-+\\)") (match-string 1)))) | |
1573 | ||
1574 | (defun org-list-bullet-string (bullet) | |
1575 | "Return BULLET with the correct number of whitespaces. | |
1576 | It determines the number of whitespaces to append by looking at | |
1577 | `org-list-two-spaces-after-bullet-regexp'." | |
1578 | (save-match-data | |
1579 | (string-match "\\S-+\\([ \t]*\\)" bullet) | |
1580 | (replace-match | |
1581 | (save-match-data | |
1582 | (concat | |
1583 | " " | |
1584 | ;; Do we need to concat another white space ? | |
1585 | (when (and org-list-two-spaces-after-bullet-regexp | |
1586 | (string-match org-list-two-spaces-after-bullet-regexp bullet)) | |
1587 | " "))) | |
1588 | nil nil bullet 1))) | |
1589 | ||
1590 | (defun org-list-inc-bullet-maybe (bullet) | |
1591 | "Increment BULLET if applicable." | |
1592 | (if (string-match "[0-9]+" bullet) | |
1593 | (replace-match | |
1594 | (number-to-string (1+ (string-to-number (match-string 0 bullet)))) | |
1595 | nil nil bullet) | |
1596 | bullet)) | |
1597 | ||
1598 | (defun org-list-repair (&optional force-bullet top bottom) | |
1599 | "Make sure all items are correctly indented, with the right bullet. | |
1600 | This function scans the list at point, along with any sublist. | |
1601 | ||
1602 | If FORCE-BULLET is a string, ensure all items in list share this | |
1603 | bullet, or a logical successor in the case of an ordered list. | |
1604 | ||
1605 | When non-nil, TOP and BOTTOM specify respectively position of | |
1606 | list beginning and list ending. | |
1607 | ||
1608 | Item's body is not indented, only shifted with the bullet." | |
1609 | (interactive) | |
1610 | (unless (org-at-item-p) (error "This is not a list")) | |
1611 | (let* ((bottom (or bottom (org-list-bottom-point))) | |
1612 | (struct (org-list-struct | |
1613 | (point-at-bol) (point-at-eol) | |
1614 | (or top (org-list-top-point)) bottom)) | |
1615 | (origins (org-list-struct-origins struct)) | |
1616 | fixed-struct) | |
1617 | (if (stringp force-bullet) | |
1618 | (let ((begin (nth 1 struct))) | |
1619 | (setcdr begin (list (nth 1 begin) | |
1620 | (org-list-bullet-string force-bullet) | |
1621 | (nth 3 begin))) | |
1622 | (setq fixed-struct | |
1623 | (cons begin (org-list-struct-fix-struct struct origins)))) | |
1624 | (setq fixed-struct (org-list-struct-fix-struct struct origins))) | |
1625 | (org-list-struct-apply-struct fixed-struct bottom))) | |
47ffc456 | 1626 | |
afe98dfa CD |
1627 | (defun org-cycle-list-bullet (&optional which) |
1628 | "Cycle through the different itemize/enumerate bullets. | |
1629 | This cycle the entire list level through the sequence: | |
47ffc456 | 1630 | |
afe98dfa | 1631 | `-' -> `+' -> `*' -> `1.' -> `1)' |
86fbb8ca | 1632 | |
afe98dfa CD |
1633 | If WHICH is a valid string, use that as the new bullet. If WHICH |
1634 | is an integer, 0 means `-', 1 means `+' etc. If WHICH is | |
1635 | 'previous, cycle backwards." | |
1636 | (interactive "P") | |
acedf35c CD |
1637 | (save-excursion |
1638 | (let* ((top (org-list-top-point)) | |
1639 | (bullet (progn | |
1640 | (goto-char (org-get-beginning-of-list top)) | |
1641 | (org-get-bullet))) | |
1642 | (current (cond | |
1643 | ((string-match "\\." bullet) "1.") | |
1644 | ((string-match ")" bullet) "1)") | |
1645 | (t bullet))) | |
1646 | (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules))) | |
1647 | (bullet-list (append '("-" "+" ) | |
1648 | ;; *-bullets are not allowed at column 0 | |
1649 | (unless (and bullet-rule-p | |
1650 | (looking-at "\\S-")) '("*")) | |
1651 | ;; Description items cannot be numbered | |
1652 | (unless (and bullet-rule-p | |
1653 | (or (eq org-plain-list-ordered-item-terminator ?\)) | |
1654 | (org-at-item-description-p))) '("1.")) | |
1655 | (unless (and bullet-rule-p | |
1656 | (or (eq org-plain-list-ordered-item-terminator ?.) | |
1657 | (org-at-item-description-p))) '("1)")))) | |
1658 | (len (length bullet-list)) | |
1659 | (item-index (- len (length (member current bullet-list)))) | |
1660 | (get-value (lambda (index) (nth (mod index len) bullet-list))) | |
1661 | (new (cond | |
1662 | ((member which bullet-list) which) | |
1663 | ((numberp which) (funcall get-value which)) | |
1664 | ((eq 'previous which) (funcall get-value (1- item-index))) | |
1665 | (t (funcall get-value (1+ item-index)))))) | |
1666 | (org-list-repair new top)))) | |
86fbb8ca | 1667 | |
afe98dfa CD |
1668 | ;;; Checkboxes |
1669 | ||
1670 | (defun org-toggle-checkbox (&optional toggle-presence) | |
1671 | "Toggle the checkbox in the current line. | |
1672 | With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. With | |
1673 | double prefix, set checkbox to [-]. | |
1674 | ||
1675 | When there is an active region, toggle status or presence of the | |
1676 | first checkbox there, and make every item inside have the | |
1677 | same status or presence, respectively. | |
1678 | ||
1679 | If the cursor is in a headline, apply this to all checkbox items | |
1680 | in the text below the heading, taking as reference the first item | |
1681 | in subtree, ignoring drawers." | |
1682 | (interactive "P") | |
1683 | ;; Bounds is a list of type (beg end single-p) where single-p is t | |
1684 | ;; when `org-toggle-checkbox' is applied to a single item. Only | |
1685 | ;; toggles on single items will return errors. | |
1686 | (let* ((bounds | |
1687 | (cond | |
1688 | ((org-region-active-p) | |
1689 | (let ((rbeg (region-beginning)) | |
1690 | (rend (region-end))) | |
1691 | (save-excursion | |
1692 | (goto-char rbeg) | |
1693 | (if (org-search-forward-unenclosed org-item-beginning-re rend 'move) | |
1694 | (list (point-at-bol) rend nil) | |
1695 | (error "No item in region"))))) | |
1696 | ((org-on-heading-p) | |
1697 | ;; In this case, reference line is the first item in | |
1698 | ;; subtree outside drawers | |
1699 | (let ((pos (point)) | |
1700 | (limit (save-excursion (outline-next-heading) (point)))) | |
1701 | (save-excursion | |
1702 | (goto-char limit) | |
1703 | (org-search-backward-unenclosed ":END:" pos 'move) | |
1704 | (org-search-forward-unenclosed | |
1705 | org-item-beginning-re limit 'move) | |
1706 | (list (point) limit nil)))) | |
1707 | ((org-at-item-p) | |
1708 | (list (point-at-bol) (1+ (point-at-eol)) t)) | |
1709 | (t (error "Not at an item or heading, and no active region")))) | |
1710 | (beg (car bounds)) | |
1711 | ;; marker is needed because deleting or inserting checkboxes | |
1712 | ;; will change bottom point | |
1713 | (end (copy-marker (nth 1 bounds))) | |
1714 | (single-p (nth 2 bounds)) | |
1715 | (ref-presence (save-excursion | |
1716 | (goto-char beg) | |
1717 | (org-at-item-checkbox-p))) | |
1718 | (ref-status (equal (match-string 1) "[X]")) | |
1719 | (act-on-item | |
1720 | (lambda (ref-pres ref-stat) | |
1721 | (if (equal toggle-presence '(4)) | |
1722 | (cond | |
1723 | ((and ref-pres (org-at-item-checkbox-p)) | |
1724 | (replace-match "")) | |
1725 | ((and (not ref-pres) | |
1726 | (not (org-at-item-checkbox-p)) | |
1727 | (org-at-item-p)) | |
1728 | (goto-char (match-end 0)) | |
1729 | ;; Ignore counter, if any | |
1730 | (when (looking-at "\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?") | |
1731 | (goto-char (match-end 0))) | |
1732 | (let ((desc-p (and (org-at-item-description-p) | |
1733 | (cdr (assq 'checkbox org-list-automatic-rules))))) | |
1734 | (cond | |
1735 | ((and single-p desc-p) | |
1736 | (error "Cannot add a checkbox in a description list")) | |
1737 | ((not desc-p) (insert "[ ] ")))))) | |
1738 | (let ((blocked (org-checkbox-blocked-p))) | |
1739 | (cond | |
1740 | ((and blocked single-p) | |
1741 | (error "Checkbox blocked because of unchecked box in line %d" blocked)) | |
1742 | (blocked nil) | |
1743 | ((org-at-item-checkbox-p) | |
1744 | (replace-match | |
1745 | (cond ((equal toggle-presence '(16)) "[-]") | |
1746 | (ref-stat "[ ]") | |
1747 | (t "[X]")) | |
1748 | t t nil 1)))))))) | |
c8d0cf5c | 1749 | (save-excursion |
47ffc456 | 1750 | (goto-char beg) |
47ffc456 | 1751 | (while (< (point) end) |
afe98dfa CD |
1752 | (funcall act-on-item ref-presence ref-status) |
1753 | (org-search-forward-unenclosed org-item-beginning-re end 'move))) | |
1754 | (org-update-checkbox-count-maybe))) | |
1755 | ||
1756 | (defun org-reset-checkbox-state-subtree () | |
1757 | "Reset all checkboxes in an entry subtree." | |
1758 | (interactive "*") | |
1759 | (save-restriction | |
47ffc456 | 1760 | (save-excursion |
afe98dfa CD |
1761 | (org-narrow-to-subtree) |
1762 | (org-show-subtree) | |
1763 | (goto-char (point-min)) | |
1764 | (let ((end (point-max))) | |
1765 | (while (< (point) end) | |
1766 | (when (org-at-item-checkbox-p) | |
1767 | (replace-match "[ ]" t t nil 1)) | |
1768 | (beginning-of-line 2)))) | |
1769 | (org-update-checkbox-count-maybe))) | |
8bfe682a | 1770 | |
afe98dfa CD |
1771 | (defvar org-checkbox-statistics-hook nil |
1772 | "Hook that is run whenever Org thinks checkbox statistics should be updated. | |
1773 | This hook runs even if checkbox rule in | |
1774 | `org-list-automatic-rules' does not apply, so it can be used to | |
1775 | implement alternative ways of collecting statistics | |
1776 | information.") | |
1777 | ||
1778 | (defun org-update-checkbox-count-maybe () | |
1779 | "Update checkbox statistics unless turned off by user." | |
1780 | (when (cdr (assq 'checkbox org-list-automatic-rules)) | |
1781 | (org-update-checkbox-count)) | |
1782 | (run-hooks 'org-checkbox-statistics-hook)) | |
1783 | ||
1784 | (defun org-update-checkbox-count (&optional all) | |
1785 | "Update the checkbox statistics in the current section. | |
1786 | This will find all statistic cookies like [57%] and [6/12] and update them | |
1787 | with the current numbers. With optional prefix argument ALL, do this for | |
1788 | the whole buffer." | |
1789 | (interactive "P") | |
c8d0cf5c | 1790 | (save-excursion |
afe98dfa CD |
1791 | (let ((cstat 0)) |
1792 | (catch 'exit | |
1793 | (while t | |
1794 | (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21 | |
1795 | (beg (condition-case nil | |
1796 | (progn (org-back-to-heading) (point)) | |
1797 | (error (point-min)))) | |
1798 | (end (copy-marker (save-excursion | |
1799 | (outline-next-heading) (point)))) | |
1800 | (re-cookie "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") | |
1801 | (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)") | |
1802 | beg-cookie end-cookie is-percent c-on c-off lim new | |
1803 | curr-ind next-ind continue-from startsearch list-beg list-end | |
1804 | (recursive | |
1805 | (or (not org-hierarchical-checkbox-statistics) | |
1806 | (string-match "\\<recursive\\>" | |
1807 | (or (ignore-errors | |
1808 | (org-entry-get nil "COOKIE_DATA")) | |
1809 | ""))))) | |
1810 | (goto-char end) | |
1811 | ;; find each statistics cookie | |
1812 | (while (and (org-search-backward-unenclosed re-cookie beg 'move) | |
1813 | (not (save-match-data | |
1814 | (and (org-on-heading-p) | |
1815 | (string-match "\\<todo\\>" | |
1816 | (downcase | |
1817 | (or (org-entry-get | |
1818 | nil "COOKIE_DATA") | |
1819 | ""))))))) | |
1820 | (setq beg-cookie (match-beginning 1) | |
1821 | end-cookie (match-end 1) | |
1822 | cstat (+ cstat (if end-cookie 1 0)) | |
1823 | startsearch (point-at-eol) | |
1824 | continue-from (match-beginning 0) | |
1825 | is-percent (match-beginning 2) | |
1826 | lim (cond | |
1827 | ((org-on-heading-p) (outline-next-heading) (point)) | |
1828 | ;; Ensure many cookies in the same list won't imply | |
1829 | ;; computing list boundaries as many times. | |
1830 | ((org-at-item-p) | |
1831 | (unless (and list-beg (>= (point) list-beg)) | |
1832 | (setq list-beg (org-list-top-point) | |
1833 | list-end (copy-marker | |
1834 | (org-list-bottom-point)))) | |
1835 | (org-get-end-of-item list-end)) | |
1836 | (t nil)) | |
1837 | c-on 0 | |
1838 | c-off 0) | |
1839 | (when lim | |
1840 | ;; find first checkbox for this cookie and gather | |
1841 | ;; statistics from all that are at this indentation level | |
1842 | (goto-char startsearch) | |
1843 | (if (org-search-forward-unenclosed re-box lim t) | |
1844 | (progn | |
1845 | (beginning-of-line) | |
1846 | (setq curr-ind (org-get-indentation)) | |
1847 | (setq next-ind curr-ind) | |
1848 | (while (and (bolp) (org-at-item-p) | |
1849 | (if recursive | |
1850 | (<= curr-ind next-ind) | |
1851 | (= curr-ind next-ind))) | |
1852 | (when (org-at-item-checkbox-p) | |
1853 | (if (member (match-string 1) '("[ ]" "[-]")) | |
1854 | (setq c-off (1+ c-off)) | |
1855 | (setq c-on (1+ c-on)))) | |
1856 | (if (not recursive) | |
1857 | ;; org-get-next-item goes through list-enders | |
1858 | ;; with proper limit. | |
1859 | (goto-char (or (org-get-next-item (point) lim) lim)) | |
1860 | (end-of-line) | |
1861 | (when (org-search-forward-unenclosed | |
1862 | org-item-beginning-re lim t) | |
1863 | (beginning-of-line))) | |
1864 | (setq next-ind (org-get-indentation))))) | |
1865 | (goto-char continue-from) | |
1866 | ;; update cookie | |
1867 | (when end-cookie | |
1868 | (setq new (if is-percent | |
1869 | (format "[%d%%]" (/ (* 100 c-on) | |
1870 | (max 1 (+ c-on c-off)))) | |
1871 | (format "[%d/%d]" c-on (+ c-on c-off)))) | |
1872 | (goto-char beg-cookie) | |
1873 | (insert new) | |
1874 | (delete-region (point) (+ (point) (- end-cookie beg-cookie)))) | |
1875 | ;; update items checkbox if it has one | |
1876 | (when (and (org-at-item-checkbox-p) | |
1877 | (> (+ c-on c-off) 0)) | |
1878 | (setq beg-cookie (match-beginning 1) | |
1879 | end-cookie (match-end 1)) | |
1880 | (delete-region beg-cookie end-cookie) | |
1881 | (goto-char beg-cookie) | |
1882 | (cond ((= c-off 0) (insert "[X]")) | |
1883 | ((= c-on 0) (insert "[ ]")) | |
1884 | (t (insert "[-]"))))) | |
1885 | (goto-char continue-from))) | |
1886 | (unless (and all (outline-next-heading)) (throw 'exit nil)))) | |
1887 | (when (interactive-p) | |
1888 | (message "Checkbox statistics updated %s (%d places)" | |
1889 | (if all "in entire file" "in current outline entry") cstat))))) | |
1890 | ||
1891 | (defun org-get-checkbox-statistics-face () | |
1892 | "Select the face for checkbox statistics. | |
1893 | The face will be `org-done' when all relevant boxes are checked. | |
1894 | Otherwise it will be `org-todo'." | |
1895 | (if (match-end 1) | |
1896 | (if (equal (match-string 1) "100%") | |
1897 | 'org-checkbox-statistics-done | |
1898 | 'org-checkbox-statistics-todo) | |
1899 | (if (and (> (match-end 2) (match-beginning 2)) | |
1900 | (equal (match-string 2) (match-string 3))) | |
1901 | 'org-checkbox-statistics-done | |
1902 | 'org-checkbox-statistics-todo))) | |
1903 | ||
1904 | ;;; Misc Tools | |
1905 | ||
1906 | (defun org-apply-on-list (function init-value &rest args) | |
1907 | "Call FUNCTION on each item of the list at point. | |
1908 | FUNCTION must be called with at least one argument: INIT-VALUE, | |
1909 | that will contain the value returned by the function at the | |
1910 | previous item, plus ARGS extra arguments. | |
1911 | ||
1912 | As an example, (org-apply-on-list (lambda (result) (1+ result)) 0) | |
1913 | will return the number of items in the current list. | |
1914 | ||
1915 | Sublists of the list are skipped. Cursor is always at the | |
1916 | beginning of the item." | |
1917 | (let* ((pos (copy-marker (point))) | |
1918 | (end (copy-marker (org-list-bottom-point))) | |
1919 | (next-p (copy-marker (org-get-beginning-of-list (org-list-top-point)))) | |
1920 | (value init-value)) | |
1921 | (while (< next-p end) | |
1922 | (goto-char next-p) | |
1923 | (set-marker next-p (or (org-get-next-item (point) end) end)) | |
1924 | (setq value (apply function value args))) | |
1925 | (goto-char pos) | |
1926 | value)) | |
1927 | ||
1928 | (defun org-sort-list (&optional with-case sorting-type getkey-func compare-func) | |
1929 | "Sort plain list items. | |
1930 | The cursor may be at any item of the list that should be sorted. | |
1931 | Sublists are not sorted. Checkboxes, if any, are ignored. | |
1932 | ||
1933 | Sorting can be alphabetically, numerically, by date/time as given by | |
1934 | a time stamp, by a property or by priority. | |
1935 | ||
1936 | Comparing entries ignores case by default. However, with an | |
1937 | optional argument WITH-CASE, the sorting considers case as well. | |
1938 | ||
1939 | The command prompts for the sorting type unless it has been given | |
1940 | to the function through the SORTING-TYPE argument, which needs to | |
1941 | be a character, \(?n ?N ?a ?A ?t ?T ?f ?F). Here is the precise | |
1942 | meaning of each character: | |
1943 | ||
1944 | n Numerically, by converting the beginning of the item to a number. | |
1945 | a Alphabetically. Only the first line of item is checked. | |
1946 | t By date/time, either the first active time stamp in the entry, if | |
1947 | any, or by the first inactive one. In a timer list, sort the timers. | |
1948 | ||
1949 | Capital letters will reverse the sort order. | |
1950 | ||
1951 | If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a | |
1952 | function to be called with point at the beginning of the record. | |
1953 | It must return either a string or a number that should serve as | |
1954 | the sorting key for that record. It will then use COMPARE-FUNC to | |
1955 | compare entries." | |
1956 | (interactive "P") | |
1957 | (let* ((case-func (if with-case 'identity 'downcase)) | |
1958 | (top (org-list-top-point)) | |
1959 | (bottom (org-list-bottom-point)) | |
1960 | (start (org-get-beginning-of-list top)) | |
1961 | (end (org-get-end-of-list bottom)) | |
1962 | (sorting-type | |
1963 | (progn | |
1964 | (message | |
1965 | "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:") | |
1966 | (read-char-exclusive))) | |
1967 | (getkey-func (and (= (downcase sorting-type) ?f) | |
1968 | (org-icompleting-read "Sort using function: " | |
1969 | obarray 'fboundp t nil nil) | |
1970 | (intern getkey-func)))) | |
1971 | (message "Sorting items...") | |
1972 | (save-restriction | |
1973 | (narrow-to-region start end) | |
1974 | (goto-char (point-min)) | |
1975 | (let* ((dcst (downcase sorting-type)) | |
1976 | (case-fold-search nil) | |
1977 | (now (current-time)) | |
1978 | (sort-func (cond | |
1979 | ((= dcst ?a) 'string<) | |
1980 | ((= dcst ?f) compare-func) | |
1981 | ((= dcst ?t) '<) | |
1982 | (t nil))) | |
1983 | (begin-record (lambda () | |
1984 | (skip-chars-forward " \r\t\n") | |
1985 | (beginning-of-line))) | |
1986 | (end-record (lambda () | |
1987 | (goto-char (org-end-of-item-before-blank end)))) | |
1988 | (value-to-sort | |
1989 | (lambda () | |
1990 | (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+") | |
1991 | (cond | |
1992 | ((= dcst ?n) | |
1993 | (string-to-number (buffer-substring (match-end 0) | |
1994 | (point-at-eol)))) | |
1995 | ((= dcst ?a) | |
1996 | (buffer-substring (match-end 0) (point-at-eol))) | |
1997 | ((= dcst ?t) | |
1998 | (cond | |
1999 | ;; If it is a timer list, convert timer to seconds | |
2000 | ((org-at-item-timer-p) | |
2001 | (org-timer-hms-to-secs (match-string 1))) | |
2002 | ((or (org-search-forward-unenclosed org-ts-regexp | |
2003 | (point-at-eol) t) | |
2004 | (org-search-forward-unenclosed org-ts-regexp-both | |
2005 | (point-at-eol) t)) | |
2006 | (org-time-string-to-seconds (match-string 0))) | |
2007 | (t (org-float-time now)))) | |
2008 | ((= dcst ?f) | |
2009 | (if getkey-func | |
2010 | (let ((value (funcall getkey-func))) | |
2011 | (if (stringp value) | |
2012 | (funcall case-func value) | |
2013 | value)) | |
2014 | (error "Invalid key function `%s'" getkey-func))) | |
2015 | (t (error "Invalid sorting type `%c'" sorting-type))))))) | |
2016 | (sort-subr (/= dcst sorting-type) | |
2017 | begin-record | |
2018 | end-record | |
2019 | value-to-sort | |
2020 | nil | |
2021 | sort-func) | |
2022 | (org-list-repair nil top bottom) | |
2023 | (run-hooks 'org-after-sorting-entries-or-items-hook) | |
2024 | (message "Sorting items...done"))))) | |
47ffc456 CD |
2025 | |
2026 | ;;; Send and receive lists | |
2027 | ||
2028 | (defun org-list-parse-list (&optional delete) | |
2029 | "Parse the list at point and maybe DELETE it. | |
2030 | Return a list containing first level items as strings and | |
2031 | sublevels as a list of strings." | |
afe98dfa CD |
2032 | (let* ((start (goto-char (org-list-top-point))) |
2033 | (end (org-list-bottom-point)) | |
33306645 | 2034 | output itemsep ltype) |
afe98dfa CD |
2035 | (while (org-search-forward-unenclosed org-item-beginning-re end t) |
2036 | (save-excursion | |
2037 | (beginning-of-line) | |
acedf35c | 2038 | (setq ltype (cond ((org-looking-at-p "^[ \t]*[0-9]") 'ordered) |
afe98dfa CD |
2039 | ((org-at-item-description-p) 'descriptive) |
2040 | (t 'unordered)))) | |
2041 | (let* ((indent1 (org-get-indentation)) | |
2042 | (nextitem (or (org-get-next-item (point) end) end)) | |
2043 | (item (org-trim (buffer-substring (point) | |
2044 | (org-end-of-item-or-at-child end)))) | |
2045 | (nextindent (if (= (point) end) 0 (org-get-indentation))) | |
2046 | (item (if (string-match | |
2047 | "^\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\[\\([xX ]\\)\\]" | |
2048 | item) | |
0bd48b37 | 2049 | (replace-match (if (equal (match-string 1 item) " ") |
afe98dfa CD |
2050 | "CBOFF" |
2051 | "CBON") | |
2052 | t nil item 1) | |
0bd48b37 | 2053 | item))) |
47ffc456 | 2054 | (push item output) |
afe98dfa CD |
2055 | (when (> nextindent indent1) |
2056 | (save-restriction | |
2057 | (narrow-to-region (point) nextitem) | |
2058 | (push (org-list-parse-list) output))))) | |
2059 | (when delete | |
2060 | (delete-region start end) | |
2061 | (save-match-data | |
2062 | (when (and (not (eq org-list-ending-method 'indent)) | |
2063 | (looking-at (org-list-end-re))) | |
2064 | (replace-match "\n")))) | |
47ffc456 CD |
2065 | (setq output (nreverse output)) |
2066 | (push ltype output))) | |
2067 | ||
c8d0cf5c CD |
2068 | (defun org-list-make-subtree () |
2069 | "Convert the plain list at point into a subtree." | |
2070 | (interactive) | |
afe98dfa CD |
2071 | (if (not (org-in-item-p)) |
2072 | (error "Not in a list") | |
2073 | (let ((list (org-list-parse-list t)) nstars) | |
2074 | (save-excursion | |
2075 | (if (ignore-errors | |
2076 | (org-back-to-heading)) | |
2077 | (progn (looking-at org-complex-heading-regexp) | |
2078 | (setq nstars (length (match-string 1)))) | |
2079 | (setq nstars 0))) | |
2080 | (org-list-make-subtrees list (1+ nstars))))) | |
c8d0cf5c CD |
2081 | |
2082 | (defun org-list-make-subtrees (list level) | |
2083 | "Convert LIST into subtrees starting at LEVEL." | |
2084 | (if (symbolp (car list)) | |
2085 | (org-list-make-subtrees (cdr list) level) | |
2086 | (mapcar (lambda (item) | |
2087 | (if (stringp item) | |
2088 | (insert (make-string | |
2089 | (if org-odd-levels-only | |
2090 | (1- (* 2 level)) level) ?*) " " item "\n") | |
2091 | (org-list-make-subtrees item (1+ level)))) | |
2092 | list))) | |
2093 | ||
47ffc456 CD |
2094 | (defun org-list-insert-radio-list () |
2095 | "Insert a radio list template appropriate for this major mode." | |
2096 | (interactive) | |
2097 | (let* ((e (assq major-mode org-list-radio-list-templates)) | |
2098 | (txt (nth 1 e)) | |
2099 | name pos) | |
2100 | (unless e (error "No radio list setup defined for %s" major-mode)) | |
2101 | (setq name (read-string "List name: ")) | |
2102 | (while (string-match "%n" txt) | |
2103 | (setq txt (replace-match name t t txt))) | |
2104 | (or (bolp) (insert "\n")) | |
2105 | (setq pos (point)) | |
2106 | (insert txt) | |
2107 | (goto-char pos))) | |
2108 | ||
2109 | (defun org-list-send-list (&optional maybe) | |
8bfe682a | 2110 | "Send a transformed version of this list to the receiver position. |
47ffc456 CD |
2111 | With argument MAYBE, fail quietly if no transformation is defined for |
2112 | this list." | |
2113 | (interactive) | |
2114 | (catch 'exit | |
afe98dfa | 2115 | (unless (org-at-item-p) (error "Not at a list item")) |
47ffc456 | 2116 | (save-excursion |
afe98dfa | 2117 | (re-search-backward "#\\+ORGLST" nil t) |
86fbb8ca | 2118 | (unless (looking-at "[ \t]*#\\+ORGLST[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?") |
47ffc456 CD |
2119 | (if maybe |
2120 | (throw 'exit nil) | |
2121 | (error "Don't know how to transform this list")))) | |
2122 | (let* ((name (match-string 1)) | |
47ffc456 | 2123 | (transform (intern (match-string 2))) |
afe98dfa CD |
2124 | (bottom-point |
2125 | (save-excursion | |
2126 | (re-search-forward | |
2127 | "\\(\\\\end{comment}\\|@end ignore\\|-->\\)" nil t) | |
2128 | (match-beginning 0))) | |
2129 | (top-point | |
2130 | (progn | |
2131 | (re-search-backward "#\\+ORGLST" nil t) | |
2132 | (re-search-forward org-item-beginning-re bottom-point t) | |
2133 | (match-beginning 0))) | |
2134 | (list (save-restriction | |
2135 | (narrow-to-region top-point bottom-point) | |
2136 | (org-list-parse-list))) | |
2137 | beg txt) | |
47ffc456 CD |
2138 | (unless (fboundp transform) |
2139 | (error "No such transformation function %s" transform)) | |
86fbb8ca CD |
2140 | (let ((txt (funcall transform list))) |
2141 | ;; Find the insertion place | |
2142 | (save-excursion | |
2143 | (goto-char (point-min)) | |
2144 | (unless (re-search-forward | |
afe98dfa CD |
2145 | (concat "BEGIN RECEIVE ORGLST +" |
2146 | name | |
2147 | "\\([ \t]\\|$\\)") nil t) | |
86fbb8ca CD |
2148 | (error "Don't know where to insert translated list")) |
2149 | (goto-char (match-beginning 0)) | |
2150 | (beginning-of-line 2) | |
2151 | (setq beg (point)) | |
2152 | (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t) | |
2153 | (error "Cannot find end of insertion region")) | |
afe98dfa | 2154 | (delete-region beg (point-at-bol)) |
86fbb8ca CD |
2155 | (goto-char beg) |
2156 | (insert txt "\n"))) | |
47ffc456 CD |
2157 | (message "List converted and installed at receiver location")))) |
2158 | ||
2159 | (defun org-list-to-generic (list params) | |
2160 | "Convert a LIST parsed through `org-list-parse-list' to other formats. | |
47ffc456 CD |
2161 | Valid parameters PARAMS are |
2162 | ||
33306645 CD |
2163 | :ustart String to start an unordered list |
2164 | :uend String to end an unordered list | |
47ffc456 | 2165 | |
33306645 CD |
2166 | :ostart String to start an ordered list |
2167 | :oend String to end an ordered list | |
47ffc456 | 2168 | |
33306645 CD |
2169 | :dstart String to start a descriptive list |
2170 | :dend String to end a descriptive list | |
47ffc456 | 2171 | :dtstart String to start a descriptive term |
33306645 | 2172 | :dtend String to end a descriptive term |
47ffc456 | 2173 | :ddstart String to start a description |
33306645 | 2174 | :ddend String to end a description |
47ffc456 | 2175 | |
33306645 CD |
2176 | :splice When set to t, return only list body lines, don't wrap |
2177 | them into :[u/o]start and :[u/o]end. Default is nil. | |
47ffc456 | 2178 | |
33306645 CD |
2179 | :istart String to start a list item |
2180 | :iend String to end a list item | |
2181 | :isep String to separate items | |
0bd48b37 CD |
2182 | :lsep String to separate sublists |
2183 | ||
2184 | :cboff String to insert for an unchecked checkbox | |
2185 | :cbon String to insert for a checked checkbox" | |
47ffc456 CD |
2186 | (interactive) |
2187 | (let* ((p params) sublist | |
2188 | (splicep (plist-get p :splice)) | |
afe98dfa CD |
2189 | (ostart (plist-get p :ostart)) |
2190 | (oend (plist-get p :oend)) | |
2191 | (ustart (plist-get p :ustart)) | |
2192 | (uend (plist-get p :uend)) | |
2193 | (dstart (plist-get p :dstart)) | |
2194 | (dend (plist-get p :dend)) | |
2195 | (dtstart (plist-get p :dtstart)) | |
2196 | (dtend (plist-get p :dtend)) | |
2197 | (ddstart (plist-get p :ddstart)) | |
2198 | (ddend (plist-get p :ddend)) | |
2199 | (istart (plist-get p :istart)) | |
2200 | (iend (plist-get p :iend)) | |
2201 | (isep (plist-get p :isep)) | |
2202 | (lsep (plist-get p :lsep)) | |
2203 | (cbon (plist-get p :cbon)) | |
0bd48b37 | 2204 | (cboff (plist-get p :cboff))) |
47ffc456 CD |
2205 | (let ((wrapper |
2206 | (cond ((eq (car list) 'ordered) | |
2207 | (concat ostart "\n%s" oend "\n")) | |
2208 | ((eq (car list) 'unordered) | |
2209 | (concat ustart "\n%s" uend "\n")) | |
2210 | ((eq (car list) 'descriptive) | |
2211 | (concat dstart "\n%s" dend "\n")))) | |
2212 | rtn term defstart defend) | |
2213 | (while (setq sublist (pop list)) | |
2214 | (cond ((symbolp sublist) nil) | |
2215 | ((stringp sublist) | |
afe98dfa | 2216 | (when (string-match "^\\(.*\\)[ \t]+::" sublist) |
33306645 CD |
2217 | (setq term (org-trim (format (concat dtstart "%s" dtend) |
2218 | (match-string 1 sublist)))) | |
afe98dfa CD |
2219 | (setq sublist (concat ddstart |
2220 | (org-trim (substring sublist | |
2221 | (match-end 0))) | |
2222 | ddend))) | |
0bd48b37 CD |
2223 | (if (string-match "\\[CBON\\]" sublist) |
2224 | (setq sublist (replace-match cbon t t sublist))) | |
2225 | (if (string-match "\\[CBOFF\\]" sublist) | |
2226 | (setq sublist (replace-match cboff t t sublist))) | |
8bfe682a CD |
2227 | (if (string-match "\\[-\\]" sublist) |
2228 | (setq sublist (replace-match "$\\boxminus$" t t sublist))) | |
afe98dfa CD |
2229 | (setq rtn (concat rtn istart term sublist iend isep))) |
2230 | (t (setq rtn (concat rtn ;; previous list | |
2231 | lsep ;; list separator | |
33306645 | 2232 | (org-list-to-generic sublist p) |
afe98dfa | 2233 | lsep ;; list separator |
33306645 | 2234 | ))))) |
47ffc456 CD |
2235 | (format wrapper rtn)))) |
2236 | ||
0bd48b37 CD |
2237 | (defun org-list-to-latex (list &optional params) |
2238 | "Convert LIST into a LaTeX list. | |
86fbb8ca | 2239 | LIST is as returned by `org-list-parse-list'. PARAMS is a property list |
0bd48b37 | 2240 | with overruling parameters for `org-list-to-generic'." |
47ffc456 | 2241 | (org-list-to-generic |
0bd48b37 CD |
2242 | list |
2243 | (org-combine-plists | |
2244 | '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}" | |
2245 | :ustart "\\begin{itemize}" :uend "\\end{itemize}" | |
2246 | :dstart "\\begin{description}" :dend "\\end{description}" | |
2247 | :dtstart "[" :dtend "]" | |
2248 | :ddstart "" :ddend "" | |
2249 | :istart "\\item " :iend "" | |
2250 | :isep "\n" :lsep "\n" | |
2251 | :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}") | |
2252 | params))) | |
2253 | ||
2254 | (defun org-list-to-html (list &optional params) | |
2255 | "Convert LIST into a HTML list. | |
86fbb8ca | 2256 | LIST is as returned by `org-list-parse-list'. PARAMS is a property list |
0bd48b37 | 2257 | with overruling parameters for `org-list-to-generic'." |
47ffc456 | 2258 | (org-list-to-generic |
0bd48b37 CD |
2259 | list |
2260 | (org-combine-plists | |
2261 | '(:splicep nil :ostart "<ol>" :oend "</ol>" | |
2262 | :ustart "<ul>" :uend "</ul>" | |
2263 | :dstart "<dl>" :dend "</dl>" | |
2264 | :dtstart "<dt>" :dtend "</dt>" | |
2265 | :ddstart "<dd>" :ddend "</dd>" | |
2266 | :istart "<li>" :iend "</li>" | |
2267 | :isep "\n" :lsep "\n" | |
2268 | :cbon "<code>[X]</code>" :cboff "<code>[ ]</code>") | |
2269 | params))) | |
2270 | ||
2271 | (defun org-list-to-texinfo (list &optional params) | |
2272 | "Convert LIST into a Texinfo list. | |
86fbb8ca | 2273 | LIST is as returned by `org-list-parse-list'. PARAMS is a property list |
0bd48b37 | 2274 | with overruling parameters for `org-list-to-generic'." |
47ffc456 | 2275 | (org-list-to-generic |
c8d0cf5c | 2276 | list |
0bd48b37 CD |
2277 | (org-combine-plists |
2278 | '(:splicep nil :ostart "@itemize @minus" :oend "@end itemize" | |
2279 | :ustart "@enumerate" :uend "@end enumerate" | |
2280 | :dstart "@table" :dend "@end table" | |
2281 | :dtstart "@item " :dtend "\n" | |
2282 | :ddstart "" :ddend "" | |
2283 | :istart "@item\n" :iend "" | |
2284 | :isep "\n" :lsep "\n" | |
2285 | :cbon "@code{[X]}" :cboff "@code{[ ]}") | |
2286 | params))) | |
47ffc456 CD |
2287 | |
2288 | (provide 'org-list) | |
2289 | ||
2290 | ;;; org-list.el ends here |