org-list.el 70 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887
  1. ;;; org-list.el --- Plain lists for Org-mode
  2. ;;
  3. ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
  4. ;; Free Software Foundation, Inc.
  5. ;;
  6. ;; Author: Carsten Dominik <carsten at orgmode dot org>
  7. ;; Bastien Guerry <bzg AT altern DOT org>
  8. ;; Keywords: outlines, hypermedia, calendar, wp
  9. ;; Homepage: http://orgmode.org
  10. ;; Version: 7.01trans
  11. ;;
  12. ;; This file is part of GNU Emacs.
  13. ;;
  14. ;; GNU Emacs is free software: you can redistribute it and/or modify
  15. ;; it under the terms of the GNU General Public License as published by
  16. ;; the Free Software Foundation, either version 3 of the License, or
  17. ;; (at your option) any later version.
  18. ;; GNU Emacs is distributed in the hope that it will be useful,
  19. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  21. ;; GNU General Public License for more details.
  22. ;; You should have received a copy of the GNU General Public License
  23. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  24. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25. ;;
  26. ;;; Commentary:
  27. ;; This file contains the code dealing with plain lists in Org-mode.
  28. ;;; Code:
  29. (eval-when-compile
  30. (require 'cl))
  31. (require 'org-macs)
  32. (require 'org-compat)
  33. (defvar org-blank-before-new-entry)
  34. (defvar org-M-RET-may-split-line)
  35. (defvar org-complex-heading-regexp)
  36. (defvar org-odd-levels-only)
  37. (declare-function org-invisible-p "org" ())
  38. (declare-function org-on-heading-p "org" (&optional invisible-ok))
  39. (declare-function outline-next-heading "outline" ())
  40. (declare-function org-back-to-heading "org" (&optional invisible-ok))
  41. (declare-function org-back-over-empty-lines "org" ())
  42. (declare-function org-skip-whitespace "org" ())
  43. (declare-function org-trim "org" (s))
  44. (declare-function org-get-indentation "org" (&optional line))
  45. (declare-function org-timer-item "org-timer" (&optional arg))
  46. (declare-function org-combine-plists "org" (&rest plists))
  47. (declare-function org-entry-get "org"
  48. (pom property &optional inherit literal-nil))
  49. (declare-function org-narrow-to-subtree "org" ())
  50. (declare-function org-show-subtree "org" ())
  51. (defgroup org-plain-lists nil
  52. "Options concerning plain lists in Org-mode."
  53. :tag "Org Plain lists"
  54. :group 'org-structure)
  55. (defcustom org-cycle-include-plain-lists t
  56. "When t, make TAB cycle visibility on plain list items.
  57. Cycling plain lists works only when the cursor is on a plain list
  58. item. When the cursor is on an outline heading, plain lists are
  59. treated as text. This is the most stable way of handling this,
  60. which is why it is the default.
  61. When this is the symbol `integrate', then during cycling, plain
  62. list items will *temporarily* be interpreted as outline headlines
  63. with a level given by 1000+i where i is the indentation of the
  64. bullet. This setting can lead to strange effects when switching
  65. visibility to `children', because the first \"child\" in a
  66. subtree decides what children should be listed. If that first
  67. \"child\" is a plain list item with an implied large level
  68. number, all true children and grand children of the outline
  69. heading will be exposed in a children' view."
  70. :group 'org-plain-lists
  71. :type '(choice
  72. (const :tag "Never" nil)
  73. (const :tag "With cursor in plain list (recommended)" t)
  74. (const :tag "As children of outline headings" integrate)))
  75. (defcustom org-list-demote-modify-bullet nil
  76. "Default bullet type installed when demoting an item.
  77. This is an association list, for each bullet type, this alist will point
  78. to the bullet that should be used when this item is demoted.
  79. For example,
  80. (setq org-list-demote-modify-bullet
  81. '((\"+\" . \"-\") (\"-\" . \"+\") (\"*\" . \"+\")))
  82. will make
  83. + Movies
  84. + Silence of the Lambs
  85. + My Cousin Vinny
  86. + Books
  87. + The Hunt for Red October
  88. + The Road to Omaha
  89. into
  90. + Movies
  91. - Silence of the Lambs
  92. - My Cousin Vinny
  93. + Books
  94. - The Hunt for Red October
  95. - The Road to Omaha"
  96. :group 'org-plain-lists
  97. :type '(repeat
  98. (cons
  99. (choice :tag "If the current bullet is "
  100. (const "-")
  101. (const "+")
  102. (const "*")
  103. (const "1.")
  104. (const "1)"))
  105. (choice :tag "demotion will change it to"
  106. (const "-")
  107. (const "+")
  108. (const "*")
  109. (const "1.")
  110. (const "1)")))))
  111. (defcustom org-plain-list-ordered-item-terminator t
  112. "The character that makes a line with leading number an ordered list item.
  113. Valid values are ?. and ?\). To get both terminators, use t. While
  114. ?. may look nicer, it creates the danger that a line with leading
  115. number may be incorrectly interpreted as an item. ?\) therefore is
  116. the safe choice."
  117. :group 'org-plain-lists
  118. :type '(choice (const :tag "dot like in \"2.\"" ?.)
  119. (const :tag "paren like in \"2)\"" ?\))
  120. (const :tab "both" t)))
  121. (defcustom org-list-two-spaces-after-bullet-regexp nil
  122. "A regular expression matching bullets that should have 2 spaces after them.
  123. When nil, no bullet will have two spaces after them.
  124. When a string, it will be used as a regular expression. When the
  125. bullet type of a list is changed, the new bullet type will be
  126. matched against this regexp. If it matches, there will be two
  127. spaces instead of one after the bullet in each item of the list."
  128. :group 'org-plain-lists
  129. :type '(choice
  130. (const :tag "never" nil)
  131. (regexp)))
  132. (defcustom org-empty-line-terminates-plain-lists nil
  133. "Non-nil means an empty line ends all plain list levels.
  134. Otherwise, look for `org-list-end-regexp'."
  135. :group 'org-plain-lists
  136. :type 'boolean)
  137. (defcustom org-list-end-regexp "^[ \t]*\n[ \t]*\n"
  138. "Regexp matching the end of all plain list levels.
  139. It must start with \"^\" and end with \"\\n\". It defaults to 2
  140. blank lines. `org-empty-line-terminates-plain-lists' has
  141. precedence over it."
  142. :group 'org-plain-lists
  143. :type 'string)
  144. (defcustom org-list-automatic-rules '((bullet . t)
  145. (checkbox . t)
  146. (indent . t)
  147. (insert . t)
  148. (renumber . t))
  149. "Non-nil means apply set of rules when acting on lists.
  150. By default, automatic actions are taken when using
  151. \\[org-shiftmetaup], \\[org-shiftmetadown], \\[org-meta-return],
  152. \\[org-metaright], \\[org-metaleft], \\[org-shiftmetaright],
  153. \\[org-shiftmetaleft], \\[org-ctrl-c-minus],
  154. \\[org-toggle-checkbox] or \\[org-insert-todo-heading]. You can
  155. disable individually these rules by setting them to nil. Valid
  156. rules are:
  157. bullet when non-nil, cycling bullet do not allow lists at
  158. column 0 to have * as a bullet and descriptions lists
  159. to be numbered.
  160. checkbox when non-nil, checkbox statistics is updated each time
  161. you either insert a new checkbox or toggle a checkbox.
  162. It also prevents from inserting a checkbox in a
  163. description item.
  164. indent when non-nil indenting or outdenting list top-item with
  165. its subtree will move the whole list and outdenting a
  166. list whose bullet is * to column 0 will change that
  167. bullet to -.
  168. insert when non-nil, trying to insert an item inside a block
  169. will insert it right before the block instead of
  170. throwing an error.
  171. renumber when non-nil, renumber ordered plain lists whenever it
  172. is modified. You can always use \\[org-ctrl-c-ctrl-c]
  173. to trigger renumbering."
  174. :group 'org-plain-lists
  175. :type '(alist :tag "Sets of rules"
  176. :key-type
  177. (choice
  178. (const :tag "Bullet" bullet)
  179. (const :tag "Checkbox" checkbox)
  180. (const :tag "Indent" indent)
  181. (const :tag "Insert" insert)
  182. (const :tag "Renumber" renumber))
  183. :value-type
  184. (boolean :tag "Activate" :value t)))
  185. (defcustom org-hierarchical-checkbox-statistics t
  186. "Non-nil means checkbox statistics counts only the state of direct children.
  187. When nil, all boxes below the cookie are counted.
  188. This can be set to nil on a per-node basis using a COOKIE_DATA property
  189. with the word \"recursive\" in the value."
  190. :group 'org-plain-lists
  191. :type 'boolean)
  192. (defcustom org-description-max-indent 20
  193. "Maximum indentation for the second line of a description list.
  194. When the indentation would be larger than this, it will become
  195. 5 characters instead."
  196. :group 'org-plain-lists
  197. :type 'integer)
  198. (defcustom org-list-radio-list-templates
  199. '((latex-mode "% BEGIN RECEIVE ORGLST %n
  200. % END RECEIVE ORGLST %n
  201. \\begin{comment}
  202. #+ORGLST: SEND %n org-list-to-latex
  203. -
  204. \\end{comment}\n")
  205. (texinfo-mode "@c BEGIN RECEIVE ORGLST %n
  206. @c END RECEIVE ORGLST %n
  207. @ignore
  208. #+ORGLST: SEND %n org-list-to-texinfo
  209. -
  210. @end ignore\n")
  211. (html-mode "<!-- BEGIN RECEIVE ORGLST %n -->
  212. <!-- END RECEIVE ORGLST %n -->
  213. <!--
  214. #+ORGLST: SEND %n org-list-to-html
  215. -
  216. -->\n"))
  217. "Templates for radio lists in different major modes.
  218. All occurrences of %n in a template will be replaced with the name of the
  219. list, obtained by prompting the user."
  220. :group 'org-plain-lists
  221. :type '(repeat
  222. (list (symbol :tag "Major mode")
  223. (string :tag "Format"))))
  224. ;;; Internal functions
  225. (defun org-list-end-re ()
  226. "Return the regex corresponding to the end of a list.
  227. It depends on `org-empty-line-terminates-plain-lists'."
  228. (if org-empty-line-terminates-plain-lists
  229. "^[ \t]*\n"
  230. org-list-end-regexp))
  231. (defun org-item-re (&optional general)
  232. "Return the correct regular expression for plain lists.
  233. If GENERAL is non-nil, return the general regexp independent of the value
  234. of `org-plain-list-ordered-item-terminator'."
  235. (cond
  236. ((or general (eq org-plain-list-ordered-item-terminator t))
  237. "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")
  238. ((= org-plain-list-ordered-item-terminator ?.)
  239. "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")
  240. ((= org-plain-list-ordered-item-terminator ?\))
  241. "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")
  242. (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))))
  243. (defconst org-item-beginning-re (concat "^" (org-item-re))
  244. "Regexp matching the beginning of a plain list item.")
  245. (defun org-list-terminator-between (min max &optional firstp)
  246. "Find the position of a list ender between MIN and MAX, or nil.
  247. This function looks for `org-list-end-re' outside a block.
  248. If FIRSTP in non-nil, return the point at the beginning of the
  249. nearest valid terminator from min. Otherwise, return the point at
  250. the end of the nearest terminator from max."
  251. (save-excursion
  252. (let* ((start (if firstp min max))
  253. (end (if firstp max min))
  254. (search-fun (if firstp
  255. #'org-search-forward-unenclosed
  256. #'org-search-backward-unenclosed))
  257. (list-end-p (progn
  258. (goto-char start)
  259. (funcall search-fun (org-list-end-re) end t))))
  260. ;; Is there a valid list terminator somewhere ?
  261. (and list-end-p
  262. ;; we want to be on the first line of the list ender
  263. (match-beginning 0)))))
  264. (defun org-list-search-unenclosed-generic (search-fun regexp bound noerror count)
  265. "Search for REGEXP with SEARCH-FUN but don't stop inside blocks or at protected places."
  266. (let ((origin (point)))
  267. (cond
  268. ;; nothing found: return nil
  269. ((not (funcall search-fun regexp bound noerror count)) nil)
  270. ((or (save-match-data
  271. (org-in-regexps-block-p "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)"
  272. '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2))))
  273. (get-text-property (match-beginning 0) 'org-protected))
  274. ;; match is enclosed or protected: start again, searching one
  275. ;; occurrence away.
  276. (goto-char origin)
  277. (org-list-search-unenclosed-generic search-fun regexp bound noerror (1+ count)))
  278. ;; else return point.
  279. (t (point)))))
  280. (defun org-search-backward-unenclosed (regexp &optional bound noerror)
  281. "Like `re-search-backward' but don't stop inside blocks or at protected places."
  282. (org-list-search-unenclosed-generic #'re-search-backward regexp bound noerror 1))
  283. (defun org-search-forward-unenclosed (regexp &optional bound noerror)
  284. "Like `re-search-forward' but don't stop inside blocks or at protected places."
  285. (org-list-search-unenclosed-generic #'re-search-forward regexp bound noerror 1))
  286. (defun org-list-at-regexp-after-bullet-p (regexp)
  287. "Is point at a list item with REGEXP after bullet?"
  288. (and (org-at-item-p)
  289. (save-excursion
  290. (goto-char (match-end 0))
  291. ;; Ignore counter if any
  292. (when (looking-at "\\(?:\\[@start:[0-9]+\\][ \t]*\\)?")
  293. (goto-char (match-end 0)))
  294. (looking-at regexp))))
  295. (defun org-list-get-item-same-level (search-fun pos limit pre-move)
  296. "Return point at the beginning of next item at the same level.
  297. Search items using function SEARCH-FUN, from POS to LIMIT. It
  298. uses PRE-MOVE before search. Return nil if no item was found."
  299. (save-excursion
  300. (goto-char pos)
  301. (let ((ind (progn
  302. (org-beginning-of-item)
  303. (org-get-indentation)))
  304. (start (point-at-bol)))
  305. ;; We don't want to match the current line.
  306. (funcall pre-move)
  307. ;; Skip any sublist on the way
  308. (while (and (funcall search-fun org-item-beginning-re limit t)
  309. (> (org-get-indentation) ind)))
  310. (when (and (/= (point-at-bol) start) ; Have we moved ?
  311. (= (org-get-indentation) ind))
  312. (point-at-bol)))))
  313. (defun org-list-insert-item-generic (pos &optional checkbox after-bullet)
  314. "Insert a new list item at POS.
  315. If POS is before first character after bullet of the item, the
  316. new item will be created before the current one.
  317. Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET
  318. after the bullet. Cursor will be after this text once the
  319. function ends."
  320. (goto-char pos)
  321. ;; Is point in a special block?
  322. (when (org-in-regexps-block-p
  323. "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)"
  324. '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2)))
  325. (if (not (cdr (assq 'insert org-list-automatic-rules)))
  326. ;; Rule in `org-list-automatic-rules' forbids insertion.
  327. (error "Cannot insert item inside a block.")
  328. ;; Else, move before it prior to add a new item.
  329. (end-of-line)
  330. (re-search-backward "^[ \t]*#\\+\\(begin\\|BEGIN\\)_" nil t)
  331. (end-of-line 0)))
  332. (let* ((true-pos (point))
  333. (bullet (and (org-beginning-of-item)
  334. (org-list-bullet-string (org-get-bullet))))
  335. (ind (org-get-indentation))
  336. (before-p (progn
  337. ;; Description item: text starts after colons.
  338. (or (org-at-item-description-p)
  339. ;; At a checkbox: text starts after it.
  340. (org-at-item-checkbox-p)
  341. ;; Otherwise, text starts after bullet.
  342. (org-at-item-p))
  343. (<= true-pos (match-end 0))))
  344. ;; Guess number of blank lines used to separate items.
  345. (blank-lines-nb
  346. (let ((insert-blank-p
  347. (cdr (assq 'plain-list-item org-blank-before-new-entry))))
  348. (cond
  349. ;; Trivial cases where there should be none.
  350. ((or org-empty-line-terminates-plain-lists
  351. (not insert-blank-p)) 0)
  352. ;; When `org-blank-before-new-entry' says so, it is 1.
  353. ((eq insert-blank-p t) 1)
  354. ;; plain-list-item is 'auto. Count blank lines separating
  355. ;; neighbours items in list.
  356. (t (let ((next-p (org-get-next-item (point) (org-list-bottom-point))))
  357. (cond
  358. ;; Is there a next item?
  359. (next-p (goto-char next-p)
  360. (org-back-over-empty-lines))
  361. ;; Is there a previous item?
  362. ((not (org-list-first-item-p)) (org-back-over-empty-lines))
  363. ;; Item alone: count lines separating it from parent, if any
  364. ((/= (org-list-top-point) (point-at-bol))
  365. (org-back-over-empty-lines))
  366. ;; No parent: no blank line.
  367. (t 0)))))))
  368. (insert-fun
  369. (lambda (text)
  370. ;; insert bullet above item in order to avoid bothering
  371. ;; with possible blank lines ending last item.
  372. (org-beginning-of-item)
  373. (indent-to-column ind)
  374. (insert (concat bullet (when checkbox "[ ] ") after-bullet))
  375. ;; Stay between after-bullet and before text.
  376. (save-excursion
  377. (insert (concat text (make-string (1+ blank-lines-nb) ?\n))))
  378. (unless before-p (org-move-item-down))
  379. (when checkbox (org-update-checkbox-count-maybe)))))
  380. (goto-char true-pos)
  381. (cond
  382. (before-p (funcall insert-fun nil)
  383. ;; Not taking advantage of renumbering while moving
  384. ;; down. Need to call it directly.
  385. (org-maybe-renumber-ordered-list) t)
  386. ;; Can't split item: insert bullet at the end of item.
  387. ((not (org-get-alist-option org-M-RET-may-split-line 'item))
  388. (funcall insert-fun nil) t)
  389. ;; else, insert a new bullet along with everything from point
  390. ;; down to last non-blank line of item.
  391. (t
  392. (delete-horizontal-space)
  393. ;; Get pos again in case previous command modified line.
  394. (let* ((pos (point))
  395. (end-before-blank (org-end-of-item-before-blank))
  396. (after-text
  397. (when (< pos end-before-blank)
  398. (prog1
  399. (delete-and-extract-region pos end-before-blank)
  400. ;; delete any blank line at and before point.
  401. (beginning-of-line)
  402. (while (looking-at "^[ \t]*$")
  403. (delete-region (point-at-bol) (1+ (point-at-eol)))
  404. (beginning-of-line 0))))))
  405. (funcall insert-fun after-text) t)))))
  406. ;;; Predicates
  407. (defun org-in-item-p ()
  408. "Is the cursor inside a plain list ?"
  409. (unless (let ((outline-regexp org-outline-regexp)) (org-at-heading-p))
  410. (save-excursion
  411. (let* ((limit (save-excursion (outline-previous-heading)))
  412. ;; Move to eol so current line can be matched by `org-item-re'.
  413. (actual-pos (goto-char (point-at-eol)))
  414. (last-item-start (save-excursion
  415. (org-search-backward-unenclosed org-item-beginning-re limit t)))
  416. (list-ender (org-list-terminator-between last-item-start actual-pos)))
  417. ;; We are in a list when we are on an item line or when we can
  418. ;; find an item before point and there is no valid list ender
  419. ;; between it and the point.
  420. (and last-item-start
  421. (not list-ender))))))
  422. (defun org-list-first-item-p ()
  423. "Is this item the first item in a plain list?"
  424. (save-excursion
  425. (= (org-beginning-of-item) (org-beginning-of-item-list))))
  426. (defun org-at-item-p ()
  427. "Is point in a line starting a hand-formatted item?"
  428. (save-excursion
  429. (beginning-of-line) (looking-at org-item-beginning-re)))
  430. (defun org-at-item-bullet-p ()
  431. "Is point at the bullet of a plain list item?"
  432. (and (org-at-item-p)
  433. (not (member (char-after) '(?\ ?\t)))
  434. (< (point) (match-end 0))))
  435. (defun org-at-item-timer-p ()
  436. "Is point at a line starting a plain list item with a timer?"
  437. (org-list-at-regexp-after-bullet-p "\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+::[ \t]+"))
  438. (defun org-at-item-description-p ()
  439. "Is point at a description list item?"
  440. (org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::[ \t]+"))
  441. (defun org-at-item-checkbox-p ()
  442. "Is point at a line starting a plain-list item with a checklet?"
  443. (org-list-at-regexp-after-bullet-p "\\(\\[[- X]\\]\\)[ \t]+"))
  444. (defun org-item-has-child-p ()
  445. "Does the current item have subitems?"
  446. (save-excursion
  447. (org-beginning-of-item)
  448. (let ((ind (org-get-indentation)))
  449. (org-end-of-item-or-at-child)
  450. (and (org-at-item-p)
  451. (> (org-get-indentation) ind)))))
  452. (defun org-checkbox-blocked-p ()
  453. "Is the current checkbox blocked from for being checked now?
  454. A checkbox is blocked if all of the following conditions are fulfilled:
  455. 1. The checkbox is not checked already.
  456. 2. The current entry has the ORDERED property set.
  457. 3. There is an unchecked checkbox in this entry before the current line."
  458. (catch 'exit
  459. (save-match-data
  460. (save-excursion
  461. (unless (org-at-item-checkbox-p) (throw 'exit nil))
  462. (when (equal (match-string 1) "[X]")
  463. ;; the box is already checked!
  464. (throw 'exit nil))
  465. (let ((end (point-at-bol)))
  466. (condition-case nil (org-back-to-heading t)
  467. (error (throw 'exit nil)))
  468. (unless (org-entry-get nil "ORDERED") (throw 'exit nil))
  469. (when (org-search-forward-unenclosed
  470. "^[ \t]*[-+*0-9.)]+[ \t]+\\(\\[@start:[0-9]+\\][ \t]*\\)?\\[[- ]\\]" end t)
  471. (org-current-line)))))))
  472. ;;; Navigate
  473. (defun org-list-top-point ()
  474. "Return point at the top level item in a list, or nil if not in a list."
  475. (save-excursion
  476. (and (org-in-item-p)
  477. (let ((pos (point-at-eol))
  478. (bound (or (outline-previous-heading) (point-min))))
  479. ;; Is there some list above this one ? If so, go to its ending.
  480. ;; Otherwise, go back to the heading above or bob.
  481. (goto-char (or (org-list-terminator-between bound pos) bound))
  482. ;; From there, search down our list.
  483. (org-search-forward-unenclosed org-item-beginning-re pos t)
  484. (point-at-bol)))))
  485. (defun org-list-bottom-point ()
  486. "Return point just before list ending or nil if not in a list."
  487. (save-excursion
  488. (and (org-in-item-p)
  489. (let ((pos (org-beginning-of-item))
  490. (bound (or (and (let ((outline-regexp org-outline-regexp))
  491. ;; Use default regexp because folding
  492. ;; changes OUTLINE-REGEXP.
  493. (outline-next-heading))
  494. (skip-chars-backward " \t\r\n")
  495. (1+ (point-at-eol)))
  496. (point-max))))
  497. ;; The list ending is either first point matching
  498. ;; `org-list-end-re', point at first white-line before next
  499. ;; heading, or eob.
  500. (or (org-list-terminator-between pos bound t) bound)))))
  501. (defun org-beginning-of-item ()
  502. "Go to the beginning of the current hand-formatted item.
  503. If the cursor is not in an item, throw an error. Return point."
  504. (interactive)
  505. (if (not (org-in-item-p))
  506. (error "Not in an item")
  507. ;; Possibly match the current line.
  508. (end-of-line)
  509. (org-search-backward-unenclosed org-item-beginning-re nil t)
  510. (goto-char (point-at-bol))))
  511. (defun org-end-of-item ()
  512. "Go to the end of the current hand-formatted item.
  513. If the cursor is not in an item, throw an error."
  514. (interactive)
  515. (let ((next-p (org-get-next-item (point) (org-list-bottom-point))))
  516. (cond ((not (org-in-item-p)) (error "Not in an item"))
  517. (next-p (goto-char next-p))
  518. (t (org-end-of-item-list)))))
  519. (defun org-end-of-item-or-at-child ()
  520. "Move to the end of the item text, stops before the first child if any."
  521. (let ((limit (org-list-bottom-point)))
  522. (end-of-line)
  523. (goto-char
  524. (if (org-search-forward-unenclosed org-item-beginning-re limit t)
  525. (point-at-bol)
  526. limit))))
  527. (defun org-end-of-item-before-blank ()
  528. "Return point at end of item, before any blank line.
  529. Point returned is at eol."
  530. (save-excursion
  531. (org-end-of-item)
  532. (skip-chars-backward " \r\t\n")
  533. (point-at-eol)))
  534. (defun org-get-next-item (pos limit)
  535. "Get the point of the next item at the same level as POS.
  536. Stop searching at LIMIT. Return nil if no item is found. This
  537. function does not move point."
  538. (org-list-get-item-same-level
  539. #'org-search-forward-unenclosed pos limit #'end-of-line))
  540. (defun org-get-previous-item (pos limit)
  541. "Get the point of the previous item at the same level as POS.
  542. Stop searching at LIMIT. Return nil if no item is found. This
  543. function does not move point."
  544. (org-list-get-item-same-level
  545. #'org-search-backward-unenclosed pos limit #'beginning-of-line))
  546. (defun org-next-item ()
  547. "Move to the beginning of the next item.
  548. Item is at the same level in the current plain list. Error if not
  549. in a plain list, or if this is the last item in the list."
  550. (interactive)
  551. (let ((next-p (org-get-next-item (point) (org-list-bottom-point))))
  552. (if next-p
  553. (goto-char next-p)
  554. (error "On last item"))))
  555. (defun org-previous-item ()
  556. "Move to the beginning of the previous item.
  557. Item is at the same level in the current plain list. Error if not
  558. in a plain list, or if this is the first item in the list."
  559. (interactive)
  560. (let ((prev-p (org-get-previous-item (point) (org-list-top-point))))
  561. (if prev-p
  562. (goto-char prev-p)
  563. (error "On first item"))))
  564. (defun org-beginning-of-item-list ()
  565. "Go to the beginning item of the current list or sublist.
  566. Return point."
  567. (interactive)
  568. (org-beginning-of-item)
  569. (let ((limit (org-list-top-point))
  570. (move-up (lambda (pos bound)
  571. ;; prev-p: any item of same level before ?
  572. (let ((prev-p (org-get-previous-item pos bound)))
  573. ;; recurse until no more item of the same level
  574. ;; can be found.
  575. (if (not prev-p) pos (funcall move-up prev-p bound))))))
  576. ;; Go to the last item found and at bol in case we didn't move
  577. (goto-char (funcall move-up (point) limit))
  578. (goto-char (point-at-bol))))
  579. (defun org-list-last-item ()
  580. "Go to the last item of the current list.
  581. Return point."
  582. (let* ((limit (org-list-bottom-point))
  583. (get-last-item
  584. (lambda (pos)
  585. (let ((next-p (org-get-next-item pos limit)))
  586. (if (not next-p) pos (funcall get-last-item next-p))))))
  587. (org-beginning-of-item)
  588. (goto-char (funcall get-last-item (point)))))
  589. (defun org-end-of-item-list ()
  590. "Go to the end of the current list or sublist.
  591. Return point."
  592. (interactive)
  593. (org-beginning-of-item)
  594. (let ((limit (org-list-bottom-point))
  595. (ind (org-get-indentation))
  596. (get-last-item (lambda (pos bound)
  597. ;; next-p: any item of same level after ?
  598. (let ((next-p (org-get-next-item pos bound)))
  599. ;; recurse until no more item of the same level
  600. ;; can be found.
  601. (if next-p (funcall get-last-item next-p bound) pos)))))
  602. ;; Move to the last item of every list or sublist encountered, and
  603. ;; down to bol of a higher-level item, or limit.
  604. (while (and (/= (point) limit)
  605. (>= (org-get-indentation) ind))
  606. (goto-char (funcall get-last-item (point) limit))
  607. (end-of-line)
  608. (when (org-search-forward-unenclosed org-item-beginning-re limit 'move)
  609. (beginning-of-line)))
  610. (point)))
  611. ;;; Manipulate
  612. (defun org-list-exchange-items (beg-A beg-B)
  613. "Swap item starting at BEG-A with item starting at BEG-B.
  614. Blank lines at the end of items are left in place. Assumes
  615. BEG-A is lesser than BEG-B."
  616. (save-excursion
  617. (let* ((end-of-item-no-blank (lambda (pos)
  618. (goto-char pos)
  619. (goto-char (org-end-of-item-before-blank))))
  620. (end-A-no-blank (funcall end-of-item-no-blank beg-A))
  621. (end-B-no-blank (funcall end-of-item-no-blank beg-B))
  622. (body-A (buffer-substring beg-A end-A-no-blank))
  623. (body-B (buffer-substring beg-B end-B-no-blank))
  624. (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B)))
  625. (goto-char beg-A)
  626. (delete-region beg-A end-B-no-blank)
  627. (insert (concat body-B between-A-no-blank-and-B body-A)))))
  628. (defun org-move-item-down ()
  629. "Move the plain list item at point down, i.e. swap with following item.
  630. Subitems (items with larger indentation) are considered part of the item,
  631. so this really moves item trees."
  632. (interactive)
  633. (let ((pos (point))
  634. (col (current-column))
  635. (actual-item (org-beginning-of-item))
  636. (next-item (org-get-next-item (point) (save-excursion (org-end-of-item-list)))))
  637. (if (not next-item)
  638. (progn
  639. (goto-char pos)
  640. (error "Cannot move this item further down"))
  641. (org-list-exchange-items actual-item next-item)
  642. (org-maybe-renumber-ordered-list)
  643. (org-next-item)
  644. (move-to-column col))))
  645. (defun org-move-item-up ()
  646. "Move the plain list item at point up, i.e. swap with previous item.
  647. Subitems (items with larger indentation) are considered part of the item,
  648. so this really moves item trees."
  649. (interactive)
  650. (let ((pos (point))
  651. (col (current-column))
  652. (actual-item (org-beginning-of-item))
  653. (prev-item (org-get-previous-item (point) (save-excursion (org-beginning-of-item-list)))))
  654. (if (not prev-item)
  655. (progn
  656. (goto-char pos)
  657. (error "Cannot move this item further up"))
  658. (org-list-exchange-items prev-item actual-item)
  659. (org-maybe-renumber-ordered-list)
  660. (move-to-column col))))
  661. (defun org-insert-item (&optional checkbox)
  662. "Insert a new item at the current level.
  663. If cursor is before first character after bullet of the item, the
  664. new item will be created before the current one. Return t when
  665. things worked, nil when we are not in an item, or item is
  666. invisible."
  667. (unless (or (not (org-in-item-p))
  668. (org-invisible-p))
  669. (if (save-excursion
  670. (org-beginning-of-item)
  671. (org-at-item-timer-p))
  672. ;; Timer list: delegate to `org-timer-item'.
  673. (progn (org-timer-item) t)
  674. ;; if we're in a description list, ask for the new term.
  675. (let ((desc-text (when (save-excursion
  676. (and (org-beginning-of-item)
  677. (org-at-item-description-p)))
  678. (concat (read-string "Term: ") " :: "))))
  679. ;; Don't insert a checkbox if checkbox rule is applied and it
  680. ;; is a description item.
  681. (org-list-insert-item-generic
  682. (point) (and checkbox
  683. (or (not desc-text)
  684. (not (cdr (assq 'checkbox org-list-automatic-rules)))))
  685. desc-text)))))
  686. ;;; Structures
  687. ;; The idea behind structures is to avoid moving back and forth in the
  688. ;; buffer on costly operations like indenting or fixing bullets.
  689. ;; It achieves this by taking a snapshot of an interesting part of the
  690. ;; list, in the shape of an alist, with `org-list-struct'.
  691. ;; It then proceeds to changes directly on the alist. When those are
  692. ;; done, `org-list-struct-apply-struct' applies the changes in the
  693. ;; buffer.
  694. (defun org-list-struct-assoc-at-point ()
  695. "Return the structure association at point.
  696. It is a cons-cell whose key is point and values are indentation,
  697. bullet string and bullet counter, if any."
  698. (save-excursion
  699. (beginning-of-line)
  700. (list (point-at-bol)
  701. (org-get-indentation)
  702. (progn
  703. (looking-at "^[ \t]*\\([-+*0-9.)]+[ \t]+\\)")
  704. (match-string 1))
  705. (progn
  706. (goto-char (match-end 0))
  707. (and (looking-at "\\[@start:\\([0-9]+\\)\\]")
  708. (match-string 1))))))
  709. (defun org-list-struct (begin end &optional outdent)
  710. "Return the structure containing the list between BEGIN and END.
  711. A structure is an alist where key is point of item and values
  712. are, in that order, indentation, bullet string and value of
  713. counter if any. The structure contains every list and sublist
  714. that has items between BEGIN and END and their common parent, if
  715. any.
  716. If OUTDENT is non-nil, it will also grab all of the parent list
  717. and the grand-parent. Setting OUTDENT to t is mandatory when next
  718. change is an outdent."
  719. (save-excursion
  720. (let* ((top (org-list-top-point))
  721. (bottom (org-list-bottom-point))
  722. struct
  723. (extend
  724. (lambda (struct)
  725. (let* ((ind-min (apply 'min (mapcar 'cadr struct)))
  726. (begin (caar struct))
  727. (end (caar (last struct)))
  728. pre-list post-list)
  729. (goto-char begin)
  730. ;; Find beginning of most outdented list (min list)
  731. (while (and (org-search-backward-unenclosed org-item-beginning-re top t)
  732. (>= (org-get-indentation) ind-min))
  733. (setq pre-list (cons (org-list-struct-assoc-at-point) pre-list)))
  734. ;; Now get the parent, if any. If not, add a virtual
  735. ;; ancestor at position 0.
  736. (if (< (org-get-indentation) ind-min)
  737. (setq pre-list (cons (org-list-struct-assoc-at-point) pre-list))
  738. (setq pre-list (cons (list 0 (org-get-indentation) "" nil) pre-list)))
  739. ;; Find end of min list
  740. (goto-char end)
  741. (end-of-line)
  742. (while (and (org-search-forward-unenclosed org-item-beginning-re bottom t)
  743. (>= (org-get-indentation) ind-min))
  744. (setq post-list (cons (org-list-struct-assoc-at-point) post-list)))
  745. (append pre-list struct (reverse post-list))))))
  746. ;; Here we start: first get the core zone...
  747. (goto-char end)
  748. (while (org-search-backward-unenclosed org-item-beginning-re begin t)
  749. (setq struct (cons (org-list-struct-assoc-at-point) struct)))
  750. ;; ... then, extend it to make it a structure...
  751. (let ((extended (funcall extend struct)))
  752. ;; ... twice when OUTDENT is non-nil and struct still can be
  753. ;; extended
  754. (if (and outdent (> (caar extended) 0))
  755. (funcall extend extended)
  756. extended)))))
  757. (defun org-list-struct-origins (struct)
  758. "Return an alist where key is item's position and value parent's.
  759. Common ancestor of structure is, as a convention, at position 0."
  760. (let* ((struct-rev (reverse struct))
  761. (prev-item (lambda (item) (car (nth 1 (member (assq item struct) struct-rev)))))
  762. (get-origins
  763. (lambda (item)
  764. (let* ((item-pos (car item))
  765. (ind (nth 1 item))
  766. (prev-ind (caar acc)))
  767. (cond
  768. ;; List closing.
  769. ((> prev-ind ind)
  770. (setq acc (member (assq ind acc) acc))
  771. (cons item-pos (cdar acc)))
  772. ;; New list
  773. ((< prev-ind ind)
  774. (let ((origin (funcall prev-item item-pos)))
  775. (setq acc (cons (cons ind origin) acc))
  776. (cons item-pos origin)))
  777. ;; Current list going on
  778. (t (cons item-pos (cdar acc)))))))
  779. (acc (list (cons (nth 1 (car struct)) 0))))
  780. (cons '(0 . 0) (mapcar get-origins (cdr struct)))))
  781. (defun org-list-struct-get-parent (item struct origins)
  782. "Return parent association of ITEM in STRUCT or nil."
  783. (let* ((parent-pos (cdr (assq (car item) origins))))
  784. (when (> parent-pos 0) (assq parent-pos struct))))
  785. (defun org-list-struct-get-child (item struct)
  786. "Return child association of ITEM in STRUCT or nil."
  787. (let ((ind (nth 1 item))
  788. (next-item (cadr (member item struct))))
  789. (when (and next-item (> (nth 1 next-item) ind)) next-item)))
  790. (defun org-list-struct-fix-bul (struct origins)
  791. "Verify and correct bullets for every association in STRUCT.
  792. This function modifies STRUCT."
  793. (let* ((init-bul (lambda (item)
  794. (let ((counter (nth 3 item))
  795. (bullet (org-list-bullet-string (nth 2 item))))
  796. (cond
  797. ((and (string-match "[0-9]+" bullet) counter)
  798. (replace-match counter nil nil bullet))
  799. ((string-match "[0-9]+" bullet)
  800. (replace-match "1" nil nil bullet))
  801. (t bullet)))))
  802. (set-bul (lambda (item bullet)
  803. (setcdr item (list (nth 1 item) bullet (nth 3 item)))))
  804. (get-bul (lambda (item bullet)
  805. (let* ((counter (nth 3 item)))
  806. (if (and counter (string-match "[0-9]+" bullet))
  807. (replace-match counter nil nil bullet)
  808. bullet))))
  809. (fix-bul
  810. (lambda (item) struct
  811. (let* ((parent (cdr (assq (car item) origins)))
  812. (orig-ref (assq parent acc)))
  813. (if orig-ref
  814. ;; Continuing previous list
  815. (let* ((prev-bul (cdr orig-ref))
  816. (new-bul (funcall get-bul item prev-bul)))
  817. (setcdr orig-ref (org-list-inc-bullet-maybe new-bul))
  818. (funcall set-bul item new-bul))
  819. ;; A new list is starting
  820. (let ((new-bul (funcall init-bul item)))
  821. (funcall set-bul item new-bul)
  822. (setq acc (cons (cons parent (org-list-inc-bullet-maybe new-bul)) acc)))))))
  823. acc)
  824. (mapc fix-bul (cdr struct))))
  825. (defun org-list-struct-fix-ind (struct origins)
  826. "Verify and correct indentation for every association in STRUCT.
  827. This function modifies STRUCT."
  828. (let* ((headless (cdr struct))
  829. (ancestor (car struct))
  830. (top-ind (+ (nth 1 ancestor) (length (nth 2 ancestor))))
  831. (new-ind
  832. (lambda (item)
  833. (let* ((parent (org-list-struct-get-parent item headless origins)))
  834. (if parent
  835. ;; Indent like parent + length of parent's bullet
  836. (setcdr item (cons (+ (length (nth 2 parent)) (nth 1 parent)) (cddr item)))
  837. ;; If no parent, indent like top-point
  838. (setcdr item (cons top-ind (cddr item))))))))
  839. (mapc new-ind headless)))
  840. (defun org-list-struct-fix-struct (struct origins)
  841. "Return STRUCT with correct bullets and indentation.
  842. Only elements of STRUCT that have changed are returned."
  843. (let ((before (copy-alist struct))
  844. (set-diff (lambda (setA setB result)
  845. (cond
  846. ((null setA) result)
  847. ((equal (car setA) (car setB))
  848. (funcall set-diff (cdr setA) (cdr setB) result))
  849. (t (funcall set-diff (cdr setA) (cdr setB) (cons (car setA) result)))))))
  850. (org-list-struct-fix-bul struct origins)
  851. (org-list-struct-fix-ind struct origins)
  852. (nreverse (funcall set-diff struct before nil))))
  853. (defun org-list-struct-outdent (start end origins)
  854. "Outdent items in ORIGINS between BEGIN and END.
  855. BEGIN is included and END excluded."
  856. (let ((out (lambda (cell)
  857. (let* ((item (car cell))
  858. (parent (cdr cell)))
  859. (cond
  860. ;; Item not yet in zone: keep association
  861. ((< item start) cell)
  862. ;; Item out of zone: follow associations in acc
  863. ((>= item end)
  864. (let ((convert (assq parent acc)))
  865. (if convert (cons item (cdr convert)) cell)))
  866. ;; Item has no parent: error
  867. ((<= parent 0)
  868. (error "Cannot outdent top-level items"))
  869. ;; Parent is outdented: keep association
  870. ((>= parent start)
  871. (setq acc (cons (cons parent item) acc)) cell)
  872. (t
  873. ;; Parent isn't outdented: reparent to grand-parent
  874. (let ((grand-parent (cdr (assq parent origins))))
  875. (setq acc (cons (cons parent item) acc))
  876. (cons item grand-parent)))))))
  877. acc)
  878. (mapcar out origins)))
  879. (defun org-list-struct-indent (start end origins)
  880. "Indent items in ORIGINS between BEGIN and END.
  881. BEGIN is included and END excluded."
  882. (let* ((orig-rev (reverse origins))
  883. (get-prev-item (lambda (cell parent)
  884. (car (rassq parent (cdr (memq cell orig-rev))))))
  885. (set-assoc (lambda (cell)
  886. (setq acc (cons cell acc)) cell))
  887. (ind
  888. (lambda (cell)
  889. (let* ((item (car cell))
  890. (parent (cdr cell)))
  891. (cond
  892. ;; Item not yet in zone: keep association
  893. ((< item start) cell)
  894. ((>= item end)
  895. ;; Item out of zone: follow associations in acc
  896. (let ((convert (assq parent acc)))
  897. (if convert (cons item (cdr convert)) cell)))
  898. (t
  899. ;; Item is in zone...
  900. (let ((prev (funcall get-prev-item cell parent)))
  901. (cond
  902. ;; First item indented but not parent: error
  903. ((and (or (not prev) (= prev 0)) (< parent start))
  904. (error "Cannot indent the first item of a list"))
  905. ;; First item and parent indented: keep same parent
  906. ((or (not prev) (= prev 0))
  907. (funcall set-assoc cell))
  908. ;; Previous item not indented: reparent to it
  909. ((< prev start)
  910. (funcall set-assoc (cons item prev)))
  911. ;; Previous item indented: reparent like it
  912. (t
  913. (funcall set-assoc (cons item (cdr (assq prev acc))))))))))))
  914. acc)
  915. (mapcar ind origins)))
  916. (defun org-list-struct-apply-struct (struct)
  917. "Apply modifications to list so it mirrors STRUCT.
  918. Initial position is restored after the changes."
  919. (let* ((pos (copy-marker (point)))
  920. (ancestor (caar struct))
  921. (modify
  922. (lambda (item)
  923. (goto-char (car item))
  924. (org-list-indent-item (nth 1 item))
  925. (org-list-replace-bullet (org-list-bullet-string (nth 2 item)))))
  926. ;; Remove ancestor if it is left.
  927. (struct-to-apply (if (or (not ancestor) (= 0 ancestor)) (cdr struct) struct)))
  928. ;; Apply changes from bottom to top
  929. (mapc modify (nreverse struct-to-apply))
  930. (goto-char pos)))
  931. ;;; Indentation
  932. (defun org-get-string-indentation (s)
  933. "What indentation has S due to SPACE and TAB at the beginning of the string?"
  934. (let ((n -1) (i 0) (w tab-width) c)
  935. (catch 'exit
  936. (while (< (setq n (1+ n)) (length s))
  937. (setq c (aref s n))
  938. (cond ((= c ?\ ) (setq i (1+ i)))
  939. ((= c ?\t) (setq i (* (/ (+ w i) w) w)))
  940. (t (throw 'exit t)))))
  941. i))
  942. (defun org-shift-item-indentation (delta)
  943. "Shift the indentation in current item by DELTA.
  944. Sub-items are not moved."
  945. (save-excursion
  946. (let ((beg (point-at-bol))
  947. (end (org-end-of-item-or-at-child)))
  948. (beginning-of-line (unless (eolp) 0))
  949. (while (> (point) beg)
  950. (when (looking-at "[ \t]*\\S-")
  951. ;; this is not an empty line
  952. (let ((i (org-get-indentation)))
  953. (when (and (> i 0) (> (+ i delta) 0))
  954. (indent-line-to (+ i delta)))))
  955. (beginning-of-line 0)))))
  956. (defun org-list-indent-item (ind)
  957. "Change indentation of item at point to IND.
  958. It does not move sub-lists."
  959. (save-excursion
  960. (beginning-of-line)
  961. (let ((old-ind (org-get-indentation)))
  962. (unless (= ind old-ind)
  963. (org-shift-item-indentation (- ind old-ind))
  964. (skip-chars-forward " \t")
  965. (delete-region (point-at-bol) (point))
  966. (org-indent-to-column ind)))))
  967. (defun org-outdent-item (arg)
  968. "Outdent a local list item, but not its children."
  969. (interactive "p")
  970. (org-indent-item-tree (- arg) t))
  971. (defun org-indent-item (arg)
  972. "Indent a local list item, but not its children."
  973. (interactive "p")
  974. (org-indent-item-tree arg t))
  975. (defun org-outdent-item-tree (arg &optional no-subtree)
  976. "Outdent a local list item including its children.
  977. If NO-SUBTREE is set, only outdent the item itself, not its children."
  978. (interactive "p")
  979. (org-indent-item-tree (- arg) no-subtree))
  980. (defvar org-last-indent-begin-marker (make-marker))
  981. (defvar org-last-indent-end-marker (make-marker))
  982. (defun org-indent-item-tree (arg &optional no-subtree)
  983. "Indent a local list item including its children.
  984. If NO-SUBTREE is set, only indent the item itself, not its
  985. children. Return t if successful."
  986. (interactive "p")
  987. (unless (org-at-item-p)
  988. (error "Not on an item"))
  989. ;; Determine begin and end points of zone to indent. If moving by
  990. ;; subtrees, ensure we don't drag additional items on subsequent
  991. ;; moves.
  992. (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft))
  993. (memq this-command '(org-shiftmetaright org-shiftmetaleft)))
  994. (if (org-region-active-p)
  995. (progn
  996. (set-marker org-last-indent-begin-marker (region-beginning))
  997. (set-marker org-last-indent-end-marker (region-end)))
  998. (set-marker org-last-indent-begin-marker (save-excursion (org-beginning-of-item)))
  999. (set-marker org-last-indent-end-marker
  1000. (save-excursion
  1001. (if no-subtree (org-end-of-item-or-at-child) (org-end-of-item))))))
  1002. ;; Get everything ready
  1003. (let* ((beg (marker-position org-last-indent-begin-marker))
  1004. (end (marker-position org-last-indent-end-marker))
  1005. (struct (org-list-struct beg end (< arg 0)))
  1006. (origins (org-list-struct-origins struct))
  1007. (beg-item (assq beg struct))
  1008. (end-item (save-excursion
  1009. (goto-char end)
  1010. (skip-chars-backward " \r\t\n")
  1011. (org-beginning-of-item)
  1012. (org-list-struct-assoc-at-point)))
  1013. (top (org-list-top-point)))
  1014. (cond
  1015. ;; Special case: moving top-item with indent rule
  1016. ((and (= top beg) (cdr (assq 'indent org-list-automatic-rules)))
  1017. (let ((offset (if (< arg 0) -2 2))
  1018. (top-ind (nth 1 beg-item)))
  1019. (if (< (+ top-ind offset) 0)
  1020. (error "Cannot outdent beyond margin")
  1021. (when (and (= (+ top-ind offset) 0) (string-match "*" (nth 2 beg-item)))
  1022. (setcdr beg-item (list (nth 1 beg-item) (org-list-bullet-string "-"))))
  1023. (mapc '(lambda (item) (setcdr item (cons (+ (nth 1 item) offset) (cddr item)))) struct)
  1024. (org-list-struct-apply-struct struct))))
  1025. ;; Forbidden move
  1026. ((and (< arg 0)
  1027. (or (and no-subtree
  1028. (not (org-region-active-p))
  1029. (org-list-struct-get-child beg-item struct))
  1030. (org-list-struct-get-child end-item struct)))
  1031. (error "Cannot outdent an item without its children"))
  1032. ;; Normal shifting
  1033. (t
  1034. (let* ((shifted-ori (if (< arg 0)
  1035. (org-list-struct-outdent beg end origins)
  1036. (org-list-struct-indent beg end origins))))
  1037. (org-list-struct-fix-struct struct shifted-ori)
  1038. (org-list-struct-apply-struct struct)))))
  1039. ;; Return value
  1040. t)
  1041. (defvar org-tab-ind-state)
  1042. (defun org-cycle-item-indentation ()
  1043. (let ((org-adapt-indentation nil))
  1044. (when (and (or (org-at-item-description-p) (org-at-item-checkbox-p) (org-at-item-p))
  1045. (>= (match-end 0) (save-excursion
  1046. (org-end-of-item-or-at-child)
  1047. (skip-chars-backward " \r\t\n")
  1048. (point))))
  1049. (setq this-command 'org-cycle-item-indentation)
  1050. ;; When in the middle of the cycle, try to outdent first. If it
  1051. ;; fails, and point is still at initial position, indent. Else,
  1052. ;; go back to original position.
  1053. (if (eq last-command 'org-cycle-item-indentation)
  1054. (cond
  1055. ((ignore-errors (org-indent-item -1)))
  1056. ((and (= (org-get-indentation) (car org-tab-ind-state))
  1057. (ignore-errors (org-indent-item 1))))
  1058. (t (back-to-indentation)
  1059. (indent-to-column (car org-tab-ind-state))
  1060. (end-of-line)
  1061. (org-fix-bullet-type (nth 1 org-tab-ind-state))
  1062. ;; Break cycle
  1063. (setq this-command 'identity)))
  1064. ;; If a cycle is starting, remember indentation and bullet,
  1065. ;; then try to indent. If it fails, try to outdent.
  1066. (setq org-tab-ind-state
  1067. (list (org-get-indentation) (org-get-bullet)))
  1068. (cond
  1069. ((ignore-errors (org-indent-item 1)))
  1070. ((ignore-errors (org-indent-item -1)))
  1071. (t (error "Cannot move item"))))
  1072. t)))
  1073. ;;; Bullets
  1074. (defun org-get-bullet ()
  1075. "Return the bullet of the item at point.
  1076. Assume cursor is at an item."
  1077. (and (looking-at "[ \t]*\\(\\S-+\\)") (match-string 1)))
  1078. (defun org-list-bullet-string (bullet)
  1079. "Return BULLET with the correct number of whitespaces.
  1080. It determines the number of whitespaces to append by looking at
  1081. `org-list-two-spaces-after-bullet-regexp'."
  1082. (save-match-data
  1083. (string-match "\\S-+\\([ \t]*\\)" bullet)
  1084. (replace-match
  1085. (save-match-data
  1086. (concat
  1087. " "
  1088. ;; Do we need to concat another white space ?
  1089. (when (and org-list-two-spaces-after-bullet-regexp
  1090. (string-match org-list-two-spaces-after-bullet-regexp bullet))
  1091. " ")))
  1092. nil nil bullet 1)))
  1093. (defun org-list-inc-bullet-maybe (bullet)
  1094. "Increment numbered bullets."
  1095. (if (string-match "[0-9]+" bullet)
  1096. (replace-match
  1097. (number-to-string (1+ (string-to-number (match-string 0 bullet)))) nil nil bullet)
  1098. bullet))
  1099. (defun org-list-replace-bullet (new-bullet)
  1100. "Replace current item's bullet with NEW-BULLET.
  1101. Item body is re-indented, but sub-lists are not moved. Assume
  1102. point is at item."
  1103. (save-excursion
  1104. (beginning-of-line)
  1105. (let ((old (progn
  1106. (looking-at "[ \t]*\\(\\S-+[ \t]*\\)")
  1107. (match-string 1))))
  1108. (unless (equal new-bullet old)
  1109. (replace-match new-bullet nil nil nil 1)
  1110. ;; When bullet lengths are differents, move the whole
  1111. ;; sublist accordingly
  1112. (org-shift-item-indentation
  1113. (- (length new-bullet) (length old)))))))
  1114. (defun org-fix-bullet-type (&optional force-bullet)
  1115. "Make sure all items in this list have the same bullet as the first item.
  1116. Also, fix the indentation."
  1117. (interactive)
  1118. (unless (org-at-item-p) (error "This is not a list"))
  1119. (let* ((struct (org-list-struct (point-at-bol) (point-at-eol)))
  1120. (origins (org-list-struct-origins struct))
  1121. fixed-struct)
  1122. (if force-bullet
  1123. (let ((begin (nth 1 struct)))
  1124. (setcdr begin (list (nth 1 begin) (org-list-bullet-string force-bullet) (nth 3 begin)))
  1125. (setq fixed-struct (cons begin (org-list-struct-fix-struct struct origins))))
  1126. (setq fixed-struct (org-list-struct-fix-struct struct origins)))
  1127. (org-list-struct-apply-struct fixed-struct)))
  1128. (defun org-renumber-ordered-list ()
  1129. "Renumber an ordered plain list.
  1130. Cursor needs to be in the first line of an item."
  1131. (interactive)
  1132. (unless (and (org-at-item-p)
  1133. (match-beginning 3))
  1134. (error "This is not an ordered list"))
  1135. (let* ((struct (org-list-struct (point-at-bol) (point-at-eol)))
  1136. (origins (org-list-struct-origins struct)))
  1137. (org-list-struct-apply-struct (org-list-struct-fix-struct struct origins))))
  1138. (defun org-maybe-renumber-ordered-list ()
  1139. "Renumber the ordered list at point if setup allows it.
  1140. This tests the if 'renumber rule is set in
  1141. `org-list-automatic-rules' before doing the renumbering.
  1142. Do not throw error on failure."
  1143. (interactive)
  1144. (when (cdr (assq 'renumber org-list-automatic-rules))
  1145. (ignore-errors (org-renumber-ordered-list))))
  1146. (defun org-cycle-list-bullet (&optional which)
  1147. "Cycle through the different itemize/enumerate bullets.
  1148. This cycle the entire list level through the sequence:
  1149. `-' -> `+' -> `*' -> `1.' -> `1)'
  1150. If WHICH is a valid string, use that as the new bullet. If WHICH
  1151. is an integer, 0 means `-', 1 means `+' etc. If WHICH is
  1152. 'previous, cycle backwards."
  1153. (interactive "P")
  1154. (org-preserve-lc
  1155. (let* ((bullet (progn (org-beginning-of-item-list)
  1156. (org-get-bullet)))
  1157. (current (cond
  1158. ((string-match "\\." bullet) "1.")
  1159. ((string-match ")" bullet) "1)")
  1160. (t bullet)))
  1161. (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules)))
  1162. (bullet-list (append '("-" "+" )
  1163. ;; *-bullets are not allowed at column 0
  1164. (unless (and bullet-rule-p
  1165. (looking-at "\\S-")) '("*"))
  1166. ;; Description items cannot be numbered
  1167. (unless (and bullet-rule-p
  1168. (or (eq org-plain-list-ordered-item-terminator ?.)
  1169. (org-at-item-description-p))) '("1)"))
  1170. (unless (and bullet-rule-p
  1171. (or (eq org-plain-list-ordered-item-terminator ?\))
  1172. (org-at-item-description-p))) '("1."))))
  1173. (len (length bullet-list))
  1174. (item-index (- len (length (member current bullet-list))))
  1175. (get-value (lambda (index) (nth (mod index len) bullet-list)))
  1176. (new (cond
  1177. ((member which bullet-list) which)
  1178. ((numberp which) (funcall get-value which))
  1179. ((eq 'previous which) (funcall get-value (1- item-index)))
  1180. (t (funcall get-value (1+ item-index))))))
  1181. (org-fix-bullet-type new))))
  1182. ;;; Checkboxes
  1183. (defun org-toggle-checkbox (&optional toggle-presence)
  1184. "Toggle the checkbox in the current line.
  1185. With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. With
  1186. double prefix, set checkbox to [-].
  1187. When there is an active region, toggle status or presence of the
  1188. checkbox in the first line, and make every item in the region
  1189. have the same status or presence, respectively.
  1190. If the cursor is in a headline, apply this to all checkbox items
  1191. in the text below the heading, taking as reference the first item
  1192. in subtree."
  1193. (interactive "P")
  1194. ;; Bounds is a list of type (beg end single-p) where single-p is t
  1195. ;; when `org-toggle-checkbox' is applied to a single item. Only
  1196. ;; toggles on single items will return errors.
  1197. (let* ((bounds
  1198. (cond
  1199. ((org-region-active-p)
  1200. (list (region-beginning) (region-end) nil))
  1201. ((org-on-heading-p)
  1202. ;; In this case, reference line is the first item in subtree
  1203. (let ((limit (save-excursion (outline-next-heading) (point))))
  1204. (save-excursion
  1205. (org-search-forward-unenclosed org-item-beginning-re limit 'move)
  1206. (list (point) limit nil))))
  1207. ((org-at-item-p)
  1208. (list (point-at-bol) (point-at-eol) t))
  1209. (t (error "Not at an item or heading, and no active region"))))
  1210. ;; marker is needed because deleting checkboxes will change END
  1211. (end (copy-marker (nth 1 bounds)))
  1212. (single-p (nth 2 bounds))
  1213. (ref-presence (save-excursion (goto-char (car bounds)) (org-at-item-checkbox-p)))
  1214. (ref-status (equal (match-string 1) "[X]"))
  1215. (act-on-item
  1216. (lambda (ref-pres ref-stat)
  1217. (if (equal toggle-presence '(4))
  1218. (cond
  1219. ((and ref-pres (org-at-item-checkbox-p))
  1220. (replace-match ""))
  1221. ((and (not ref-pres)
  1222. (not (org-at-item-checkbox-p))
  1223. (org-at-item-p))
  1224. (goto-char (match-end 0))
  1225. ;; Ignore counter, if any
  1226. (when (looking-at "\\(?:\\[@start:[0-9]+\\][ \t]*\\)?")
  1227. (goto-char (match-end 0)))
  1228. (let ((desc-p (and (org-at-item-description-p)
  1229. (cdr (assq 'checkbox org-list-automatic-rules)))))
  1230. (cond
  1231. ((and single-p desc-p)
  1232. (error "Cannot add a checkbox in a description list"))
  1233. ((not desc-p) (insert "[ ] "))))))
  1234. (let ((blocked (org-checkbox-blocked-p)))
  1235. (cond
  1236. ((and blocked single-p)
  1237. (error "Checkbox blocked because of unchecked box in line %d" blocked))
  1238. (blocked nil)
  1239. ((org-at-item-checkbox-p)
  1240. (replace-match
  1241. (cond ((equal toggle-presence '(16)) "[-]")
  1242. (ref-stat "[ ]")
  1243. (t "[X]"))
  1244. t t nil 1))))))))
  1245. (save-excursion
  1246. (while (< (point) end)
  1247. (funcall act-on-item ref-presence ref-status)
  1248. (org-search-forward-unenclosed org-item-beginning-re end 'move)))
  1249. (org-update-checkbox-count-maybe)))
  1250. (defun org-reset-checkbox-state-subtree ()
  1251. "Reset all checkboxes in an entry subtree."
  1252. (interactive "*")
  1253. (save-restriction
  1254. (save-excursion
  1255. (org-narrow-to-subtree)
  1256. (org-show-subtree)
  1257. (goto-char (point-min))
  1258. (let ((end (point-max)))
  1259. (while (< (point) end)
  1260. (when (org-at-item-checkbox-p)
  1261. (replace-match "[ ]" t t nil 1))
  1262. (beginning-of-line 2))))
  1263. (org-update-checkbox-count-maybe)))
  1264. (defvar org-checkbox-statistics-hook nil
  1265. "Hook that is run whenever Org thinks checkbox statistics should be updated.
  1266. This hook runs even if 'checkbox rules in
  1267. `org-list-automatic-rules' do not apply, so it can be used to
  1268. implement alternative ways of collecting statistics
  1269. information.")
  1270. (defun org-update-checkbox-count-maybe ()
  1271. "Update checkbox statistics unless turned off by user."
  1272. (when (cdr (assq 'checkbox org-list-automatic-rules))
  1273. (org-update-checkbox-count))
  1274. (run-hooks 'org-checkbox-statistics-hook))
  1275. (defun org-update-checkbox-count (&optional all)
  1276. "Update the checkbox statistics in the current section.
  1277. This will find all statistic cookies like [57%] and [6/12] and update them
  1278. with the current numbers. With optional prefix argument ALL, do this for
  1279. the whole buffer."
  1280. (interactive "P")
  1281. (save-excursion
  1282. (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21
  1283. (beg (condition-case nil
  1284. (progn (org-back-to-heading) (point))
  1285. (error (point-min))))
  1286. (end (move-marker (make-marker)
  1287. (progn (outline-next-heading) (point))))
  1288. (re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
  1289. (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)")
  1290. (re-find (concat re "\\|" re-box))
  1291. beg-cookie end-cookie is-percent c-on c-off lim new
  1292. eline curr-ind next-ind continue-from startsearch
  1293. (recursive
  1294. (or (not org-hierarchical-checkbox-statistics)
  1295. (string-match "\\<recursive\\>"
  1296. (or (ignore-errors
  1297. (org-entry-get nil "COOKIE_DATA"))
  1298. ""))))
  1299. (cstat 0))
  1300. (when all
  1301. (goto-char (point-min))
  1302. (outline-next-heading)
  1303. (setq beg (point) end (point-max)))
  1304. (goto-char end)
  1305. ;; find each statistics cookie
  1306. (while (and (org-search-backward-unenclosed re-find beg t)
  1307. (not (save-match-data
  1308. (and (org-on-heading-p)
  1309. (string-match "\\<todo\\>"
  1310. (downcase
  1311. (or (org-entry-get
  1312. nil "COOKIE_DATA")
  1313. "")))))))
  1314. (setq beg-cookie (match-beginning 1)
  1315. end-cookie (match-end 1)
  1316. cstat (+ cstat (if end-cookie 1 0))
  1317. startsearch (point-at-eol)
  1318. continue-from (match-beginning 0)
  1319. is-percent (match-beginning 2)
  1320. lim (cond
  1321. ((org-on-heading-p) (outline-next-heading) (point))
  1322. ((org-at-item-p) (org-end-of-item) (point))
  1323. (t nil))
  1324. c-on 0
  1325. c-off 0)
  1326. (when lim
  1327. ;; find first checkbox for this cookie and gather
  1328. ;; statistics from all that are at this indentation level
  1329. (goto-char startsearch)
  1330. (if (org-search-forward-unenclosed re-box lim t)
  1331. (progn
  1332. (org-beginning-of-item)
  1333. (setq curr-ind (org-get-indentation))
  1334. (setq next-ind curr-ind)
  1335. (while (and (bolp) (org-at-item-p)
  1336. (if recursive
  1337. (<= curr-ind next-ind)
  1338. (= curr-ind next-ind)))
  1339. (setq eline (point-at-eol))
  1340. (if (org-search-forward-unenclosed re-box eline t)
  1341. (if (member (match-string 2) '("[ ]" "[-]"))
  1342. (setq c-off (1+ c-off))
  1343. (setq c-on (1+ c-on))))
  1344. (if (not recursive)
  1345. ;; org-get-next-item goes through list-enders
  1346. ;; with proper limit.
  1347. (goto-char (or (org-get-next-item (point) lim) lim))
  1348. (end-of-line)
  1349. (when (org-search-forward-unenclosed org-item-beginning-re lim t)
  1350. (beginning-of-line)))
  1351. (setq next-ind (org-get-indentation)))))
  1352. (goto-char continue-from)
  1353. ;; update cookie
  1354. (when end-cookie
  1355. (setq new (if is-percent
  1356. (format "[%d%%]" (/ (* 100 c-on) (max 1 (+ c-on c-off))))
  1357. (format "[%d/%d]" c-on (+ c-on c-off))))
  1358. (goto-char beg-cookie)
  1359. (insert new)
  1360. (delete-region (point) (+ (point) (- end-cookie beg-cookie))))
  1361. ;; update items checkbox if it has one
  1362. (when (org-at-item-p)
  1363. (org-beginning-of-item)
  1364. (when (and (> (+ c-on c-off) 0)
  1365. (org-search-forward-unenclosed re-box (point-at-eol) t))
  1366. (setq beg-cookie (match-beginning 2)
  1367. end-cookie (match-end 2))
  1368. (delete-region beg-cookie end-cookie)
  1369. (goto-char beg-cookie)
  1370. (cond ((= c-off 0) (insert "[X]"))
  1371. ((= c-on 0) (insert "[ ]"))
  1372. (t (insert "[-]")))
  1373. )))
  1374. (goto-char continue-from))
  1375. (when (interactive-p)
  1376. (message "Checkbox statistics updated %s (%d places)"
  1377. (if all "in entire file" "in current outline entry") cstat)))))
  1378. (defun org-get-checkbox-statistics-face ()
  1379. "Select the face for checkbox statistics.
  1380. The face will be `org-done' when all relevant boxes are checked.
  1381. Otherwise it will be `org-todo'."
  1382. (if (match-end 1)
  1383. (if (equal (match-string 1) "100%")
  1384. 'org-checkbox-statistics-done
  1385. 'org-checkbox-statistics-todo)
  1386. (if (and (> (match-end 2) (match-beginning 2))
  1387. (equal (match-string 2) (match-string 3)))
  1388. 'org-checkbox-statistics-done
  1389. 'org-checkbox-statistics-todo)))
  1390. ;;; Misc Tools
  1391. (defun org-apply-on-list (function init-value &rest args)
  1392. "Call FUNCTION for each item of a the list under point.
  1393. FUNCTION must be called with at least one argument: a return
  1394. value that will contain the value returned by the function at the
  1395. previous item, plus ARGS extra arguments. INIT-VALUE will be the
  1396. value passed to the function at the first item of the list.
  1397. As an example, (org-apply-on-list (lambda (result) (1+ result)) 0)
  1398. will return the number of items in the current list.
  1399. Sublists of the list are skipped. Cursor is always at the
  1400. beginning of the item."
  1401. (save-excursion
  1402. (let ((end (copy-marker (save-excursion (org-end-of-item-list))))
  1403. (next-p (make-marker))
  1404. (move-down-action
  1405. (lambda (pos value &rest args)
  1406. (goto-char pos)
  1407. (set-marker next-p (org-get-next-item pos end))
  1408. (let ((return-value (apply function value args)))
  1409. (if (marker-position next-p)
  1410. (apply move-down-action next-p return-value args)
  1411. return-value)))))
  1412. (apply move-down-action (org-beginning-of-item-list) init-value args))))
  1413. (defun org-sort-list (&optional with-case sorting-type getkey-func compare-func)
  1414. "Sort plain list items.
  1415. The cursor may be at any item of the list that should be sorted.
  1416. Sublists are not sorted. Checkboxes, if any, are ignored.
  1417. Sorting can be alphabetically, numerically, by date/time as given by
  1418. a time stamp, by a property or by priority.
  1419. The command prompts for the sorting type unless it has been given
  1420. to the function through the SORTING-TYPE argument, which needs to
  1421. be a character, \(?n ?N ?a ?A ?t ?T ?f ?F). Here is the precise
  1422. meaning of each character:
  1423. n Numerically, by converting the beginning of the item to a number.
  1424. a Alphabetically. Only the first line of item is checked.
  1425. t By date/time, either the first active time stamp in the entry, if
  1426. any, or by the first inactive one. In a timer list, sort the timers.
  1427. Capital letters will reverse the sort order.
  1428. If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a
  1429. function to be called with point at the beginning of the record.
  1430. It must return either a string or a number that should serve as
  1431. the sorting key for that record.
  1432. Comparing entries ignores case by default. However, with an
  1433. optional argument WITH-CASE, the sorting considers case as well."
  1434. (interactive "P")
  1435. (let* ((case-func (if with-case 'identity 'downcase))
  1436. (start (org-beginning-of-item-list))
  1437. (end (save-excursion (org-end-of-item-list)))
  1438. (sorting-type
  1439. (progn
  1440. (message
  1441. "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:")
  1442. (read-char-exclusive)))
  1443. (getkey-func (and (= (downcase sorting-type) ?f)
  1444. (org-icompleting-read "Sort using function: "
  1445. obarray 'fboundp t nil nil)
  1446. (intern getkey-func))))
  1447. (message "Sorting items...")
  1448. (save-restriction
  1449. (narrow-to-region start end)
  1450. (let* ((dcst (downcase sorting-type))
  1451. (case-fold-search nil)
  1452. (now (current-time))
  1453. (sort-func (cond
  1454. ((= dcst ?a) 'string<)
  1455. ((= dcst ?f) compare-func)
  1456. ((= dcst ?t) '<)
  1457. (t nil)))
  1458. (begin-record (lambda ()
  1459. (skip-chars-forward " \r\t\n")
  1460. (beginning-of-line)))
  1461. (end-record (lambda ()
  1462. (goto-char (org-end-of-item-before-blank))))
  1463. (value-to-sort
  1464. (lambda ()
  1465. (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+")
  1466. (cond
  1467. ((= dcst ?n)
  1468. (string-to-number (buffer-substring (match-end 0)
  1469. (point-at-eol))))
  1470. ((= dcst ?a)
  1471. (buffer-substring (match-end 0) (point-at-eol)))
  1472. ((= dcst ?t)
  1473. (cond
  1474. ;; If it is a timer list, convert timer to seconds
  1475. ((org-at-item-timer-p)
  1476. (org-timer-hms-to-secs (match-string 1)))
  1477. ((or (org-search-forward-unenclosed org-ts-regexp
  1478. (point-at-eol) t)
  1479. (org-search-forward-unenclosed org-ts-regexp-both
  1480. (point-at-eol) t))
  1481. (org-time-string-to-seconds (match-string 0)))
  1482. (t (org-float-time now))))
  1483. ((= dcst ?f)
  1484. (if getkey-func
  1485. (let ((value (funcall getkey-func)))
  1486. (if (stringp value)
  1487. (funcall case-func value)
  1488. value))
  1489. (error "Invalid key function `%s'" getkey-func)))
  1490. (t (error "Invalid sorting type `%c'" sorting-type)))))))
  1491. (sort-subr (/= dcst sorting-type) begin-record end-record value-to-sort nil sort-func)
  1492. (org-maybe-renumber-ordered-list)
  1493. (run-hooks 'org-after-sorting-entries-or-items-hook)
  1494. (message "Sorting items...done")))))
  1495. ;;; Send and receive lists
  1496. (defun org-list-parse-list (&optional delete)
  1497. "Parse the list at point and maybe DELETE it.
  1498. Return a list containing first level items as strings and
  1499. sublevels as a list of strings."
  1500. (let* ((start (goto-char (org-list-top-point)))
  1501. (end (org-list-bottom-point))
  1502. output itemsep ltype)
  1503. (while (org-search-forward-unenclosed org-item-beginning-re end t)
  1504. (save-excursion
  1505. (beginning-of-line)
  1506. (setq ltype (cond ((looking-at-p "^[ \t]*[0-9]") 'ordered)
  1507. ((org-at-item-description-p) 'descriptive)
  1508. (t 'unordered))))
  1509. (let* ((indent1 (org-get-indentation))
  1510. (nextitem (or (org-get-next-item (point) end) end))
  1511. (item (org-trim (buffer-substring (point) (org-end-of-item-or-at-child))))
  1512. (nextindent (if (= (point) end) 0 (org-get-indentation)))
  1513. (item (if (string-match "^\\(?:\\[@start:[0-9]+\\][ \t]*\\)?\\[\\([xX ]\\)\\]" item)
  1514. (replace-match (if (equal (match-string 1 item) " ")
  1515. "CBOFF"
  1516. "CBON")
  1517. t nil item 1)
  1518. item)))
  1519. (push item output)
  1520. (when (> nextindent indent1)
  1521. (save-restriction
  1522. (narrow-to-region (point) nextitem)
  1523. (push (org-list-parse-list) output)))))
  1524. (when delete
  1525. (delete-region start end)
  1526. (save-match-data
  1527. (when (looking-at (org-list-end-re))
  1528. (replace-match "\n"))))
  1529. (setq output (nreverse output))
  1530. (push ltype output)))
  1531. (defun org-list-make-subtree ()
  1532. "Convert the plain list at point into a subtree."
  1533. (interactive)
  1534. (if (not (org-in-item-p))
  1535. (error "Not in a list.")
  1536. (goto-char (org-list-top-point))
  1537. (let ((list (org-list-parse-list t)) nstars)
  1538. (save-excursion
  1539. (if (ignore-errors
  1540. (org-back-to-heading))
  1541. (progn (org-search-forward-unenclosed org-complex-heading-regexp nil t)
  1542. (setq nstars (length (match-string 1))))
  1543. (setq nstars 0)))
  1544. (org-list-make-subtrees list (1+ nstars)))))
  1545. (defun org-list-make-subtrees (list level)
  1546. "Convert LIST into subtrees starting at LEVEL."
  1547. (if (symbolp (car list))
  1548. (org-list-make-subtrees (cdr list) level)
  1549. (mapcar (lambda (item)
  1550. (if (stringp item)
  1551. (insert (make-string
  1552. (if org-odd-levels-only
  1553. (1- (* 2 level)) level) ?*) " " item "\n")
  1554. (org-list-make-subtrees item (1+ level))))
  1555. list)))
  1556. (defun org-list-insert-radio-list ()
  1557. "Insert a radio list template appropriate for this major mode."
  1558. (interactive)
  1559. (let* ((e (assq major-mode org-list-radio-list-templates))
  1560. (txt (nth 1 e))
  1561. name pos)
  1562. (unless e (error "No radio list setup defined for %s" major-mode))
  1563. (setq name (read-string "List name: "))
  1564. (while (string-match "%n" txt)
  1565. (setq txt (replace-match name t t txt)))
  1566. (or (bolp) (insert "\n"))
  1567. (setq pos (point))
  1568. (insert txt)
  1569. (goto-char pos)))
  1570. (defun org-list-send-list (&optional maybe)
  1571. "Send a transformed version of this list to the receiver position.
  1572. With argument MAYBE, fail quietly if no transformation is defined for
  1573. this list."
  1574. (interactive)
  1575. (catch 'exit
  1576. (unless (org-at-item-p) (error "Not at a list"))
  1577. (save-excursion
  1578. (re-search-backward "#\\+ORGLST" nil t)
  1579. (unless (looking-at "[ \t]*#\\+ORGLST[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?")
  1580. (if maybe
  1581. (throw 'exit nil)
  1582. (error "Don't know how to transform this list"))))
  1583. (let* ((name (match-string 1))
  1584. (transform (intern (match-string 2)))
  1585. (bottom-point
  1586. (save-excursion
  1587. (re-search-forward "\\(\\\\end{comment}\\|@end ignore\\|-->\\)" nil t)
  1588. (match-beginning 0)))
  1589. (top-point
  1590. (progn
  1591. (re-search-backward "#\\+ORGLST" nil t)
  1592. (re-search-forward org-item-beginning-re bottom-point t)
  1593. (match-beginning 0)))
  1594. (list (save-restriction
  1595. (narrow-to-region top-point bottom-point)
  1596. (org-list-parse-list)))
  1597. beg txt)
  1598. (unless (fboundp transform)
  1599. (error "No such transformation function %s" transform))
  1600. (let ((txt (funcall transform list)))
  1601. ;; Find the insertion place
  1602. (save-excursion
  1603. (goto-char (point-min))
  1604. (unless (re-search-forward
  1605. (concat "BEGIN RECEIVE ORGLST +" name "\\([ \t]\\|$\\)") nil t)
  1606. (error "Don't know where to insert translated list"))
  1607. (goto-char (match-beginning 0))
  1608. (beginning-of-line 2)
  1609. (setq beg (point))
  1610. (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t)
  1611. (error "Cannot find end of insertion region"))
  1612. (delete-region beg (point-at-bol))
  1613. (goto-char beg)
  1614. (insert txt "\n")))
  1615. (message "List converted and installed at receiver location"))))
  1616. (defun org-list-to-generic (list params)
  1617. "Convert a LIST parsed through `org-list-parse-list' to other formats.
  1618. Valid parameters PARAMS are
  1619. :ustart String to start an unordered list
  1620. :uend String to end an unordered list
  1621. :ostart String to start an ordered list
  1622. :oend String to end an ordered list
  1623. :dstart String to start a descriptive list
  1624. :dend String to end a descriptive list
  1625. :dtstart String to start a descriptive term
  1626. :dtend String to end a descriptive term
  1627. :ddstart String to start a description
  1628. :ddend String to end a description
  1629. :splice When set to t, return only list body lines, don't wrap
  1630. them into :[u/o]start and :[u/o]end. Default is nil.
  1631. :istart String to start a list item
  1632. :iend String to end a list item
  1633. :isep String to separate items
  1634. :lsep String to separate sublists
  1635. :cboff String to insert for an unchecked checkbox
  1636. :cbon String to insert for a checked checkbox"
  1637. (interactive)
  1638. (let* ((p params) sublist
  1639. (splicep (plist-get p :splice))
  1640. (ostart (plist-get p :ostart))
  1641. (oend (plist-get p :oend))
  1642. (ustart (plist-get p :ustart))
  1643. (uend (plist-get p :uend))
  1644. (dstart (plist-get p :dstart))
  1645. (dend (plist-get p :dend))
  1646. (dtstart (plist-get p :dtstart))
  1647. (dtend (plist-get p :dtend))
  1648. (ddstart (plist-get p :ddstart))
  1649. (ddend (plist-get p :ddend))
  1650. (istart (plist-get p :istart))
  1651. (iend (plist-get p :iend))
  1652. (isep (plist-get p :isep))
  1653. (lsep (plist-get p :lsep))
  1654. (cbon (plist-get p :cbon))
  1655. (cboff (plist-get p :cboff)))
  1656. (let ((wrapper
  1657. (cond ((eq (car list) 'ordered)
  1658. (concat ostart "\n%s" oend "\n"))
  1659. ((eq (car list) 'unordered)
  1660. (concat ustart "\n%s" uend "\n"))
  1661. ((eq (car list) 'descriptive)
  1662. (concat dstart "\n%s" dend "\n"))))
  1663. rtn term defstart defend)
  1664. (while (setq sublist (pop list))
  1665. (cond ((symbolp sublist) nil)
  1666. ((stringp sublist)
  1667. (when (string-match "^\\(\\S-+\\)[ \t]+::" sublist)
  1668. (setq term (org-trim (format (concat dtstart "%s" dtend)
  1669. (match-string 1 sublist))))
  1670. (setq sublist (concat ddstart
  1671. (org-trim (substring sublist (match-end 0)))
  1672. ddend)))
  1673. (if (string-match "\\[CBON\\]" sublist)
  1674. (setq sublist (replace-match cbon t t sublist)))
  1675. (if (string-match "\\[CBOFF\\]" sublist)
  1676. (setq sublist (replace-match cboff t t sublist)))
  1677. (if (string-match "\\[-\\]" sublist)
  1678. (setq sublist (replace-match "$\\boxminus$" t t sublist)))
  1679. (setq rtn (concat rtn istart term sublist iend isep)))
  1680. (t (setq rtn (concat rtn ;; previous list
  1681. lsep ;; list separator
  1682. (org-list-to-generic sublist p)
  1683. lsep ;; list separator
  1684. )))))
  1685. (format wrapper rtn))))
  1686. (defun org-list-to-latex (list &optional params)
  1687. "Convert LIST into a LaTeX list.
  1688. LIST is as returned by `org-list-parse-list'. PARAMS is a property list
  1689. with overruling parameters for `org-list-to-generic'."
  1690. (org-list-to-generic
  1691. list
  1692. (org-combine-plists
  1693. '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}"
  1694. :ustart "\\begin{itemize}" :uend "\\end{itemize}"
  1695. :dstart "\\begin{description}" :dend "\\end{description}"
  1696. :dtstart "[" :dtend "]"
  1697. :ddstart "" :ddend ""
  1698. :istart "\\item " :iend ""
  1699. :isep "\n" :lsep "\n"
  1700. :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}")
  1701. params)))
  1702. (defun org-list-to-html (list &optional params)
  1703. "Convert LIST into a HTML list.
  1704. LIST is as returned by `org-list-parse-list'. PARAMS is a property list
  1705. with overruling parameters for `org-list-to-generic'."
  1706. (org-list-to-generic
  1707. list
  1708. (org-combine-plists
  1709. '(:splicep nil :ostart "<ol>" :oend "</ol>"
  1710. :ustart "<ul>" :uend "</ul>"
  1711. :dstart "<dl>" :dend "</dl>"
  1712. :dtstart "<dt>" :dtend "</dt>"
  1713. :ddstart "<dd>" :ddend "</dd>"
  1714. :istart "<li>" :iend "</li>"
  1715. :isep "\n" :lsep "\n"
  1716. :cbon "<code>[X]</code>" :cboff "<code>[ ]</code>")
  1717. params)))
  1718. (defun org-list-to-texinfo (list &optional params)
  1719. "Convert LIST into a Texinfo list.
  1720. LIST is as returned by `org-list-parse-list'. PARAMS is a property list
  1721. with overruling parameters for `org-list-to-generic'."
  1722. (org-list-to-generic
  1723. list
  1724. (org-combine-plists
  1725. '(:splicep nil :ostart "@itemize @minus" :oend "@end itemize"
  1726. :ustart "@enumerate" :uend "@end enumerate"
  1727. :dstart "@table" :dend "@end table"
  1728. :dtstart "@item " :dtend "\n"
  1729. :ddstart "" :ddend ""
  1730. :istart "@item\n" :iend ""
  1731. :isep "\n" :lsep "\n"
  1732. :cbon "@code{[X]}" :cboff "@code{[ ]}")
  1733. params)))
  1734. (provide 'org-list)
  1735. ;; arch-tag: 73cf50c1-200f-4d1d-8a53-4e842a5b11c8
  1736. ;;; org-list.el ends here