org-list.el 70 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890
  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. A structure contains every list and sublist that
  714. has items between BEGIN and END along with their common ancestor.
  715. If no such ancestor can be found, the function will add a virtual
  716. ancestor at position 0.
  717. If OUTDENT is non-nil, it will also grab all of the parent list
  718. and the grand-parent. Setting OUTDENT to t is mandatory when next
  719. change is an outdent."
  720. (save-excursion
  721. (let* ((top (org-list-top-point))
  722. (bottom (org-list-bottom-point))
  723. struct
  724. (extend
  725. (lambda (struct)
  726. (let* ((ind-min (apply 'min (mapcar 'cadr struct)))
  727. (begin (caar struct))
  728. (end (caar (last struct)))
  729. pre-list post-list)
  730. (goto-char begin)
  731. ;; Find beginning of most outdented list (min list)
  732. (while (and (org-search-backward-unenclosed org-item-beginning-re top t)
  733. (>= (org-get-indentation) ind-min))
  734. (setq pre-list (cons (org-list-struct-assoc-at-point) pre-list)))
  735. ;; Now get the parent. If none, add a virtual ancestor
  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. (let* ((struct-rev (reverse struct))
  760. (prev-item (lambda (item) (car (nth 1 (member (assq item struct) struct-rev)))))
  761. (get-origins
  762. (lambda (item)
  763. (let* ((item-pos (car item))
  764. (ind (nth 1 item))
  765. (prev-ind (caar acc)))
  766. (cond
  767. ;; List closing.
  768. ((> prev-ind ind)
  769. (setq acc (member (assq ind acc) acc))
  770. (cons item-pos (cdar acc)))
  771. ;; New list
  772. ((< prev-ind ind)
  773. (let ((origin (funcall prev-item item-pos)))
  774. (setq acc (cons (cons ind origin) acc))
  775. (cons item-pos origin)))
  776. ;; Current list going on
  777. (t (cons item-pos (cdar acc)))))))
  778. (acc (list (cons (nth 1 (car struct)) 0))))
  779. (cons '(0 . 0) (mapcar get-origins (cdr struct)))))
  780. (defun org-list-struct-get-parent (item struct origins)
  781. "Return parent association of ITEM in STRUCT or nil."
  782. (let* ((parent-pos (cdr (assq (car item) origins))))
  783. (when (> parent-pos 0) (assq parent-pos struct))))
  784. (defun org-list-struct-get-child (item struct)
  785. "Return child association of ITEM in STRUCT or nil."
  786. (let ((ind (nth 1 item))
  787. (next-item (cadr (member item struct))))
  788. (when (and next-item (> (nth 1 next-item) ind)) next-item)))
  789. (defun org-list-struct-fix-bul (struct origins)
  790. "Verify and correct bullets for every association in STRUCT.
  791. This function modifies STRUCT."
  792. (let* ((init-bul (lambda (item)
  793. (let ((counter (nth 3 item))
  794. (bullet (org-list-bullet-string (nth 2 item))))
  795. (cond
  796. ((and (string-match "[0-9]+" bullet) counter)
  797. (replace-match counter nil nil bullet))
  798. ((string-match "[0-9]+" bullet)
  799. (replace-match "1" nil nil bullet))
  800. (t bullet)))))
  801. (set-bul (lambda (item bullet)
  802. (setcdr item (list (nth 1 item) bullet (nth 3 item)))))
  803. (get-bul (lambda (item bullet)
  804. (let* ((counter (nth 3 item)))
  805. (if (and counter (string-match "[0-9]+" bullet))
  806. (replace-match counter nil nil bullet)
  807. bullet))))
  808. (fix-bul
  809. (lambda (item) struct
  810. (let* ((parent (cdr (assq (car item) origins)))
  811. (orig-ref (assq parent acc)))
  812. (if orig-ref
  813. ;; Continuing previous list
  814. (let* ((prev-bul (cdr orig-ref))
  815. (new-bul (funcall get-bul item prev-bul)))
  816. (setcdr orig-ref (org-list-inc-bullet-maybe new-bul))
  817. (funcall set-bul item new-bul))
  818. ;; A new list is starting
  819. (let ((new-bul (funcall init-bul item)))
  820. (funcall set-bul item new-bul)
  821. (setq acc (cons (cons parent (org-list-inc-bullet-maybe new-bul)) acc)))))))
  822. acc)
  823. (mapc fix-bul (cdr struct))))
  824. (defun org-list-struct-fix-ind (struct origins)
  825. "Verify and correct indentation for every association in STRUCT.
  826. This function modifies STRUCT."
  827. (let* ((headless (cdr struct))
  828. (ancestor (car struct))
  829. (top-ind (+ (nth 1 ancestor) (length (nth 2 ancestor))))
  830. (new-ind
  831. (lambda (item)
  832. (let* ((parent (org-list-struct-get-parent item headless origins)))
  833. (if parent
  834. ;; Indent like parent + length of parent's bullet
  835. (setcdr item (cons (+ (length (nth 2 parent)) (nth 1 parent)) (cddr item)))
  836. ;; If no parent, indent like top-point
  837. (setcdr item (cons top-ind (cddr item))))))))
  838. (mapc new-ind headless)))
  839. (defun org-list-struct-fix-struct (struct origins)
  840. "Return STRUCT with correct bullets and indentation.
  841. Only elements of STRUCT that have changed are returned."
  842. (let ((before (copy-alist struct))
  843. (set-diff (lambda (setA setB result)
  844. (cond
  845. ((null setA) result)
  846. ((equal (car setA) (car setB))
  847. (funcall set-diff (cdr setA) (cdr setB) result))
  848. (t (funcall set-diff (cdr setA) (cdr setB) (cons (car setA) result)))))))
  849. (org-list-struct-fix-bul struct origins)
  850. (org-list-struct-fix-ind struct origins)
  851. (nreverse (funcall set-diff struct before nil))))
  852. (defun org-list-struct-outdent (start end origins)
  853. "Outdent items in ORIGINS between BEGIN and END.
  854. BEGIN is included and END excluded."
  855. (let ((out (lambda (cell)
  856. (let* ((item (car cell))
  857. (parent (cdr cell)))
  858. (cond
  859. ;; Item not yet in zone: keep association
  860. ((< item start) cell)
  861. ;; Item out of zone: follow associations in acc
  862. ((>= item end)
  863. (let ((convert (assq parent acc)))
  864. (if convert (cons item (cdr convert)) cell)))
  865. ;; Item has no parent: error
  866. ((<= parent 0)
  867. (error "Cannot outdent top-level items"))
  868. ;; Parent is outdented: keep association
  869. ((>= parent start)
  870. (setq acc (cons (cons parent item) acc)) cell)
  871. (t
  872. ;; Parent isn't outdented: reparent to grand-parent
  873. (let ((grand-parent (cdr (assq parent origins))))
  874. (setq acc (cons (cons parent item) acc))
  875. (cons item grand-parent)))))))
  876. acc)
  877. (mapcar out origins)))
  878. (defun org-list-struct-indent (start end origins)
  879. "Indent items in ORIGINS between BEGIN and END.
  880. BEGIN is included and END excluded."
  881. (let* ((orig-rev (reverse origins))
  882. (get-prev-item (lambda (cell parent)
  883. (car (rassq parent (cdr (memq cell orig-rev))))))
  884. (set-assoc (lambda (cell)
  885. (setq acc (cons cell acc)) cell))
  886. (ind
  887. (lambda (cell)
  888. (let* ((item (car cell))
  889. (parent (cdr cell)))
  890. (cond
  891. ;; Item not yet in zone: keep association
  892. ((< item start) cell)
  893. ((>= item end)
  894. ;; Item out of zone: follow associations in acc
  895. (let ((convert (assq parent acc)))
  896. (if convert (cons item (cdr convert)) cell)))
  897. (t
  898. ;; Item is in zone...
  899. (let ((prev (funcall get-prev-item cell parent)))
  900. (cond
  901. ;; First item indented but not parent: error
  902. ((and (or (not prev) (= prev 0)) (< parent start))
  903. (error "Cannot indent the first item of a list"))
  904. ;; First item and parent indented: keep same parent
  905. ((or (not prev) (= prev 0))
  906. (funcall set-assoc cell))
  907. ;; Previous item not indented: reparent to it
  908. ((< prev start)
  909. (funcall set-assoc (cons item prev)))
  910. ;; Previous item indented: reparent like it
  911. (t
  912. (funcall set-assoc (cons item (cdr (assq prev acc))))))))))))
  913. acc)
  914. (mapcar ind origins)))
  915. (defun org-list-struct-apply-struct (struct)
  916. "Apply modifications to list so it mirrors STRUCT.
  917. Initial position is restored after the changes."
  918. (let* ((pos (copy-marker (point)))
  919. (ancestor (caar struct))
  920. (modify
  921. (lambda (item)
  922. (goto-char (car item))
  923. (org-list-indent-item (nth 1 item))
  924. (org-list-replace-bullet (org-list-bullet-string (nth 2 item)))))
  925. ;; Remove ancestor if it is left.
  926. (struct-to-apply (if (or (not ancestor) (= 0 ancestor)) (cdr struct) struct)))
  927. ;; Apply changes from bottom to top
  928. (mapc modify (nreverse struct-to-apply))
  929. (goto-char pos)))
  930. ;;; Indentation
  931. (defun org-get-string-indentation (s)
  932. "What indentation has S due to SPACE and TAB at the beginning of the string?"
  933. (let ((n -1) (i 0) (w tab-width) c)
  934. (catch 'exit
  935. (while (< (setq n (1+ n)) (length s))
  936. (setq c (aref s n))
  937. (cond ((= c ?\ ) (setq i (1+ i)))
  938. ((= c ?\t) (setq i (* (/ (+ w i) w) w)))
  939. (t (throw 'exit t)))))
  940. i))
  941. (defun org-shift-item-indentation (delta)
  942. "Shift the indentation in current item by DELTA.
  943. Sub-items are not moved."
  944. (save-excursion
  945. (let ((beg (point-at-bol))
  946. (end (org-end-of-item-or-at-child)))
  947. (beginning-of-line (unless (eolp) 0))
  948. (while (> (point) beg)
  949. (when (looking-at "[ \t]*\\S-")
  950. ;; this is not an empty line
  951. (let ((i (org-get-indentation)))
  952. (when (and (> i 0) (> (+ i delta) 0))
  953. (indent-line-to (+ i delta)))))
  954. (beginning-of-line 0)))))
  955. (defun org-list-indent-item (ind)
  956. "Change indentation of item at point to IND.
  957. It does not move sub-lists."
  958. (save-excursion
  959. (beginning-of-line)
  960. (let ((old-ind (org-get-indentation)))
  961. (unless (= ind old-ind)
  962. (org-shift-item-indentation (- ind old-ind))
  963. (skip-chars-forward " \t")
  964. (delete-region (point-at-bol) (point))
  965. (org-indent-to-column ind)))))
  966. (defun org-outdent-item (arg)
  967. "Outdent a local list item, but not its children."
  968. (interactive "p")
  969. (org-indent-item-tree (- arg) t))
  970. (defun org-indent-item (arg)
  971. "Indent a local list item, but not its children."
  972. (interactive "p")
  973. (org-indent-item-tree arg t))
  974. (defun org-outdent-item-tree (arg &optional no-subtree)
  975. "Outdent a local list item including its children.
  976. If NO-SUBTREE is set, only outdent the item itself, not its children."
  977. (interactive "p")
  978. (org-indent-item-tree (- arg) no-subtree))
  979. (defvar org-last-indent-begin-marker (make-marker))
  980. (defvar org-last-indent-end-marker (make-marker))
  981. (defun org-indent-item-tree (arg &optional no-subtree)
  982. "Indent a local list item including its children.
  983. If NO-SUBTREE is set, only indent the item itself, not its
  984. children. Return t if successful."
  985. (interactive "p")
  986. (unless (org-at-item-p)
  987. (error "Not on an item"))
  988. ;; Determine begin and end points of zone to indent. If moving by
  989. ;; subtrees, ensure we don't drag additional items on subsequent
  990. ;; moves.
  991. (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft))
  992. (memq this-command '(org-shiftmetaright org-shiftmetaleft)))
  993. (if (org-region-active-p)
  994. (progn
  995. (set-marker org-last-indent-begin-marker (region-beginning))
  996. (set-marker org-last-indent-end-marker (region-end)))
  997. (set-marker org-last-indent-begin-marker (save-excursion (org-beginning-of-item)))
  998. (set-marker org-last-indent-end-marker
  999. (save-excursion
  1000. (if no-subtree (org-end-of-item-or-at-child) (org-end-of-item))))))
  1001. ;; Get everything ready
  1002. (let* ((beg (marker-position org-last-indent-begin-marker))
  1003. (end (marker-position org-last-indent-end-marker))
  1004. (struct (org-list-struct beg end (< arg 0)))
  1005. (origins (org-list-struct-origins struct))
  1006. (beg-item (assq beg struct))
  1007. (end-item (save-excursion
  1008. (goto-char end)
  1009. (skip-chars-backward " \r\t\n")
  1010. (org-beginning-of-item)
  1011. (org-list-struct-assoc-at-point)))
  1012. (top (org-list-top-point)))
  1013. (cond
  1014. ;; Special case: moving top-item with indent rule
  1015. ((and (= top beg) (cdr (assq 'indent org-list-automatic-rules)))
  1016. (let ((offset (if (< arg 0) -2 2))
  1017. (top-ind (nth 1 beg-item)))
  1018. (if (< (+ top-ind offset) 0)
  1019. (error "Cannot outdent beyond margin")
  1020. ;; Change bullet if necessary
  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. ;; Shift ancestor
  1024. (let ((anc (car struct))) (setcdr anc (list (+ (nth 1 anc) offset) "" nil)))
  1025. (org-list-struct-fix-struct struct origins)
  1026. (org-list-struct-apply-struct struct))))
  1027. ;; Forbidden move
  1028. ((and (< arg 0)
  1029. (or (and no-subtree
  1030. (not (org-region-active-p))
  1031. (org-list-struct-get-child beg-item struct))
  1032. (org-list-struct-get-child end-item struct)))
  1033. (error "Cannot outdent an item without its children"))
  1034. ;; Normal shifting
  1035. (t
  1036. (let* ((shifted-ori (if (< arg 0)
  1037. (org-list-struct-outdent beg end origins)
  1038. (org-list-struct-indent beg end origins))))
  1039. (org-list-struct-fix-struct struct shifted-ori)
  1040. (org-list-struct-apply-struct struct)))))
  1041. ;; Return value
  1042. t)
  1043. (defvar org-tab-ind-state)
  1044. (defun org-cycle-item-indentation ()
  1045. (let ((org-adapt-indentation nil))
  1046. (when (and (or (org-at-item-description-p) (org-at-item-checkbox-p) (org-at-item-p))
  1047. (>= (match-end 0) (save-excursion
  1048. (org-end-of-item-or-at-child)
  1049. (skip-chars-backward " \r\t\n")
  1050. (point))))
  1051. (setq this-command 'org-cycle-item-indentation)
  1052. ;; When in the middle of the cycle, try to outdent first. If it
  1053. ;; fails, and point is still at initial position, indent. Else,
  1054. ;; go back to original position.
  1055. (if (eq last-command 'org-cycle-item-indentation)
  1056. (cond
  1057. ((ignore-errors (org-indent-item -1)))
  1058. ((and (= (org-get-indentation) (car org-tab-ind-state))
  1059. (ignore-errors (org-indent-item 1))))
  1060. (t (back-to-indentation)
  1061. (indent-to-column (car org-tab-ind-state))
  1062. (end-of-line)
  1063. (org-fix-bullet-type (nth 1 org-tab-ind-state))
  1064. ;; Break cycle
  1065. (setq this-command 'identity)))
  1066. ;; If a cycle is starting, remember indentation and bullet,
  1067. ;; then try to indent. If it fails, try to outdent.
  1068. (setq org-tab-ind-state
  1069. (list (org-get-indentation) (org-get-bullet)))
  1070. (cond
  1071. ((ignore-errors (org-indent-item 1)))
  1072. ((ignore-errors (org-indent-item -1)))
  1073. (t (error "Cannot move item"))))
  1074. t)))
  1075. ;;; Bullets
  1076. (defun org-get-bullet ()
  1077. "Return the bullet of the item at point.
  1078. Assume cursor is at an item."
  1079. (and (looking-at "[ \t]*\\(\\S-+\\)") (match-string 1)))
  1080. (defun org-list-bullet-string (bullet)
  1081. "Return BULLET with the correct number of whitespaces.
  1082. It determines the number of whitespaces to append by looking at
  1083. `org-list-two-spaces-after-bullet-regexp'."
  1084. (save-match-data
  1085. (string-match "\\S-+\\([ \t]*\\)" bullet)
  1086. (replace-match
  1087. (save-match-data
  1088. (concat
  1089. " "
  1090. ;; Do we need to concat another white space ?
  1091. (when (and org-list-two-spaces-after-bullet-regexp
  1092. (string-match org-list-two-spaces-after-bullet-regexp bullet))
  1093. " ")))
  1094. nil nil bullet 1)))
  1095. (defun org-list-inc-bullet-maybe (bullet)
  1096. "Increment numbered bullets."
  1097. (if (string-match "[0-9]+" bullet)
  1098. (replace-match
  1099. (number-to-string (1+ (string-to-number (match-string 0 bullet)))) nil nil bullet)
  1100. bullet))
  1101. (defun org-list-replace-bullet (new-bullet)
  1102. "Replace current item's bullet with NEW-BULLET.
  1103. Item body is re-indented, but sub-lists are not moved. Assume
  1104. point is at item."
  1105. (save-excursion
  1106. (beginning-of-line)
  1107. (let ((old (progn
  1108. (looking-at "[ \t]*\\(\\S-+[ \t]*\\)")
  1109. (match-string 1))))
  1110. (unless (equal new-bullet old)
  1111. (replace-match new-bullet nil nil nil 1)
  1112. ;; When bullet lengths are differents, move the whole
  1113. ;; sublist accordingly
  1114. (org-shift-item-indentation
  1115. (- (length new-bullet) (length old)))))))
  1116. (defun org-fix-bullet-type (&optional force-bullet)
  1117. "Make sure all items in this list have the same bullet as the first item.
  1118. Also, fix the indentation."
  1119. (interactive)
  1120. (unless (org-at-item-p) (error "This is not a list"))
  1121. (let* ((struct (org-list-struct (point-at-bol) (point-at-eol)))
  1122. (origins (org-list-struct-origins struct))
  1123. fixed-struct)
  1124. (if force-bullet
  1125. (let ((begin (nth 1 struct)))
  1126. (setcdr begin (list (nth 1 begin) (org-list-bullet-string force-bullet) (nth 3 begin)))
  1127. (setq fixed-struct (cons begin (org-list-struct-fix-struct struct origins))))
  1128. (setq fixed-struct (org-list-struct-fix-struct struct origins)))
  1129. (org-list-struct-apply-struct fixed-struct)))
  1130. (defun org-renumber-ordered-list ()
  1131. "Renumber an ordered plain list.
  1132. Cursor needs to be in the first line of an item."
  1133. (interactive)
  1134. (unless (and (org-at-item-p)
  1135. (match-beginning 3))
  1136. (error "This is not an ordered list"))
  1137. (let* ((struct (org-list-struct (point-at-bol) (point-at-eol)))
  1138. (origins (org-list-struct-origins struct)))
  1139. (org-list-struct-apply-struct (org-list-struct-fix-struct struct origins))))
  1140. (defun org-maybe-renumber-ordered-list ()
  1141. "Renumber the ordered list at point if setup allows it.
  1142. This tests the if 'renumber rule is set in
  1143. `org-list-automatic-rules' before doing the renumbering.
  1144. Do not throw error on failure."
  1145. (interactive)
  1146. (when (cdr (assq 'renumber org-list-automatic-rules))
  1147. (ignore-errors (org-renumber-ordered-list))))
  1148. (defun org-cycle-list-bullet (&optional which)
  1149. "Cycle through the different itemize/enumerate bullets.
  1150. This cycle the entire list level through the sequence:
  1151. `-' -> `+' -> `*' -> `1.' -> `1)'
  1152. If WHICH is a valid string, use that as the new bullet. If WHICH
  1153. is an integer, 0 means `-', 1 means `+' etc. If WHICH is
  1154. 'previous, cycle backwards."
  1155. (interactive "P")
  1156. (org-preserve-lc
  1157. (let* ((bullet (progn (org-beginning-of-item-list)
  1158. (org-get-bullet)))
  1159. (current (cond
  1160. ((string-match "\\." bullet) "1.")
  1161. ((string-match ")" bullet) "1)")
  1162. (t bullet)))
  1163. (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules)))
  1164. (bullet-list (append '("-" "+" )
  1165. ;; *-bullets are not allowed at column 0
  1166. (unless (and bullet-rule-p
  1167. (looking-at "\\S-")) '("*"))
  1168. ;; Description items cannot be numbered
  1169. (unless (and bullet-rule-p
  1170. (or (eq org-plain-list-ordered-item-terminator ?.)
  1171. (org-at-item-description-p))) '("1)"))
  1172. (unless (and bullet-rule-p
  1173. (or (eq org-plain-list-ordered-item-terminator ?\))
  1174. (org-at-item-description-p))) '("1."))))
  1175. (len (length bullet-list))
  1176. (item-index (- len (length (member current bullet-list))))
  1177. (get-value (lambda (index) (nth (mod index len) bullet-list)))
  1178. (new (cond
  1179. ((member which bullet-list) which)
  1180. ((numberp which) (funcall get-value which))
  1181. ((eq 'previous which) (funcall get-value (1- item-index)))
  1182. (t (funcall get-value (1+ item-index))))))
  1183. (org-fix-bullet-type new))))
  1184. ;;; Checkboxes
  1185. (defun org-toggle-checkbox (&optional toggle-presence)
  1186. "Toggle the checkbox in the current line.
  1187. With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. With
  1188. double prefix, set checkbox to [-].
  1189. When there is an active region, toggle status or presence of the
  1190. checkbox in the first line, and make every item in the region
  1191. have the same status or presence, respectively.
  1192. If the cursor is in a headline, apply this to all checkbox items
  1193. in the text below the heading, taking as reference the first item
  1194. in subtree."
  1195. (interactive "P")
  1196. ;; Bounds is a list of type (beg end single-p) where single-p is t
  1197. ;; when `org-toggle-checkbox' is applied to a single item. Only
  1198. ;; toggles on single items will return errors.
  1199. (let* ((bounds
  1200. (cond
  1201. ((org-region-active-p)
  1202. (list (region-beginning) (region-end) nil))
  1203. ((org-on-heading-p)
  1204. ;; In this case, reference line is the first item in subtree
  1205. (let ((limit (save-excursion (outline-next-heading) (point))))
  1206. (save-excursion
  1207. (org-search-forward-unenclosed org-item-beginning-re limit 'move)
  1208. (list (point) limit nil))))
  1209. ((org-at-item-p)
  1210. (list (point-at-bol) (point-at-eol) t))
  1211. (t (error "Not at an item or heading, and no active region"))))
  1212. ;; marker is needed because deleting checkboxes will change END
  1213. (end (copy-marker (nth 1 bounds)))
  1214. (single-p (nth 2 bounds))
  1215. (ref-presence (save-excursion (goto-char (car bounds)) (org-at-item-checkbox-p)))
  1216. (ref-status (equal (match-string 1) "[X]"))
  1217. (act-on-item
  1218. (lambda (ref-pres ref-stat)
  1219. (if (equal toggle-presence '(4))
  1220. (cond
  1221. ((and ref-pres (org-at-item-checkbox-p))
  1222. (replace-match ""))
  1223. ((and (not ref-pres)
  1224. (not (org-at-item-checkbox-p))
  1225. (org-at-item-p))
  1226. (goto-char (match-end 0))
  1227. ;; Ignore counter, if any
  1228. (when (looking-at "\\(?:\\[@start:[0-9]+\\][ \t]*\\)?")
  1229. (goto-char (match-end 0)))
  1230. (let ((desc-p (and (org-at-item-description-p)
  1231. (cdr (assq 'checkbox org-list-automatic-rules)))))
  1232. (cond
  1233. ((and single-p desc-p)
  1234. (error "Cannot add a checkbox in a description list"))
  1235. ((not desc-p) (insert "[ ] "))))))
  1236. (let ((blocked (org-checkbox-blocked-p)))
  1237. (cond
  1238. ((and blocked single-p)
  1239. (error "Checkbox blocked because of unchecked box in line %d" blocked))
  1240. (blocked nil)
  1241. ((org-at-item-checkbox-p)
  1242. (replace-match
  1243. (cond ((equal toggle-presence '(16)) "[-]")
  1244. (ref-stat "[ ]")
  1245. (t "[X]"))
  1246. t t nil 1))))))))
  1247. (save-excursion
  1248. (beginning-of-line)
  1249. (while (< (point) end)
  1250. (funcall act-on-item ref-presence ref-status)
  1251. (org-search-forward-unenclosed org-item-beginning-re end 'move)))
  1252. (org-update-checkbox-count-maybe)))
  1253. (defun org-reset-checkbox-state-subtree ()
  1254. "Reset all checkboxes in an entry subtree."
  1255. (interactive "*")
  1256. (save-restriction
  1257. (save-excursion
  1258. (org-narrow-to-subtree)
  1259. (org-show-subtree)
  1260. (goto-char (point-min))
  1261. (let ((end (point-max)))
  1262. (while (< (point) end)
  1263. (when (org-at-item-checkbox-p)
  1264. (replace-match "[ ]" t t nil 1))
  1265. (beginning-of-line 2))))
  1266. (org-update-checkbox-count-maybe)))
  1267. (defvar org-checkbox-statistics-hook nil
  1268. "Hook that is run whenever Org thinks checkbox statistics should be updated.
  1269. This hook runs even if 'checkbox rules in
  1270. `org-list-automatic-rules' do not apply, so it can be used to
  1271. implement alternative ways of collecting statistics
  1272. information.")
  1273. (defun org-update-checkbox-count-maybe ()
  1274. "Update checkbox statistics unless turned off by user."
  1275. (when (cdr (assq 'checkbox org-list-automatic-rules))
  1276. (org-update-checkbox-count))
  1277. (run-hooks 'org-checkbox-statistics-hook))
  1278. (defun org-update-checkbox-count (&optional all)
  1279. "Update the checkbox statistics in the current section.
  1280. This will find all statistic cookies like [57%] and [6/12] and update them
  1281. with the current numbers. With optional prefix argument ALL, do this for
  1282. the whole buffer."
  1283. (interactive "P")
  1284. (save-excursion
  1285. (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21
  1286. (beg (condition-case nil
  1287. (progn (org-back-to-heading) (point))
  1288. (error (point-min))))
  1289. (end (move-marker (make-marker)
  1290. (progn (outline-next-heading) (point))))
  1291. (re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
  1292. (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)")
  1293. (re-find (concat re "\\|" re-box))
  1294. beg-cookie end-cookie is-percent c-on c-off lim new
  1295. eline curr-ind next-ind continue-from startsearch
  1296. (recursive
  1297. (or (not org-hierarchical-checkbox-statistics)
  1298. (string-match "\\<recursive\\>"
  1299. (or (ignore-errors
  1300. (org-entry-get nil "COOKIE_DATA"))
  1301. ""))))
  1302. (cstat 0))
  1303. (when all
  1304. (goto-char (point-min))
  1305. (outline-next-heading)
  1306. (setq beg (point) end (point-max)))
  1307. (goto-char end)
  1308. ;; find each statistics cookie
  1309. (while (and (org-search-backward-unenclosed re-find beg t)
  1310. (not (save-match-data
  1311. (and (org-on-heading-p)
  1312. (string-match "\\<todo\\>"
  1313. (downcase
  1314. (or (org-entry-get
  1315. nil "COOKIE_DATA")
  1316. "")))))))
  1317. (setq beg-cookie (match-beginning 1)
  1318. end-cookie (match-end 1)
  1319. cstat (+ cstat (if end-cookie 1 0))
  1320. startsearch (point-at-eol)
  1321. continue-from (match-beginning 0)
  1322. is-percent (match-beginning 2)
  1323. lim (cond
  1324. ((org-on-heading-p) (outline-next-heading) (point))
  1325. ((org-at-item-p) (org-end-of-item) (point))
  1326. (t nil))
  1327. c-on 0
  1328. c-off 0)
  1329. (when lim
  1330. ;; find first checkbox for this cookie and gather
  1331. ;; statistics from all that are at this indentation level
  1332. (goto-char startsearch)
  1333. (if (org-search-forward-unenclosed re-box lim t)
  1334. (progn
  1335. (org-beginning-of-item)
  1336. (setq curr-ind (org-get-indentation))
  1337. (setq next-ind curr-ind)
  1338. (while (and (bolp) (org-at-item-p)
  1339. (if recursive
  1340. (<= curr-ind next-ind)
  1341. (= curr-ind next-ind)))
  1342. (setq eline (point-at-eol))
  1343. (if (org-search-forward-unenclosed re-box eline t)
  1344. (if (member (match-string 2) '("[ ]" "[-]"))
  1345. (setq c-off (1+ c-off))
  1346. (setq c-on (1+ c-on))))
  1347. (if (not recursive)
  1348. ;; org-get-next-item goes through list-enders
  1349. ;; with proper limit.
  1350. (goto-char (or (org-get-next-item (point) lim) lim))
  1351. (end-of-line)
  1352. (when (org-search-forward-unenclosed org-item-beginning-re lim t)
  1353. (beginning-of-line)))
  1354. (setq next-ind (org-get-indentation)))))
  1355. (goto-char continue-from)
  1356. ;; update cookie
  1357. (when end-cookie
  1358. (setq new (if is-percent
  1359. (format "[%d%%]" (/ (* 100 c-on) (max 1 (+ c-on c-off))))
  1360. (format "[%d/%d]" c-on (+ c-on c-off))))
  1361. (goto-char beg-cookie)
  1362. (insert new)
  1363. (delete-region (point) (+ (point) (- end-cookie beg-cookie))))
  1364. ;; update items checkbox if it has one
  1365. (when (org-at-item-p)
  1366. (org-beginning-of-item)
  1367. (when (and (> (+ c-on c-off) 0)
  1368. (org-search-forward-unenclosed re-box (point-at-eol) t))
  1369. (setq beg-cookie (match-beginning 2)
  1370. end-cookie (match-end 2))
  1371. (delete-region beg-cookie end-cookie)
  1372. (goto-char beg-cookie)
  1373. (cond ((= c-off 0) (insert "[X]"))
  1374. ((= c-on 0) (insert "[ ]"))
  1375. (t (insert "[-]")))
  1376. )))
  1377. (goto-char continue-from))
  1378. (when (interactive-p)
  1379. (message "Checkbox statistics updated %s (%d places)"
  1380. (if all "in entire file" "in current outline entry") cstat)))))
  1381. (defun org-get-checkbox-statistics-face ()
  1382. "Select the face for checkbox statistics.
  1383. The face will be `org-done' when all relevant boxes are checked.
  1384. Otherwise it will be `org-todo'."
  1385. (if (match-end 1)
  1386. (if (equal (match-string 1) "100%")
  1387. 'org-checkbox-statistics-done
  1388. 'org-checkbox-statistics-todo)
  1389. (if (and (> (match-end 2) (match-beginning 2))
  1390. (equal (match-string 2) (match-string 3)))
  1391. 'org-checkbox-statistics-done
  1392. 'org-checkbox-statistics-todo)))
  1393. ;;; Misc Tools
  1394. (defun org-apply-on-list (function init-value &rest args)
  1395. "Call FUNCTION for each item of a the list under point.
  1396. FUNCTION must be called with at least one argument: a return
  1397. value that will contain the value returned by the function at the
  1398. previous item, plus ARGS extra arguments. INIT-VALUE will be the
  1399. value passed to the function at the first item of the list.
  1400. As an example, (org-apply-on-list (lambda (result) (1+ result)) 0)
  1401. will return the number of items in the current list.
  1402. Sublists of the list are skipped. Cursor is always at the
  1403. beginning of the item."
  1404. (save-excursion
  1405. (let ((end (copy-marker (save-excursion (org-end-of-item-list))))
  1406. (next-p (make-marker))
  1407. (move-down-action
  1408. (lambda (pos value &rest args)
  1409. (goto-char pos)
  1410. (set-marker next-p (org-get-next-item pos end))
  1411. (let ((return-value (apply function value args)))
  1412. (if (marker-position next-p)
  1413. (apply move-down-action next-p return-value args)
  1414. return-value)))))
  1415. (apply move-down-action (org-beginning-of-item-list) init-value args))))
  1416. (defun org-sort-list (&optional with-case sorting-type getkey-func compare-func)
  1417. "Sort plain list items.
  1418. The cursor may be at any item of the list that should be sorted.
  1419. Sublists are not sorted. Checkboxes, if any, are ignored.
  1420. Sorting can be alphabetically, numerically, by date/time as given by
  1421. a time stamp, by a property or by priority.
  1422. The command prompts for the sorting type unless it has been given
  1423. to the function through the SORTING-TYPE argument, which needs to
  1424. be a character, \(?n ?N ?a ?A ?t ?T ?f ?F). Here is the precise
  1425. meaning of each character:
  1426. n Numerically, by converting the beginning of the item to a number.
  1427. a Alphabetically. Only the first line of item is checked.
  1428. t By date/time, either the first active time stamp in the entry, if
  1429. any, or by the first inactive one. In a timer list, sort the timers.
  1430. Capital letters will reverse the sort order.
  1431. If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a
  1432. function to be called with point at the beginning of the record.
  1433. It must return either a string or a number that should serve as
  1434. the sorting key for that record.
  1435. Comparing entries ignores case by default. However, with an
  1436. optional argument WITH-CASE, the sorting considers case as well."
  1437. (interactive "P")
  1438. (let* ((case-func (if with-case 'identity 'downcase))
  1439. (start (org-beginning-of-item-list))
  1440. (end (save-excursion (org-end-of-item-list)))
  1441. (sorting-type
  1442. (progn
  1443. (message
  1444. "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:")
  1445. (read-char-exclusive)))
  1446. (getkey-func (and (= (downcase sorting-type) ?f)
  1447. (org-icompleting-read "Sort using function: "
  1448. obarray 'fboundp t nil nil)
  1449. (intern getkey-func))))
  1450. (message "Sorting items...")
  1451. (save-restriction
  1452. (narrow-to-region start end)
  1453. (let* ((dcst (downcase sorting-type))
  1454. (case-fold-search nil)
  1455. (now (current-time))
  1456. (sort-func (cond
  1457. ((= dcst ?a) 'string<)
  1458. ((= dcst ?f) compare-func)
  1459. ((= dcst ?t) '<)
  1460. (t nil)))
  1461. (begin-record (lambda ()
  1462. (skip-chars-forward " \r\t\n")
  1463. (beginning-of-line)))
  1464. (end-record (lambda ()
  1465. (goto-char (org-end-of-item-before-blank))))
  1466. (value-to-sort
  1467. (lambda ()
  1468. (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+")
  1469. (cond
  1470. ((= dcst ?n)
  1471. (string-to-number (buffer-substring (match-end 0)
  1472. (point-at-eol))))
  1473. ((= dcst ?a)
  1474. (buffer-substring (match-end 0) (point-at-eol)))
  1475. ((= dcst ?t)
  1476. (cond
  1477. ;; If it is a timer list, convert timer to seconds
  1478. ((org-at-item-timer-p)
  1479. (org-timer-hms-to-secs (match-string 1)))
  1480. ((or (org-search-forward-unenclosed org-ts-regexp
  1481. (point-at-eol) t)
  1482. (org-search-forward-unenclosed org-ts-regexp-both
  1483. (point-at-eol) t))
  1484. (org-time-string-to-seconds (match-string 0)))
  1485. (t (org-float-time now))))
  1486. ((= dcst ?f)
  1487. (if getkey-func
  1488. (let ((value (funcall getkey-func)))
  1489. (if (stringp value)
  1490. (funcall case-func value)
  1491. value))
  1492. (error "Invalid key function `%s'" getkey-func)))
  1493. (t (error "Invalid sorting type `%c'" sorting-type)))))))
  1494. (sort-subr (/= dcst sorting-type) begin-record end-record value-to-sort nil sort-func)
  1495. (org-maybe-renumber-ordered-list)
  1496. (run-hooks 'org-after-sorting-entries-or-items-hook)
  1497. (message "Sorting items...done")))))
  1498. ;;; Send and receive lists
  1499. (defun org-list-parse-list (&optional delete)
  1500. "Parse the list at point and maybe DELETE it.
  1501. Return a list containing first level items as strings and
  1502. sublevels as a list of strings."
  1503. (let* ((start (goto-char (org-list-top-point)))
  1504. (end (org-list-bottom-point))
  1505. output itemsep ltype)
  1506. (while (org-search-forward-unenclosed org-item-beginning-re end t)
  1507. (save-excursion
  1508. (beginning-of-line)
  1509. (setq ltype (cond ((looking-at-p "^[ \t]*[0-9]") 'ordered)
  1510. ((org-at-item-description-p) 'descriptive)
  1511. (t 'unordered))))
  1512. (let* ((indent1 (org-get-indentation))
  1513. (nextitem (or (org-get-next-item (point) end) end))
  1514. (item (org-trim (buffer-substring (point) (org-end-of-item-or-at-child))))
  1515. (nextindent (if (= (point) end) 0 (org-get-indentation)))
  1516. (item (if (string-match "^\\(?:\\[@start:[0-9]+\\][ \t]*\\)?\\[\\([xX ]\\)\\]" item)
  1517. (replace-match (if (equal (match-string 1 item) " ")
  1518. "CBOFF"
  1519. "CBON")
  1520. t nil item 1)
  1521. item)))
  1522. (push item output)
  1523. (when (> nextindent indent1)
  1524. (save-restriction
  1525. (narrow-to-region (point) nextitem)
  1526. (push (org-list-parse-list) output)))))
  1527. (when delete
  1528. (delete-region start end)
  1529. (save-match-data
  1530. (when (looking-at (org-list-end-re))
  1531. (replace-match "\n"))))
  1532. (setq output (nreverse output))
  1533. (push ltype output)))
  1534. (defun org-list-make-subtree ()
  1535. "Convert the plain list at point into a subtree."
  1536. (interactive)
  1537. (if (not (org-in-item-p))
  1538. (error "Not in a list.")
  1539. (goto-char (org-list-top-point))
  1540. (let ((list (org-list-parse-list t)) nstars)
  1541. (save-excursion
  1542. (if (ignore-errors
  1543. (org-back-to-heading))
  1544. (progn (org-search-forward-unenclosed org-complex-heading-regexp nil t)
  1545. (setq nstars (length (match-string 1))))
  1546. (setq nstars 0)))
  1547. (org-list-make-subtrees list (1+ nstars)))))
  1548. (defun org-list-make-subtrees (list level)
  1549. "Convert LIST into subtrees starting at LEVEL."
  1550. (if (symbolp (car list))
  1551. (org-list-make-subtrees (cdr list) level)
  1552. (mapcar (lambda (item)
  1553. (if (stringp item)
  1554. (insert (make-string
  1555. (if org-odd-levels-only
  1556. (1- (* 2 level)) level) ?*) " " item "\n")
  1557. (org-list-make-subtrees item (1+ level))))
  1558. list)))
  1559. (defun org-list-insert-radio-list ()
  1560. "Insert a radio list template appropriate for this major mode."
  1561. (interactive)
  1562. (let* ((e (assq major-mode org-list-radio-list-templates))
  1563. (txt (nth 1 e))
  1564. name pos)
  1565. (unless e (error "No radio list setup defined for %s" major-mode))
  1566. (setq name (read-string "List name: "))
  1567. (while (string-match "%n" txt)
  1568. (setq txt (replace-match name t t txt)))
  1569. (or (bolp) (insert "\n"))
  1570. (setq pos (point))
  1571. (insert txt)
  1572. (goto-char pos)))
  1573. (defun org-list-send-list (&optional maybe)
  1574. "Send a transformed version of this list to the receiver position.
  1575. With argument MAYBE, fail quietly if no transformation is defined for
  1576. this list."
  1577. (interactive)
  1578. (catch 'exit
  1579. (unless (org-at-item-p) (error "Not at a list"))
  1580. (save-excursion
  1581. (re-search-backward "#\\+ORGLST" nil t)
  1582. (unless (looking-at "[ \t]*#\\+ORGLST[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?")
  1583. (if maybe
  1584. (throw 'exit nil)
  1585. (error "Don't know how to transform this list"))))
  1586. (let* ((name (match-string 1))
  1587. (transform (intern (match-string 2)))
  1588. (bottom-point
  1589. (save-excursion
  1590. (re-search-forward "\\(\\\\end{comment}\\|@end ignore\\|-->\\)" nil t)
  1591. (match-beginning 0)))
  1592. (top-point
  1593. (progn
  1594. (re-search-backward "#\\+ORGLST" nil t)
  1595. (re-search-forward org-item-beginning-re bottom-point t)
  1596. (match-beginning 0)))
  1597. (list (save-restriction
  1598. (narrow-to-region top-point bottom-point)
  1599. (org-list-parse-list)))
  1600. beg txt)
  1601. (unless (fboundp transform)
  1602. (error "No such transformation function %s" transform))
  1603. (let ((txt (funcall transform list)))
  1604. ;; Find the insertion place
  1605. (save-excursion
  1606. (goto-char (point-min))
  1607. (unless (re-search-forward
  1608. (concat "BEGIN RECEIVE ORGLST +" name "\\([ \t]\\|$\\)") nil t)
  1609. (error "Don't know where to insert translated list"))
  1610. (goto-char (match-beginning 0))
  1611. (beginning-of-line 2)
  1612. (setq beg (point))
  1613. (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t)
  1614. (error "Cannot find end of insertion region"))
  1615. (delete-region beg (point-at-bol))
  1616. (goto-char beg)
  1617. (insert txt "\n")))
  1618. (message "List converted and installed at receiver location"))))
  1619. (defun org-list-to-generic (list params)
  1620. "Convert a LIST parsed through `org-list-parse-list' to other formats.
  1621. Valid parameters PARAMS are
  1622. :ustart String to start an unordered list
  1623. :uend String to end an unordered list
  1624. :ostart String to start an ordered list
  1625. :oend String to end an ordered list
  1626. :dstart String to start a descriptive list
  1627. :dend String to end a descriptive list
  1628. :dtstart String to start a descriptive term
  1629. :dtend String to end a descriptive term
  1630. :ddstart String to start a description
  1631. :ddend String to end a description
  1632. :splice When set to t, return only list body lines, don't wrap
  1633. them into :[u/o]start and :[u/o]end. Default is nil.
  1634. :istart String to start a list item
  1635. :iend String to end a list item
  1636. :isep String to separate items
  1637. :lsep String to separate sublists
  1638. :cboff String to insert for an unchecked checkbox
  1639. :cbon String to insert for a checked checkbox"
  1640. (interactive)
  1641. (let* ((p params) sublist
  1642. (splicep (plist-get p :splice))
  1643. (ostart (plist-get p :ostart))
  1644. (oend (plist-get p :oend))
  1645. (ustart (plist-get p :ustart))
  1646. (uend (plist-get p :uend))
  1647. (dstart (plist-get p :dstart))
  1648. (dend (plist-get p :dend))
  1649. (dtstart (plist-get p :dtstart))
  1650. (dtend (plist-get p :dtend))
  1651. (ddstart (plist-get p :ddstart))
  1652. (ddend (plist-get p :ddend))
  1653. (istart (plist-get p :istart))
  1654. (iend (plist-get p :iend))
  1655. (isep (plist-get p :isep))
  1656. (lsep (plist-get p :lsep))
  1657. (cbon (plist-get p :cbon))
  1658. (cboff (plist-get p :cboff)))
  1659. (let ((wrapper
  1660. (cond ((eq (car list) 'ordered)
  1661. (concat ostart "\n%s" oend "\n"))
  1662. ((eq (car list) 'unordered)
  1663. (concat ustart "\n%s" uend "\n"))
  1664. ((eq (car list) 'descriptive)
  1665. (concat dstart "\n%s" dend "\n"))))
  1666. rtn term defstart defend)
  1667. (while (setq sublist (pop list))
  1668. (cond ((symbolp sublist) nil)
  1669. ((stringp sublist)
  1670. (when (string-match "^\\(\\S-+\\)[ \t]+::" sublist)
  1671. (setq term (org-trim (format (concat dtstart "%s" dtend)
  1672. (match-string 1 sublist))))
  1673. (setq sublist (concat ddstart
  1674. (org-trim (substring sublist (match-end 0)))
  1675. ddend)))
  1676. (if (string-match "\\[CBON\\]" sublist)
  1677. (setq sublist (replace-match cbon t t sublist)))
  1678. (if (string-match "\\[CBOFF\\]" sublist)
  1679. (setq sublist (replace-match cboff t t sublist)))
  1680. (if (string-match "\\[-\\]" sublist)
  1681. (setq sublist (replace-match "$\\boxminus$" t t sublist)))
  1682. (setq rtn (concat rtn istart term sublist iend isep)))
  1683. (t (setq rtn (concat rtn ;; previous list
  1684. lsep ;; list separator
  1685. (org-list-to-generic sublist p)
  1686. lsep ;; list separator
  1687. )))))
  1688. (format wrapper rtn))))
  1689. (defun org-list-to-latex (list &optional params)
  1690. "Convert LIST into a LaTeX list.
  1691. LIST is as returned by `org-list-parse-list'. PARAMS is a property list
  1692. with overruling parameters for `org-list-to-generic'."
  1693. (org-list-to-generic
  1694. list
  1695. (org-combine-plists
  1696. '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}"
  1697. :ustart "\\begin{itemize}" :uend "\\end{itemize}"
  1698. :dstart "\\begin{description}" :dend "\\end{description}"
  1699. :dtstart "[" :dtend "]"
  1700. :ddstart "" :ddend ""
  1701. :istart "\\item " :iend ""
  1702. :isep "\n" :lsep "\n"
  1703. :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}")
  1704. params)))
  1705. (defun org-list-to-html (list &optional params)
  1706. "Convert LIST into a HTML list.
  1707. LIST is as returned by `org-list-parse-list'. PARAMS is a property list
  1708. with overruling parameters for `org-list-to-generic'."
  1709. (org-list-to-generic
  1710. list
  1711. (org-combine-plists
  1712. '(:splicep nil :ostart "<ol>" :oend "</ol>"
  1713. :ustart "<ul>" :uend "</ul>"
  1714. :dstart "<dl>" :dend "</dl>"
  1715. :dtstart "<dt>" :dtend "</dt>"
  1716. :ddstart "<dd>" :ddend "</dd>"
  1717. :istart "<li>" :iend "</li>"
  1718. :isep "\n" :lsep "\n"
  1719. :cbon "<code>[X]</code>" :cboff "<code>[ ]</code>")
  1720. params)))
  1721. (defun org-list-to-texinfo (list &optional params)
  1722. "Convert LIST into a Texinfo list.
  1723. LIST is as returned by `org-list-parse-list'. PARAMS is a property list
  1724. with overruling parameters for `org-list-to-generic'."
  1725. (org-list-to-generic
  1726. list
  1727. (org-combine-plists
  1728. '(:splicep nil :ostart "@itemize @minus" :oend "@end itemize"
  1729. :ustart "@enumerate" :uend "@end enumerate"
  1730. :dstart "@table" :dend "@end table"
  1731. :dtstart "@item " :dtend "\n"
  1732. :ddstart "" :ddend ""
  1733. :istart "@item\n" :iend ""
  1734. :isep "\n" :lsep "\n"
  1735. :cbon "@code{[X]}" :cboff "@code{[ ]}")
  1736. params)))
  1737. (provide 'org-list)
  1738. ;; arch-tag: 73cf50c1-200f-4d1d-8a53-4e842a5b11c8
  1739. ;;; org-list.el ends here