org-list.el 62 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700
  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] or
  154. \\[org-insert-todo-heading]. You can disable individually these
  155. rules by setting sets to nil. Valid sets are:
  156. bullet when non-nil, cycling bullet do not allow lists at
  157. column 0 to have * as a bullet and descriptions lists
  158. to be numbered.
  159. checkbox when non-nil, checkbox statistics is updated each time
  160. you either insert a new checkbox or toggle a checkbox.
  161. indent when non-nil indenting or outdenting list top-item will
  162. move the whole list, indenting the first item of a
  163. sub-list will be forbidden and outdenting a list whose
  164. bullet is * to column 0 will change that bullet to -.
  165. insert when non-nil, trying to insert an item inside a block
  166. will insert it right before the block instead of
  167. throwing an error.
  168. renumber when non-nil, renumber ordered plain lists whenever it
  169. is modified. You can always use \\[org-ctrl-c-ctrl-c]
  170. to trigger renumbering."
  171. :group 'org-plain-lists
  172. :type '(alist :tag "Sets of rules"
  173. :key-type
  174. (choice
  175. (const :tag "Bullet" bullet)
  176. (const :tag "Checkbox" checkbox)
  177. (const :tag "Indent" indent)
  178. (const :tag "Insert" insert)
  179. (const :tag "Renumber" renumber))
  180. :value-type
  181. (boolean :tag "Activate" :value t)))
  182. (defcustom org-hierarchical-checkbox-statistics t
  183. "Non-nil means checkbox statistics counts only the state of direct children.
  184. When nil, all boxes below the cookie are counted.
  185. This can be set to nil on a per-node basis using a COOKIE_DATA property
  186. with the word \"recursive\" in the value."
  187. :group 'org-plain-lists
  188. :type 'boolean)
  189. (defcustom org-description-max-indent 20
  190. "Maximum indentation for the second line of a description list.
  191. When the indentation would be larger than this, it will become
  192. 5 characters instead."
  193. :group 'org-plain-lists
  194. :type 'integer)
  195. (defcustom org-list-radio-list-templates
  196. '((latex-mode "% BEGIN RECEIVE ORGLST %n
  197. % END RECEIVE ORGLST %n
  198. \\begin{comment}
  199. #+ORGLST: SEND %n org-list-to-latex
  200. -
  201. \\end{comment}\n")
  202. (texinfo-mode "@c BEGIN RECEIVE ORGLST %n
  203. @c END RECEIVE ORGLST %n
  204. @ignore
  205. #+ORGLST: SEND %n org-list-to-texinfo
  206. -
  207. @end ignore\n")
  208. (html-mode "<!-- BEGIN RECEIVE ORGLST %n -->
  209. <!-- END RECEIVE ORGLST %n -->
  210. <!--
  211. #+ORGLST: SEND %n org-list-to-html
  212. -
  213. -->\n"))
  214. "Templates for radio lists in different major modes.
  215. All occurrences of %n in a template will be replaced with the name of the
  216. list, obtained by prompting the user."
  217. :group 'org-plain-lists
  218. :type '(repeat
  219. (list (symbol :tag "Major mode")
  220. (string :tag "Format"))))
  221. ;;; Internal functions
  222. (defun org-list-end-re ()
  223. "Return the regex corresponding to the end of a list.
  224. It depends on `org-empty-line-terminates-plain-lists'."
  225. (if org-empty-line-terminates-plain-lists
  226. "^[ \t]*\n"
  227. org-list-end-regexp))
  228. (defun org-item-re (&optional general)
  229. "Return the correct regular expression for plain lists.
  230. If GENERAL is non-nil, return the general regexp independent of the value
  231. of `org-plain-list-ordered-item-terminator'."
  232. (cond
  233. ((or general (eq org-plain-list-ordered-item-terminator t))
  234. "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")
  235. ((= org-plain-list-ordered-item-terminator ?.)
  236. "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")
  237. ((= org-plain-list-ordered-item-terminator ?\))
  238. "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")
  239. (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))))
  240. (defconst org-item-beginning-re (concat "^" (org-item-re))
  241. "Regexp matching the beginning of a plain list item.")
  242. (defun org-list-terminator-between (min max &optional firstp)
  243. "Find the position of a list ender between MIN and MAX, or nil.
  244. This function looks for `org-list-end-re' outside a block.
  245. If FIRSTP in non-nil, return the point at the beginning of the
  246. nearest valid terminator from min. Otherwise, return the point at
  247. the end of the nearest terminator from max."
  248. (save-excursion
  249. (let* ((start (if firstp min max))
  250. (end (if firstp max min))
  251. (search-fun (if firstp
  252. #'org-search-forward-unenclosed
  253. #'org-search-backward-unenclosed))
  254. (list-end-p (progn
  255. (goto-char start)
  256. (funcall search-fun (org-list-end-re) end t))))
  257. ;; Is there a valid list terminator somewhere ?
  258. (and list-end-p
  259. ;; we want to be on the first line of the list ender
  260. (match-beginning 0)))))
  261. (defun org-list-search-unenclosed-generic (search-fun regexp bound noerror count)
  262. "Search for REGEXP with SEARCH-FUN but don't stop inside blocks or at protected places."
  263. (let ((origin (point)))
  264. (cond
  265. ;; nothing found: return nil
  266. ((not (funcall search-fun regexp bound noerror count)) nil)
  267. ((or (save-match-data
  268. (org-in-regexps-block-p "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)"
  269. '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2))))
  270. (get-text-property (match-beginning 0) 'org-protected))
  271. ;; match is enclosed or protected: start again, searching one
  272. ;; occurrence away.
  273. (goto-char origin)
  274. (org-list-search-unenclosed-generic search-fun regexp bound noerror (1+ count)))
  275. ;; else return point.
  276. (t (point)))))
  277. (defun org-search-backward-unenclosed (regexp &optional bound noerror)
  278. "Like `re-search-backward' but don't stop inside blocks or at protected places."
  279. (org-list-search-unenclosed-generic #'re-search-backward regexp bound noerror 1))
  280. (defun org-search-forward-unenclosed (regexp &optional bound noerror)
  281. "Like `re-search-forward' but don't stop inside blocks or at protected places."
  282. (org-list-search-unenclosed-generic #'re-search-forward regexp bound noerror 1))
  283. (defun org-list-at-regexp-after-bullet-p (regexp)
  284. "Is point at a list item with REGEXP after bullet?"
  285. (and (org-at-item-p)
  286. (save-excursion
  287. (goto-char (match-end 0))
  288. (looking-at regexp))))
  289. (defun org-list-get-item-same-level (search-fun pos limit pre-move)
  290. "Return point at the beginning of next item at the same level.
  291. Search items using function SEARCH-FUN, from POS to LIMIT. It
  292. uses PRE-MOVE before search. Return nil if no item was found."
  293. (save-excursion
  294. (goto-char pos)
  295. (let ((ind (progn
  296. (org-beginning-of-item)
  297. (org-get-indentation)))
  298. (start (point-at-bol)))
  299. ;; We don't want to match the current line.
  300. (funcall pre-move)
  301. ;; Skip any sublist on the way
  302. (while (and (funcall search-fun org-item-beginning-re limit t)
  303. (> (org-get-indentation) ind)))
  304. (when (and (/= (point-at-bol) start) ; Have we moved ?
  305. (= (org-get-indentation) ind))
  306. (point-at-bol)))))
  307. (defun org-list-insert-item-generic (pos &optional checkbox after-bullet)
  308. "Insert a new list item at POS.
  309. If POS is before first character after bullet of the item, the
  310. new item will be created before the current one.
  311. Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET
  312. after the bullet. Cursor will be after this text once the
  313. function ends."
  314. (goto-char pos)
  315. ;; Is point in a special block?
  316. (when (org-in-regexps-block-p
  317. "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)"
  318. '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2)))
  319. (if (not (cdr (assq 'insert org-list-automatic-rules)))
  320. ;; Rule in `org-list-automatic-rules' forbids insertion.
  321. (error "Cannot insert item inside a block.")
  322. ;; Else, move before it prior to add a new item.
  323. (end-of-line)
  324. (re-search-backward "^[ \t]*#\\+\\(begin\\|BEGIN\\)_" nil t)
  325. (end-of-line 0)))
  326. (let* ((true-pos (point))
  327. (bullet (and (org-beginning-of-item)
  328. (org-list-bullet-string (org-get-bullet))))
  329. (ind (org-get-indentation))
  330. (before-p (progn
  331. ;; Description item: text starts after colons.
  332. (or (org-at-item-description-p)
  333. ;; At a checkbox: text starts after it.
  334. (org-at-item-checkbox-p)
  335. ;; Otherwise, text starts after bullet.
  336. (org-at-item-p))
  337. (<= true-pos (match-end 0))))
  338. ;; Guess number of blank lines used to separate items.
  339. (blank-lines-nb
  340. (let ((insert-blank-p
  341. (cdr (assq 'plain-list-item org-blank-before-new-entry))))
  342. (cond
  343. ;; Trivial cases where there should be none.
  344. ((or org-empty-line-terminates-plain-lists
  345. (not insert-blank-p)) 0)
  346. ;; When `org-blank-before-new-entry' says so, it is 1.
  347. ((eq insert-blank-p t) 1)
  348. ;; plain-list-item is 'auto. Count blank lines separating
  349. ;; neighbours items in list.
  350. (t (let ((next-p (org-get-next-item (point) (org-list-bottom-point))))
  351. (cond
  352. ;; Is there a next item?
  353. (next-p (goto-char next-p)
  354. (org-back-over-empty-lines))
  355. ;; Is there a previous item?
  356. ((not (org-list-first-item-p)) (org-back-over-empty-lines))
  357. ;; Item alone: count lines separating it from parent, if any
  358. ((/= (org-list-top-point) (point-at-bol))
  359. (org-back-over-empty-lines))
  360. ;; No parent: no blank line.
  361. (t 0)))))))
  362. (insert-fun
  363. (lambda (text)
  364. ;; insert bullet above item in order to avoid bothering
  365. ;; with possible blank lines ending last item.
  366. (org-beginning-of-item)
  367. (indent-to-column ind)
  368. (insert (concat bullet (when checkbox "[ ] ") after-bullet))
  369. ;; Stay between after-bullet and before text.
  370. (save-excursion
  371. (insert (concat text (make-string (1+ blank-lines-nb) ?\n))))
  372. (unless before-p (org-move-item-down))
  373. (when checkbox (org-update-checkbox-count-maybe)))))
  374. (goto-char true-pos)
  375. (cond
  376. (before-p (funcall insert-fun nil)
  377. ;; Not taking advantage of renumbering while moving
  378. ;; down. Need to call it directly.
  379. (org-maybe-renumber-ordered-list) t)
  380. ;; Can't split item: insert bullet at the end of item.
  381. ((not (org-get-alist-option org-M-RET-may-split-line 'item))
  382. (funcall insert-fun nil) t)
  383. ;; else, insert a new bullet along with everything from point
  384. ;; down to last non-blank line of item.
  385. (t
  386. (delete-horizontal-space)
  387. ;; Get pos again in case previous command modified line.
  388. (let* ((pos (point))
  389. (end-before-blank (org-end-of-item-before-blank))
  390. (after-text
  391. (when (< pos end-before-blank)
  392. (prog1
  393. (delete-and-extract-region pos end-before-blank)
  394. ;; delete any blank line at and before point.
  395. (beginning-of-line)
  396. (while (looking-at "^[ \t]*$")
  397. (delete-region (point-at-bol) (1+ (point-at-eol)))
  398. (beginning-of-line 0))))))
  399. (funcall insert-fun after-text) t)))))
  400. ;;; Predicates
  401. (defun org-in-item-p ()
  402. "Is the cursor inside a plain list ?"
  403. (unless (let ((outline-regexp org-outline-regexp)) (org-at-heading-p))
  404. (save-excursion
  405. (let* ((limit (save-excursion (outline-previous-heading)))
  406. ;; Move to eol so current line can be matched by `org-item-re'.
  407. (actual-pos (goto-char (point-at-eol)))
  408. (last-item-start (save-excursion
  409. (org-search-backward-unenclosed org-item-beginning-re limit t)))
  410. (list-ender (org-list-terminator-between last-item-start actual-pos)))
  411. ;; We are in a list when we are on an item line or when we can
  412. ;; find an item before point and there is no valid list ender
  413. ;; between it and the point.
  414. (and last-item-start
  415. (not list-ender))))))
  416. (defun org-list-first-item-p ()
  417. "Is this item the first item in a plain list?"
  418. (save-excursion
  419. (= (org-beginning-of-item) (org-beginning-of-item-list))))
  420. (defun org-at-item-p ()
  421. "Is point in a line starting a hand-formatted item?"
  422. (save-excursion
  423. (goto-char (point-at-bol))
  424. (looking-at org-item-beginning-re)))
  425. (defun org-at-item-bullet-p ()
  426. "Is point at the bullet of a plain list item?"
  427. (and (org-at-item-p)
  428. (not (member (char-after) '(?\ ?\t)))
  429. (< (point) (match-end 0))))
  430. (defun org-at-item-timer-p ()
  431. "Is point at a line starting a plain list item with a timer?"
  432. (org-list-at-regexp-after-bullet-p "\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+::[ \t]+"))
  433. (defun org-at-item-description-p ()
  434. "Is point at a description list item?"
  435. (org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::[ \t]+"))
  436. (defun org-at-item-checkbox-p ()
  437. "Is point at a line starting a plain-list item with a checklet?"
  438. (org-list-at-regexp-after-bullet-p "\\(\\[[- X]\\]\\)[ \t]+"))
  439. (defun org-item-has-child-p ()
  440. "Does the current item have subitems?"
  441. (save-excursion
  442. (org-beginning-of-item)
  443. (let ((ind (org-get-indentation)))
  444. (org-end-of-item-or-at-child)
  445. (and (org-at-item-p)
  446. (> (org-get-indentation) ind)))))
  447. (defun org-checkbox-blocked-p ()
  448. "Is the current checkbox blocked from for being checked now?
  449. A checkbox is blocked if all of the following conditions are fulfilled:
  450. 1. The checkbox is not checked already.
  451. 2. The current entry has the ORDERED property set.
  452. 3. There is an unchecked checkbox in this entry before the current line."
  453. (catch 'exit
  454. (save-match-data
  455. (save-excursion
  456. (unless (org-at-item-checkbox-p) (throw 'exit nil))
  457. (when (equal (match-string 1) "[X]")
  458. ;; the box is already checked!
  459. (throw 'exit nil))
  460. (let ((end (point-at-bol)))
  461. (condition-case nil (org-back-to-heading t)
  462. (error (throw 'exit nil)))
  463. (unless (org-entry-get nil "ORDERED") (throw 'exit nil))
  464. (when (org-search-forward-unenclosed "^[ \t]*[-+*0-9.)] \\[[- ]\\]" end t)
  465. (org-current-line)))))))
  466. ;;; Navigate
  467. (defun org-list-top-point ()
  468. "Return point at the top level item in a list, or nil if not in a list."
  469. (save-excursion
  470. (and (org-in-item-p)
  471. (let ((pos (point-at-eol))
  472. (bound (or (outline-previous-heading) (point-min))))
  473. ;; Is there some list above this one ? If so, go to its ending.
  474. ;; Otherwise, go back to the heading above or bob.
  475. (goto-char (or (org-list-terminator-between bound pos) bound))
  476. ;; From there, search down our list.
  477. (org-search-forward-unenclosed org-item-beginning-re pos t)
  478. (point-at-bol)))))
  479. (defun org-list-bottom-point ()
  480. "Return point just before list ending or nil if not in a list."
  481. (save-excursion
  482. (and (org-in-item-p)
  483. (let ((pos (org-beginning-of-item))
  484. (bound (or (and (let ((outline-regexp org-outline-regexp))
  485. ;; Use default regexp because folding
  486. ;; changes OUTLINE-REGEXP.
  487. (outline-next-heading))
  488. (skip-chars-backward " \t\r\n")
  489. (1+ (point-at-eol)))
  490. (point-max))))
  491. ;; The list ending is either first point matching
  492. ;; `org-list-end-re', point at first white-line before next
  493. ;; heading, or eob.
  494. (or (org-list-terminator-between pos bound t) bound)))))
  495. (defun org-beginning-of-item ()
  496. "Go to the beginning of the current hand-formatted item.
  497. If the cursor is not in an item, throw an error. Return point."
  498. (interactive)
  499. (if (not (org-in-item-p))
  500. (error "Not in an item")
  501. ;; Possibly match the current line.
  502. (end-of-line)
  503. (org-search-backward-unenclosed org-item-beginning-re nil t)
  504. (goto-char (point-at-bol))))
  505. (defun org-end-of-item ()
  506. "Go to the end of the current hand-formatted item.
  507. If the cursor is not in an item, throw an error."
  508. (interactive)
  509. (let ((next-p (org-get-next-item (point) (org-list-bottom-point))))
  510. (cond ((not (org-in-item-p)) (error "Not in an item"))
  511. (next-p (goto-char next-p))
  512. (t (org-end-of-item-list)))))
  513. (defun org-end-of-item-or-at-child ()
  514. "Move to the end of the item text, stops before the first child if any."
  515. (let ((limit (org-list-bottom-point)))
  516. (end-of-line)
  517. (goto-char
  518. (if (org-search-forward-unenclosed org-item-beginning-re limit t)
  519. (point-at-bol)
  520. limit))))
  521. (defun org-end-of-item-before-blank ()
  522. "Return point at end of item, before any blank line.
  523. Point returned is at eol."
  524. (save-excursion
  525. (org-end-of-item)
  526. (skip-chars-backward " \r\t\n")
  527. (point-at-eol)))
  528. (defun org-get-next-item (pos limit)
  529. "Get the point of the next item at the same level as POS.
  530. Stop searching at LIMIT. Return nil if no item is found. This
  531. function does not move point."
  532. (org-list-get-item-same-level
  533. #'org-search-forward-unenclosed pos limit #'end-of-line))
  534. (defun org-get-previous-item (pos limit)
  535. "Get the point of the previous 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-backward-unenclosed pos limit #'beginning-of-line))
  540. (defun org-next-item ()
  541. "Move to the beginning of the next item.
  542. Item is at the same level in the current plain list. Error if not
  543. in a plain list, or if this is the last item in the list."
  544. (interactive)
  545. (let ((next-p (org-get-next-item (point) (org-list-bottom-point))))
  546. (if next-p
  547. (goto-char next-p)
  548. (error "On last item"))))
  549. (defun org-previous-item ()
  550. "Move to the beginning of the previous item.
  551. Item is at the same level in the current plain list. Error if not
  552. in a plain list, or if this is the first item in the list."
  553. (interactive)
  554. (let ((prev-p (org-get-previous-item (point) (org-list-top-point))))
  555. (if prev-p
  556. (goto-char prev-p)
  557. (error "On first item"))))
  558. (defun org-beginning-of-item-list ()
  559. "Go to the beginning item of the current list or sublist.
  560. Return point."
  561. (interactive)
  562. (org-beginning-of-item)
  563. (let ((limit (org-list-top-point))
  564. (move-up (lambda (pos bound)
  565. ;; prev-p: any item of same level before ?
  566. (let ((prev-p (org-get-previous-item pos bound)))
  567. ;; recurse until no more item of the same level
  568. ;; can be found.
  569. (if prev-p (funcall move-up prev-p bound) pos)))))
  570. ;; Go to the last item found and at bol in case we didn't move
  571. (goto-char (funcall move-up (point) limit))
  572. (goto-char (point-at-bol))))
  573. (defun org-end-of-item-list ()
  574. "Go to the end of the current list or sublist.
  575. Return point."
  576. (interactive)
  577. (org-beginning-of-item)
  578. (let ((limit (org-list-bottom-point))
  579. (ind (org-get-indentation))
  580. (get-last-item (lambda (pos bound)
  581. ;; next-p: any item of same level after ?
  582. (let ((next-p (org-get-next-item pos bound)))
  583. ;; recurse until no more item of the same level
  584. ;; can be found.
  585. (if next-p (funcall get-last-item next-p bound) pos)))))
  586. ;; Move to the last item of every list or sublist encountered, and
  587. ;; down to bol of a higher-level item, or limit.
  588. (while (and (/= (point) limit)
  589. (>= (org-get-indentation) ind))
  590. (goto-char (funcall get-last-item (point) limit))
  591. (end-of-line)
  592. (when (org-search-forward-unenclosed org-item-beginning-re limit 'move)
  593. (beginning-of-line)))
  594. (point)))
  595. ;;; Manipulate
  596. (defun org-list-exchange-items (beg-A beg-B)
  597. "Swap item starting at BEG-A with item starting at BEG-B.
  598. Blank lines at the end of items are left in place. Assumes
  599. BEG-A is lesser than BEG-B."
  600. (save-excursion
  601. (let* ((end-of-item-no-blank (lambda (pos)
  602. (goto-char pos)
  603. (goto-char (org-end-of-item-before-blank))))
  604. (end-A-no-blank (funcall end-of-item-no-blank beg-A))
  605. (end-B-no-blank (funcall end-of-item-no-blank beg-B))
  606. (body-A (buffer-substring beg-A end-A-no-blank))
  607. (body-B (buffer-substring beg-B end-B-no-blank))
  608. (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B)))
  609. (goto-char beg-A)
  610. (delete-region beg-A end-B-no-blank)
  611. (insert (concat body-B between-A-no-blank-and-B body-A)))))
  612. (defun org-move-item-down ()
  613. "Move the plain list item at point down, i.e. swap with following item.
  614. Subitems (items with larger indentation) are considered part of the item,
  615. so this really moves item trees."
  616. (interactive)
  617. (let ((pos (point))
  618. (col (current-column))
  619. (actual-item (org-beginning-of-item))
  620. (next-item (org-get-next-item (point) (save-excursion (org-end-of-item-list)))))
  621. (if (not next-item)
  622. (progn
  623. (goto-char pos)
  624. (error "Cannot move this item further down"))
  625. (org-list-exchange-items actual-item next-item)
  626. (org-maybe-renumber-ordered-list)
  627. (org-next-item)
  628. (move-to-column col))))
  629. (defun org-move-item-up ()
  630. "Move the plain list item at point up, i.e. swap with previous item.
  631. Subitems (items with larger indentation) are considered part of the item,
  632. so this really moves item trees."
  633. (interactive)
  634. (let ((pos (point))
  635. (col (current-column))
  636. (actual-item (org-beginning-of-item))
  637. (prev-item (org-get-previous-item (point) (save-excursion (org-beginning-of-item-list)))))
  638. (if (not prev-item)
  639. (progn
  640. (goto-char pos)
  641. (error "Cannot move this item further up"))
  642. (org-list-exchange-items prev-item actual-item)
  643. (org-maybe-renumber-ordered-list)
  644. (move-to-column col))))
  645. (defun org-insert-item (&optional checkbox)
  646. "Insert a new item at the current level.
  647. If cursor is before first character after bullet of the item, the
  648. new item will be created before the current one. Return t when
  649. things worked, nil when we are not in an item, or item is
  650. invisible."
  651. (unless (or (not (org-in-item-p))
  652. (org-invisible-p))
  653. (if (save-excursion
  654. (org-beginning-of-item)
  655. (org-at-item-timer-p))
  656. ;; Timer list: delegate to `org-timer-item'.
  657. (progn (org-timer-item) t)
  658. ;; if we're in a description list, ask for the new term.
  659. (let ((desc-text (when (save-excursion
  660. (and (org-beginning-of-item)
  661. (org-at-item-description-p)))
  662. (concat (read-string "Term: ") " :: "))))
  663. (org-list-insert-item-generic
  664. (point) (and checkbox (not desc-text)) desc-text)))))
  665. ;;; Indentation
  666. (defun org-get-string-indentation (s)
  667. "What indentation has S due to SPACE and TAB at the beginning of the string?"
  668. (let ((n -1) (i 0) (w tab-width) c)
  669. (catch 'exit
  670. (while (< (setq n (1+ n)) (length s))
  671. (setq c (aref s n))
  672. (cond ((= c ?\ ) (setq i (1+ i)))
  673. ((= c ?\t) (setq i (* (/ (+ w i) w) w)))
  674. (t (throw 'exit t)))))
  675. i))
  676. (defvar org-suppress-item-indentation) ; dynamically scoped parameter
  677. (defun org-shift-item-indentation (delta)
  678. "Shift the indentation in current item by DELTA."
  679. (unless (org-bound-and-true-p org-suppress-item-indentation)
  680. (save-excursion
  681. (let ((beg (point-at-bol))
  682. (end (org-end-of-item)))
  683. (beginning-of-line 0)
  684. (while (> (point) beg)
  685. (when (looking-at "[ \t]*\\S-")
  686. ;; this is not an empty line
  687. (let ((i (org-get-indentation)))
  688. (when (and (> i 0) (> (+ i delta) 0))
  689. (indent-line-to (+ i delta)))))
  690. (beginning-of-line 0))))))
  691. (defvar org-last-indent-begin-marker (make-marker))
  692. (defvar org-last-indent-end-marker (make-marker))
  693. (defun org-outdent-item (arg)
  694. "Outdent a local list item, but not its children."
  695. (interactive "p")
  696. (org-indent-item-tree (- arg) 'no-subtree))
  697. (defun org-indent-item (arg)
  698. "Indent a local list item, but not its children."
  699. (interactive "p")
  700. (org-indent-item-tree arg 'no-subtree))
  701. (defun org-outdent-item-tree (arg &optional no-subtree)
  702. "Outdent a local list item including its children.
  703. If NO-SUBTREE is set, only outdent the item itself, not its children."
  704. (interactive "p")
  705. (org-indent-item-tree (- arg) no-subtree))
  706. (defun org-indent-item-tree (arg &optional no-subtree)
  707. "Indent a local list item including its children.
  708. If NO-SUBTREE is set, only indent the item itself, not its
  709. children. Return t if sucessful."
  710. (interactive "p")
  711. (and (org-region-active-p) (org-cursor-to-region-beginning))
  712. (unless (org-at-item-p)
  713. (error "Not on an item"))
  714. (let ((line (org-current-line))
  715. (col (current-column))
  716. (pos (point))
  717. (origin-ind (save-excursion
  718. (goto-char (org-list-top-point))
  719. (org-get-indentation)))
  720. beg end ind ind1 ind-pos bullet delta ind-down ind-up)
  721. (setq end (and (org-region-active-p) (region-end)))
  722. ;; If moving a subtree, don't drag additional items on subsequent
  723. ;; moves.
  724. (if (and (memq last-command '(org-shiftmetaright org-shiftmetaleft))
  725. (memq this-command '(org-shiftmetaright org-shiftmetaleft)))
  726. (setq beg org-last-indent-begin-marker
  727. end org-last-indent-end-marker)
  728. (org-beginning-of-item)
  729. (setq beg (move-marker org-last-indent-begin-marker (point)))
  730. ;; Determine end point of indentation
  731. (if no-subtree (org-end-of-item-or-at-child) (org-end-of-item))
  732. (setq end (move-marker org-last-indent-end-marker (or end (point)))))
  733. ;; Get some information
  734. (goto-char beg)
  735. (setq ind-pos (org-item-indent-positions)
  736. bullet (cdr (car ind-pos))
  737. bul-up (cdr (nth 1 ind-pos))
  738. ind (caar ind-pos)
  739. ind-down (car (nth 2 ind-pos))
  740. ind-up (car (nth 1 ind-pos))
  741. delta (if (> arg 0)
  742. (if ind-down (- ind-down ind) 2)
  743. (if ind-up (- ind-up ind) -2)))
  744. ;; Make some checks before indenting.
  745. (cond
  746. ((< (+ delta ind) 0)
  747. (goto-char pos)
  748. (error "Cannot outdent beyond margin"))
  749. ;; Apply indent rules if activated.
  750. ((cdr (assq 'indent org-list-automatic-rules))
  751. (cond
  752. ;; 1. If at top-point move the whole list. Moreover, if
  753. ;; *-list is going to column 0, change bullet to "-".
  754. ((= (point-at-bol) (org-list-top-point))
  755. (when (and (= (+ delta ind) 0) (equal bullet "*"))
  756. (org-fix-bullet-type (setq bullet "-")))
  757. (setq end (set-marker org-last-indent-end-marker (org-list-bottom-point))))
  758. ;; 2. Do not indent before top-item.
  759. ((< (+ delta ind) origin-ind)
  760. (goto-char pos)
  761. (error "Cannot outdent beyond top level item"))
  762. ;; 3. Do not indent the first item of a list.
  763. ((and (org-list-first-item-p) (> delta 0))
  764. (goto-char pos)
  765. (error "Cannot indent the beginning of a sublist"))
  766. ;; 4. Do not outdent item that has children without moving.
  767. ;; In the case of a subtree, make sure the check applies to
  768. ;; its last item.
  769. ((and (< delta 0)
  770. (save-excursion (goto-char (1- end)) (org-item-has-child-p)))
  771. (goto-char pos)
  772. (error "Cannot outdent an item having children")))))
  773. ;; Replace bullet of current item with the bullet it is going to
  774. ;; have if we're outdenting. This is needed to prevent indentation
  775. ;; problems of subtrees when outdenting changes bullet size.
  776. (when (< delta 0)
  777. (let ((new-bul (org-list-bullet-string (or bul-up bullet))))
  778. (org-list-replace-bullet new-bul)))
  779. ;; Proceed to reindentation.
  780. (while (< (point) end)
  781. (beginning-of-line)
  782. (skip-chars-forward " \t") (setq ind1 (current-column))
  783. (delete-region (point-at-bol) (point))
  784. (or (eolp) (org-indent-to-column (+ ind1 delta)))
  785. (beginning-of-line 2))
  786. ;; Get back to original position, shifted by delta
  787. (goto-line line)
  788. (move-to-column (max (+ delta col) 0))
  789. ;; Fix and reorder all lists and sublists from parent of the list
  790. ;; at point, or from list at point if it hasn't got any parent or
  791. ;; if we're outdenting.
  792. (save-excursion
  793. ;; Take care of parent list, if it makes sense.
  794. (org-beginning-of-item-list)
  795. (unless (or (< arg 0) (= (org-list-top-point) (point)))
  796. (beginning-of-line 0)
  797. (org-beginning-of-item)
  798. (org-fix-bullet-type)))
  799. ;; Take care of list at point. If demoting, look at
  800. ;; `org-list-demote-modify-bullet'.
  801. (org-fix-bullet-type
  802. (and (> arg 0)
  803. (cdr (assoc bullet org-list-demote-modify-bullet))))
  804. (save-excursion
  805. (when (org-item-has-child-p)
  806. ;; Take care of child, or of every sublist if we're moving a
  807. ;; subtree.
  808. (org-end-of-item-or-at-child)
  809. (if no-subtree
  810. (org-fix-bullet-type)
  811. (let ((fix-list (lambda (i)
  812. (when (org-list-first-item-p)
  813. (org-fix-bullet-type
  814. (and (> arg 0)
  815. (cdr (assoc (org-get-bullet) org-list-demote-modify-bullet)))))
  816. (when (org-item-has-child-p)
  817. (org-end-of-item-or-at-child)
  818. (org-apply-on-list fix-list nil)))))
  819. (org-apply-on-list fix-list nil))))))
  820. t)
  821. (defun org-item-indent-positions ()
  822. "Return indentation for plain list items.
  823. This returns a list with three values: The current indentation, the
  824. parent indentation and the indentation a child should have.
  825. Assumes cursor in item line."
  826. (let* ((bolpos (point-at-bol))
  827. (ind (org-get-indentation))
  828. (bullet (org-get-bullet))
  829. ind-down ind-up bullet-up bullet-down pos)
  830. (save-excursion
  831. (org-beginning-of-item-list)
  832. (skip-chars-backward "\n\r \t")
  833. (when (org-in-item-p)
  834. (org-beginning-of-item)
  835. (let ((prev-indent (org-get-indentation)))
  836. (when (< prev-indent ind)
  837. (setq ind-up prev-indent)
  838. (setq bullet-up (org-get-bullet))))))
  839. (setq pos (point))
  840. (save-excursion
  841. (cond
  842. ((and (ignore-errors (progn (org-previous-item) t))
  843. (or (end-of-line) t)
  844. (org-search-forward-unenclosed org-item-beginning-re bolpos t))
  845. (setq ind-down (org-get-indentation)
  846. bullet-down (org-get-bullet)))
  847. ((and (goto-char pos)
  848. (org-at-item-p))
  849. (goto-char (match-end 0))
  850. (skip-chars-forward " \t")
  851. (setq ind-down (current-column)
  852. bullet-down (org-get-bullet)))))
  853. (if (and bullet-down (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet-down))
  854. (setq bullet-down (concat "1" (match-string 1 bullet-down))))
  855. (if (and bullet-up (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet-up))
  856. (setq bullet-up (concat "1" (match-string 1 bullet-up))))
  857. (if (and bullet (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet))
  858. (setq bullet (concat "1" (match-string 1 bullet))))
  859. (list (cons ind bullet)
  860. (cons ind-up bullet-up)
  861. (cons ind-down bullet-down))))
  862. (defvar org-tab-ind-state) ; defined in org.el
  863. (defun org-cycle-item-indentation ()
  864. (let ((org-suppress-item-indentation t)
  865. (org-adapt-indentation nil))
  866. (when (and (or (org-at-item-description-p) (org-at-item-checkbox-p) (org-at-item-p))
  867. (>= (match-end 0) (save-excursion
  868. (org-end-of-item-or-at-child)
  869. (skip-chars-backward " \r\t\n")
  870. (point))))
  871. (setq this-command 'org-cycle-item-indentation)
  872. ;; When in the middle of the cycle, try to outdent first. If it
  873. ;; fails, and point is still at initial position, indent. Else,
  874. ;; go back to original position.
  875. (if (eq last-command 'org-cycle-item-indentation)
  876. (cond
  877. ((ignore-errors (org-indent-item -1)))
  878. ((and (= (org-get-indentation) org-tab-ind-state)
  879. (ignore-errors (org-indent-item 1))))
  880. (t (back-to-indentation)
  881. (org-indent-to-column org-tab-ind-state)
  882. (end-of-line)
  883. (org-fix-bullet-type)
  884. ;; Break cycle
  885. (setq this-command 'identity)))
  886. ;; If a cycle has just started, try to indent first. If it
  887. ;; fails, try to outdent.
  888. (setq org-tab-ind-state (org-get-indentation))
  889. (cond
  890. ((ignore-errors (org-indent-item 1)))
  891. ((ignore-errors (org-indent-item -1)))
  892. (t (error "Cannot move item"))))
  893. t)))
  894. ;;; Bullets
  895. (defun org-get-bullet ()
  896. (and (org-at-item-p)
  897. (org-trim (match-string 1))))
  898. (defun org-list-bullet-string (bullet)
  899. "Concatenate BULLET with an appropriate number of whitespaces.
  900. It determines the number of whitespaces to append by looking at
  901. `org-list-two-spaces-after-bullet-regexp'."
  902. (concat
  903. bullet " "
  904. ;; Do we need to concat another white space ?
  905. (when (string-match org-list-two-spaces-after-bullet-regexp bullet) " ")))
  906. (defun org-list-replace-bullet (new-bullet)
  907. "Replace current item's bullet with NEW-BULLET.
  908. Assume point is at item. Indent body if needed."
  909. (save-excursion
  910. (let ((old (progn
  911. (looking-at "[ \t]*\\(\\S-+[ \t]*\\)")
  912. (match-string 1))))
  913. (unless (equal new-bullet old)
  914. (replace-match new-bullet nil nil nil 1)
  915. ;; When bullet lengths are differents, move the whole
  916. ;; sublist accordingly
  917. (org-shift-item-indentation (- (length new-bullet) (length old)))))))
  918. (defun org-fix-bullet-type (&optional force-bullet)
  919. "Make sure all items in this list have the same bullet as the first item.
  920. Also, fix the indentation."
  921. (interactive)
  922. (unless (org-at-item-p) (error "This is not a list"))
  923. (org-preserve-lc
  924. (let* ((ini-bul (progn (org-beginning-of-item-list) (org-get-bullet)))
  925. (bullet (org-list-bullet-string (or force-bullet ini-bul)))
  926. (replace-bullet
  927. (lambda (result bullet)
  928. (org-list-replace-bullet bullet))))
  929. (org-apply-on-list replace-bullet nil bullet)
  930. (org-maybe-renumber-ordered-list))))
  931. (defun org-renumber-ordered-list (&optional arg)
  932. "Renumber an ordered plain list.
  933. Cursor needs to be in the first line of an item, the line that starts
  934. with something like \"1.\" or \"2)\". Start to count at ARG or 1."
  935. (interactive "p")
  936. (unless (and (org-at-item-p)
  937. (match-beginning 3))
  938. (error "This is not an ordered list"))
  939. (org-preserve-lc
  940. (let* ((offset (progn
  941. (org-beginning-of-item)
  942. (or (and (looking-at "[ \t]*\\[@start:\\([0-9]+\\)")
  943. (string-to-number (match-string 1)))
  944. arg
  945. 1)))
  946. (item-fmt (progn
  947. (looking-at "[ \t]*[0-9]+\\([.)]\\)")
  948. (concat "%d" (or (match-string 1) "."))))
  949. ;; Here is the function applied at each item of the list.
  950. (renumber-item (lambda (counter off fmt)
  951. (let* ((new (format fmt (+ counter off)))
  952. (old (progn
  953. (looking-at org-item-beginning-re)
  954. (match-string 2)))
  955. (begin (match-beginning 2))
  956. (end (match-end 2)))
  957. (delete-region begin end)
  958. (goto-char begin)
  959. (insert new)
  960. ;; In case item number went from 9. to 10.
  961. ;; or the other way.
  962. (org-shift-item-indentation (- (length new) (length old)))
  963. (1+ counter)))))
  964. (org-apply-on-list renumber-item 0 offset item-fmt))))
  965. (defun org-maybe-renumber-ordered-list ()
  966. "Renumber the ordered list at point if setup allows it.
  967. This tests the if 'renumber rule is set in
  968. `org-list-automatic-rules' before doing the renumbering.
  969. Do not throw error on failure."
  970. (interactive)
  971. (when (cdr (assq 'renumber org-list-automatic-rules))
  972. (ignore-errors (org-renumber-ordered-list))))
  973. (defun org-cycle-list-bullet (&optional which)
  974. "Cycle through the different itemize/enumerate bullets.
  975. This cycle the entire list level through the sequence:
  976. `-' -> `+' -> `*' -> `1.' -> `1)'
  977. If WHICH is a valid string, use that as the new bullet. If WHICH
  978. is an integer, 0 means `-', 1 means `+' etc. If WHICH is
  979. 'previous, cycle backwards."
  980. (interactive "P")
  981. (org-preserve-lc
  982. (let* ((bullet (progn (org-beginning-of-item-list)
  983. (org-get-bullet)))
  984. (current (cond
  985. ((string-match "\\." bullet) "1.")
  986. ((string-match ")" bullet) "1)")
  987. (t bullet)))
  988. (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules)))
  989. (bullet-list (append '("-" "+" )
  990. ;; *-bullets are not allowed at column 0
  991. (unless (and bullet-rule-p
  992. (looking-at "\\S-")) '("*"))
  993. ;; Description items cannot be numbered
  994. (unless (and bullet-rule-p
  995. (or (eq org-plain-list-ordered-item-terminator ?.)
  996. (org-at-item-description-p))) '("1)"))
  997. (unless (and bullet-rule-p
  998. (or (eq org-plain-list-ordered-item-terminator ?\))
  999. (org-at-item-description-p))) '("1."))))
  1000. (len (length bullet-list))
  1001. (item-index (- len (length (member current bullet-list))))
  1002. (get-value (lambda (index) (nth (mod index len) bullet-list)))
  1003. (new (cond
  1004. ((member which bullet-list) which)
  1005. ((numberp which) (funcall get-value which))
  1006. ((eq 'previous which) (funcall get-value (1- item-index)))
  1007. (t (funcall get-value (1+ item-index))))))
  1008. (org-fix-bullet-type new))))
  1009. ;;; Checkboxes
  1010. (defun org-toggle-checkbox (&optional toggle-presence)
  1011. "Toggle the checkbox in the current line.
  1012. With prefix arg TOGGLE-PRESENCE, add or remove checkboxes.
  1013. With double prefix, set checkbox to [-].
  1014. When there is an active region, toggle status or presence of the checkbox
  1015. in the first line, and make every item in the region have the same
  1016. status or presence, respectively.
  1017. If the cursor is in a headline, apply this to all checkbox items in the
  1018. text below the heading."
  1019. (interactive "P")
  1020. (catch 'exit
  1021. (let (beg end status first-present first-status blocked)
  1022. (cond
  1023. ((org-region-active-p)
  1024. (setq beg (region-beginning) end (region-end)))
  1025. ((org-on-heading-p)
  1026. (setq beg (point) end (save-excursion (outline-next-heading) (point))))
  1027. ((org-at-item-checkbox-p)
  1028. (save-excursion
  1029. (if (equal toggle-presence '(4))
  1030. (progn
  1031. (replace-match "" nil nil nil 1)
  1032. (goto-char (match-beginning 0))
  1033. (just-one-space))
  1034. (when (setq blocked (org-checkbox-blocked-p))
  1035. (error "Checkbox blocked because of unchecked box in line %d"
  1036. blocked))
  1037. (replace-match
  1038. (cond ((equal toggle-presence '(16)) "[-]")
  1039. ((member (match-string 1) '("[ ]" "[-]")) "[X]")
  1040. (t "[ ]"))
  1041. t t nil 1)))
  1042. (throw 'exit t))
  1043. ((org-at-item-p)
  1044. ;; add a checkbox if point is not at a description item
  1045. (save-excursion
  1046. (goto-char (match-end 0))
  1047. (if (org-at-item-description-p)
  1048. (error "Cannot add a checkbox in a description list")
  1049. (insert "[ ] ")))
  1050. (throw 'exit t))
  1051. (t (error "Not at a checkbox or heading, and no active region")))
  1052. (setq end (move-marker (make-marker) end))
  1053. (save-excursion
  1054. (goto-char beg)
  1055. (setq first-present (org-at-item-checkbox-p)
  1056. first-status
  1057. (save-excursion
  1058. (and (org-search-forward-unenclosed "[ \t]\\(\\[[ X]\\]\\)" end t)
  1059. (equal (match-string 0) "[X]"))))
  1060. (while (< (point) end)
  1061. (if toggle-presence
  1062. (cond
  1063. ((and first-present (org-at-item-checkbox-p))
  1064. (save-excursion
  1065. (replace-match "")
  1066. (goto-char (match-beginning 0))
  1067. (just-one-space)))
  1068. ((and (not first-present) (not (org-at-item-checkbox-p))
  1069. (org-at-item-p))
  1070. (save-excursion
  1071. (goto-char (match-end 0))
  1072. (insert "[ ] "))))
  1073. (when (org-at-item-checkbox-p)
  1074. (setq status (equal (match-string 1) "[X]"))
  1075. (replace-match
  1076. (if first-status "[ ]" "[X]") t t nil 1)))
  1077. (beginning-of-line 2)))))
  1078. (org-update-checkbox-count-maybe))
  1079. (defun org-reset-checkbox-state-subtree ()
  1080. "Reset all checkboxes in an entry subtree."
  1081. (interactive "*")
  1082. (save-restriction
  1083. (save-excursion
  1084. (org-narrow-to-subtree)
  1085. (org-show-subtree)
  1086. (goto-char (point-min))
  1087. (let ((end (point-max)))
  1088. (while (< (point) end)
  1089. (when (org-at-item-checkbox-p)
  1090. (replace-match "[ ]" t t nil 1))
  1091. (beginning-of-line 2))))
  1092. (org-update-checkbox-count-maybe)))
  1093. (defvar org-checkbox-statistics-hook nil
  1094. "Hook that is run whenever Org thinks checkbox statistics should be updated.
  1095. This hook runs even if 'checkbox rules in
  1096. `org-list-automatic-rules' do not apply, so it can be used to
  1097. implement alternative ways of collecting statistics
  1098. information.")
  1099. (defun org-update-checkbox-count-maybe ()
  1100. "Update checkbox statistics unless turned off by user."
  1101. (when (cdr (assq 'checkbox org-list-automatic-rules))
  1102. (org-update-checkbox-count))
  1103. (run-hooks 'org-checkbox-statistics-hook))
  1104. (defun org-update-checkbox-count (&optional all)
  1105. "Update the checkbox statistics in the current section.
  1106. This will find all statistic cookies like [57%] and [6/12] and update them
  1107. with the current numbers. With optional prefix argument ALL, do this for
  1108. the whole buffer."
  1109. (interactive "P")
  1110. (save-excursion
  1111. (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21
  1112. (beg (condition-case nil
  1113. (progn (org-back-to-heading) (point))
  1114. (error (point-min))))
  1115. (end (move-marker (make-marker)
  1116. (progn (outline-next-heading) (point))))
  1117. (re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
  1118. (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)")
  1119. (re-find (concat re "\\|" re-box))
  1120. beg-cookie end-cookie is-percent c-on c-off lim new
  1121. eline curr-ind next-ind continue-from startsearch
  1122. (recursive
  1123. (or (not org-hierarchical-checkbox-statistics)
  1124. (string-match "\\<recursive\\>"
  1125. (or (ignore-errors
  1126. (org-entry-get nil "COOKIE_DATA"))
  1127. ""))))
  1128. (cstat 0)
  1129. )
  1130. (when all
  1131. (goto-char (point-min))
  1132. (outline-next-heading)
  1133. (setq beg (point) end (point-max)))
  1134. (goto-char end)
  1135. ;; find each statistics cookie
  1136. (while (and (org-search-backward-unenclosed re-find beg t)
  1137. (not (save-match-data
  1138. (and (org-on-heading-p)
  1139. (string-match "\\<todo\\>"
  1140. (downcase
  1141. (or (org-entry-get
  1142. nil "COOKIE_DATA")
  1143. "")))))))
  1144. (setq beg-cookie (match-beginning 1)
  1145. end-cookie (match-end 1)
  1146. cstat (+ cstat (if end-cookie 1 0))
  1147. startsearch (point-at-eol)
  1148. continue-from (match-beginning 0)
  1149. is-percent (match-beginning 2)
  1150. lim (cond
  1151. ((org-on-heading-p) (outline-next-heading) (point))
  1152. ((org-at-item-p) (org-end-of-item) (point))
  1153. (t nil))
  1154. c-on 0
  1155. c-off 0)
  1156. (when lim
  1157. ;; find first checkbox for this cookie and gather
  1158. ;; statistics from all that are at this indentation level
  1159. (goto-char startsearch)
  1160. (if (org-search-forward-unenclosed re-box lim t)
  1161. (progn
  1162. (org-beginning-of-item)
  1163. (setq curr-ind (org-get-indentation))
  1164. (setq next-ind curr-ind)
  1165. (while (and (bolp) (org-at-item-p)
  1166. (if recursive
  1167. (<= curr-ind next-ind)
  1168. (= curr-ind next-ind)))
  1169. (setq eline (point-at-eol))
  1170. (if (org-search-forward-unenclosed re-box eline t)
  1171. (if (member (match-string 2) '("[ ]" "[-]"))
  1172. (setq c-off (1+ c-off))
  1173. (setq c-on (1+ c-on))))
  1174. (if (not recursive)
  1175. ;; org-get-next-item goes through list-enders
  1176. ;; with proper limit.
  1177. (goto-char (or (org-get-next-item (point) lim) lim))
  1178. (end-of-line)
  1179. (when (org-search-forward-unenclosed org-item-beginning-re lim t)
  1180. (beginning-of-line)))
  1181. (setq next-ind (org-get-indentation)))))
  1182. (goto-char continue-from)
  1183. ;; update cookie
  1184. (when end-cookie
  1185. (setq new (if is-percent
  1186. (format "[%d%%]" (/ (* 100 c-on) (max 1 (+ c-on c-off))))
  1187. (format "[%d/%d]" c-on (+ c-on c-off))))
  1188. (goto-char beg-cookie)
  1189. (insert new)
  1190. (delete-region (point) (+ (point) (- end-cookie beg-cookie))))
  1191. ;; update items checkbox if it has one
  1192. (when (org-at-item-p)
  1193. (org-beginning-of-item)
  1194. (when (and (> (+ c-on c-off) 0)
  1195. (org-search-forward-unenclosed re-box (point-at-eol) t))
  1196. (setq beg-cookie (match-beginning 2)
  1197. end-cookie (match-end 2))
  1198. (delete-region beg-cookie end-cookie)
  1199. (goto-char beg-cookie)
  1200. (cond ((= c-off 0) (insert "[X]"))
  1201. ((= c-on 0) (insert "[ ]"))
  1202. (t (insert "[-]")))
  1203. )))
  1204. (goto-char continue-from))
  1205. (when (interactive-p)
  1206. (message "Checkbox statistics updated %s (%d places)"
  1207. (if all "in entire file" "in current outline entry") cstat)))))
  1208. (defun org-get-checkbox-statistics-face ()
  1209. "Select the face for checkbox statistics.
  1210. The face will be `org-done' when all relevant boxes are checked.
  1211. Otherwise it will be `org-todo'."
  1212. (if (match-end 1)
  1213. (if (equal (match-string 1) "100%")
  1214. 'org-checkbox-statistics-done
  1215. 'org-checkbox-statistics-todo)
  1216. (if (and (> (match-end 2) (match-beginning 2))
  1217. (equal (match-string 2) (match-string 3)))
  1218. 'org-checkbox-statistics-done
  1219. 'org-checkbox-statistics-todo)))
  1220. ;;; Misc Tools
  1221. (defun org-apply-on-list (function init-value &rest args)
  1222. "Call FUNCTION for each item of a the list under point.
  1223. FUNCTION must be called with at least one argument : a return
  1224. value that will contain the value returned by the function at
  1225. the previous item, plus ARGS extra arguments. INIT-VALUE will be
  1226. the value passed to the function at the first item of the list.
  1227. As an example, (org-apply-on-list (lambda (result) (1+ result)) 0)
  1228. will return the number of items in the current list.
  1229. Sublists of the list are skipped. Cursor is always at the
  1230. beginning of the item."
  1231. (save-excursion
  1232. (let ((end (copy-marker (save-excursion (org-end-of-item-list))))
  1233. (next-p (make-marker))
  1234. (move-down-action
  1235. (lambda (pos value &rest args)
  1236. (goto-char pos)
  1237. (set-marker next-p (org-get-next-item pos end))
  1238. (let ((return-value (apply function value args)))
  1239. (if (marker-position next-p)
  1240. (apply move-down-action next-p return-value args)
  1241. return-value)))))
  1242. (apply move-down-action (org-beginning-of-item-list) init-value args))))
  1243. (defun org-sort-list (&optional with-case sorting-type getkey-func compare-func)
  1244. "Sort plain list items.
  1245. The cursor may be at any item of the list that should be sorted.
  1246. Sublists are not sorted. Checkboxes, if any, are ignored.
  1247. Sorting can be alphabetically, numerically, by date/time as given by
  1248. a time stamp, by a property or by priority.
  1249. The command prompts for the sorting type unless it has been given
  1250. to the function through the SORTING-TYPE argument, which needs to
  1251. be a character, \(?n ?N ?a ?A ?t ?T ?f ?F). Here is the precise
  1252. meaning of each character:
  1253. n Numerically, by converting the beginning of the item to a number.
  1254. a Alphabetically.
  1255. t By date/time, either the first active time stamp in the entry, if
  1256. any, or by the first inactive one. In a timer list, sorts the timers.
  1257. Only the first line of item is checked.
  1258. Capital letters will reverse the sort order.
  1259. If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a
  1260. function to be called with point at the beginning of the record.
  1261. It must return either a string or a number that should serve as
  1262. the sorting key for that record.
  1263. Comparing entries ignores case by default. However, with an
  1264. optional argument WITH-CASE, the sorting considers case as well."
  1265. (interactive "P")
  1266. (let* ((case-func (if with-case 'identity 'downcase))
  1267. (start (org-beginning-of-item-list))
  1268. (end (save-excursion (org-end-of-item-list)))
  1269. (sorting-type
  1270. (progn
  1271. (message
  1272. "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:")
  1273. (read-char-exclusive)))
  1274. (getkey-func (and (= (downcase sorting-type) ?f)
  1275. (org-icompleting-read "Sort using function: "
  1276. obarray 'fboundp t nil nil)
  1277. (intern getkey-func))))
  1278. (message "Sorting items...")
  1279. (save-restriction
  1280. (narrow-to-region start end)
  1281. (let* ((dcst (downcase sorting-type))
  1282. (case-fold-search nil)
  1283. (now (current-time))
  1284. (sort-func (cond
  1285. ((= dcst ?a) 'string<)
  1286. ((= dcst ?f) compare-func)
  1287. ((= dcst ?t) '<)
  1288. (t nil)))
  1289. (begin-record (lambda ()
  1290. (skip-chars-forward " \r\t\n")
  1291. (beginning-of-line)))
  1292. (end-record (lambda ()
  1293. (goto-char (org-end-of-item-before-blank))))
  1294. (value-to-sort
  1295. (lambda ()
  1296. (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+")
  1297. (cond
  1298. ((= dcst ?n)
  1299. (string-to-number (buffer-substring (match-end 0)
  1300. (point-at-eol))))
  1301. ((= dcst ?a)
  1302. (buffer-substring (match-end 0) (point-at-eol)))
  1303. ((= dcst ?t)
  1304. (cond
  1305. ;; If it is a timer list, convert timer to seconds
  1306. ((org-at-item-timer-p)
  1307. (org-timer-hms-to-secs (match-string 1)))
  1308. ((or (org-search-forward-unenclosed org-ts-regexp
  1309. (point-at-eol) t)
  1310. (org-search-forward-unenclosed org-ts-regexp-both
  1311. (point-at-eol) t))
  1312. (org-time-string-to-seconds (match-string 0)))
  1313. (t (org-float-time now))))
  1314. ((= dcst ?f)
  1315. (if getkey-func
  1316. (let ((value (funcall getkey-func)))
  1317. (if (stringp value)
  1318. (funcall case-func value)
  1319. value))
  1320. (error "Invalid key function `%s'" getkey-func)))
  1321. (t (error "Invalid sorting type `%c'" sorting-type)))))))
  1322. (sort-subr (/= dcst sorting-type) begin-record end-record value-to-sort nil sort-func)
  1323. (org-maybe-renumber-ordered-list)
  1324. (run-hooks 'org-after-sorting-entries-or-items-hook)
  1325. (message "Sorting items...done")))))
  1326. ;;; Send and receive lists
  1327. (defun org-list-parse-list (&optional delete)
  1328. "Parse the list at point and maybe DELETE it.
  1329. Return a list containing first level items as strings and
  1330. sublevels as a list of strings."
  1331. (let* ((start (goto-char (org-list-top-point)))
  1332. (end (org-list-bottom-point))
  1333. output itemsep ltype)
  1334. (while (org-search-forward-unenclosed org-item-beginning-re end t)
  1335. (save-excursion
  1336. (beginning-of-line)
  1337. (setq ltype (cond ((looking-at-p "^[ \t]*[0-9]") 'ordered)
  1338. ((org-at-item-description-p) 'descriptive)
  1339. (t 'unordered))))
  1340. (let* ((indent1 (org-get-indentation))
  1341. (nextitem (or (org-get-next-item (point) end) end))
  1342. (item (org-trim (buffer-substring (point) (org-end-of-item-or-at-child))))
  1343. (nextindent (if (= (point) end) 0 (org-get-indentation)))
  1344. (item (if (string-match "^\\[\\([xX ]\\)\\]" item)
  1345. (replace-match (if (equal (match-string 1 item) " ")
  1346. "[CBOFF]"
  1347. "[CBON]")
  1348. t nil item)
  1349. item)))
  1350. (push item output)
  1351. (when (> nextindent indent1)
  1352. (save-restriction
  1353. (narrow-to-region (point) nextitem)
  1354. (push (org-list-parse-list) output)))))
  1355. (when delete
  1356. (delete-region start end)
  1357. (save-match-data
  1358. (when (looking-at (org-list-end-re))
  1359. (replace-match "\n"))))
  1360. (setq output (nreverse output))
  1361. (push ltype output)))
  1362. (defun org-list-make-subtree ()
  1363. "Convert the plain list at point into a subtree."
  1364. (interactive)
  1365. (if (not (org-in-item-p))
  1366. (error "Not in a list.")
  1367. (goto-char (org-list-top-point))
  1368. (let ((list (org-list-parse-list t)) nstars)
  1369. (save-excursion
  1370. (if (ignore-errors
  1371. (org-back-to-heading))
  1372. (progn (org-search-forward-unenclosed org-complex-heading-regexp nil t)
  1373. (setq nstars (length (match-string 1))))
  1374. (setq nstars 0)))
  1375. (org-list-make-subtrees list (1+ nstars)))))
  1376. (defun org-list-make-subtrees (list level)
  1377. "Convert LIST into subtrees starting at LEVEL."
  1378. (if (symbolp (car list))
  1379. (org-list-make-subtrees (cdr list) level)
  1380. (mapcar (lambda (item)
  1381. (if (stringp item)
  1382. (insert (make-string
  1383. (if org-odd-levels-only
  1384. (1- (* 2 level)) level) ?*) " " item "\n")
  1385. (org-list-make-subtrees item (1+ level))))
  1386. list)))
  1387. (defun org-list-insert-radio-list ()
  1388. "Insert a radio list template appropriate for this major mode."
  1389. (interactive)
  1390. (let* ((e (assq major-mode org-list-radio-list-templates))
  1391. (txt (nth 1 e))
  1392. name pos)
  1393. (unless e (error "No radio list setup defined for %s" major-mode))
  1394. (setq name (read-string "List name: "))
  1395. (while (string-match "%n" txt)
  1396. (setq txt (replace-match name t t txt)))
  1397. (or (bolp) (insert "\n"))
  1398. (setq pos (point))
  1399. (insert txt)
  1400. (goto-char pos)))
  1401. (defun org-list-send-list (&optional maybe)
  1402. "Send a transformed version of this list to the receiver position.
  1403. With argument MAYBE, fail quietly if no transformation is defined for
  1404. this list."
  1405. (interactive)
  1406. (catch 'exit
  1407. (unless (org-at-item-p) (error "Not at a list"))
  1408. (save-excursion
  1409. (re-search-backward "#\\+ORGLST" nil t)
  1410. (unless (looking-at "[ \t]*#\\+ORGLST[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?")
  1411. (if maybe
  1412. (throw 'exit nil)
  1413. (error "Don't know how to transform this list"))))
  1414. (let* ((name (match-string 1))
  1415. (transform (intern (match-string 2)))
  1416. (bottom-point
  1417. (save-excursion
  1418. (re-search-forward "\\(\\\\end{comment}\\|@end ignore\\|-->\\)" nil t)
  1419. (match-beginning 0)))
  1420. (top-point
  1421. (progn
  1422. (re-search-backward "#\\+ORGLST" nil t)
  1423. (re-search-forward org-item-beginning-re bottom-point t)
  1424. (match-beginning 0)))
  1425. (list (save-restriction
  1426. (narrow-to-region top-point bottom-point)
  1427. (org-list-parse-list)))
  1428. beg txt)
  1429. (unless (fboundp transform)
  1430. (error "No such transformation function %s" transform))
  1431. (let ((txt (funcall transform list)))
  1432. ;; Find the insertion place
  1433. (save-excursion
  1434. (goto-char (point-min))
  1435. (unless (re-search-forward
  1436. (concat "BEGIN RECEIVE ORGLST +" name "\\([ \t]\\|$\\)") nil t)
  1437. (error "Don't know where to insert translated list"))
  1438. (goto-char (match-beginning 0))
  1439. (beginning-of-line 2)
  1440. (setq beg (point))
  1441. (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t)
  1442. (error "Cannot find end of insertion region"))
  1443. (delete-region beg (point-at-bol))
  1444. (goto-char beg)
  1445. (insert txt "\n")))
  1446. (message "List converted and installed at receiver location"))))
  1447. (defun org-list-to-generic (list params)
  1448. "Convert a LIST parsed through `org-list-parse-list' to other formats.
  1449. Valid parameters PARAMS are
  1450. :ustart String to start an unordered list
  1451. :uend String to end an unordered list
  1452. :ostart String to start an ordered list
  1453. :oend String to end an ordered list
  1454. :dstart String to start a descriptive list
  1455. :dend String to end a descriptive list
  1456. :dtstart String to start a descriptive term
  1457. :dtend String to end a descriptive term
  1458. :ddstart String to start a description
  1459. :ddend String to end a description
  1460. :splice When set to t, return only list body lines, don't wrap
  1461. them into :[u/o]start and :[u/o]end. Default is nil.
  1462. :istart String to start a list item
  1463. :iend String to end a list item
  1464. :isep String to separate items
  1465. :lsep String to separate sublists
  1466. :cboff String to insert for an unchecked checkbox
  1467. :cbon String to insert for a checked checkbox"
  1468. (interactive)
  1469. (let* ((p params) sublist
  1470. (splicep (plist-get p :splice))
  1471. (ostart (plist-get p :ostart))
  1472. (oend (plist-get p :oend))
  1473. (ustart (plist-get p :ustart))
  1474. (uend (plist-get p :uend))
  1475. (dstart (plist-get p :dstart))
  1476. (dend (plist-get p :dend))
  1477. (dtstart (plist-get p :dtstart))
  1478. (dtend (plist-get p :dtend))
  1479. (ddstart (plist-get p :ddstart))
  1480. (ddend (plist-get p :ddend))
  1481. (istart (plist-get p :istart))
  1482. (iend (plist-get p :iend))
  1483. (isep (plist-get p :isep))
  1484. (lsep (plist-get p :lsep))
  1485. (cbon (plist-get p :cbon))
  1486. (cboff (plist-get p :cboff)))
  1487. (let ((wrapper
  1488. (cond ((eq (car list) 'ordered)
  1489. (concat ostart "\n%s" oend "\n"))
  1490. ((eq (car list) 'unordered)
  1491. (concat ustart "\n%s" uend "\n"))
  1492. ((eq (car list) 'descriptive)
  1493. (concat dstart "\n%s" dend "\n"))))
  1494. rtn term defstart defend)
  1495. (while (setq sublist (pop list))
  1496. (cond ((symbolp sublist) nil)
  1497. ((stringp sublist)
  1498. (when (string-match "^\\(\\S-+\\)[ \t]+::" sublist)
  1499. (setq term (org-trim (format (concat dtstart "%s" dtend)
  1500. (match-string 1 sublist))))
  1501. (setq sublist (concat ddstart
  1502. (org-trim (substring sublist (match-end 0)))
  1503. ddend)))
  1504. (if (string-match "\\[CBON\\]" sublist)
  1505. (setq sublist (replace-match cbon t t sublist)))
  1506. (if (string-match "\\[CBOFF\\]" sublist)
  1507. (setq sublist (replace-match cboff t t sublist)))
  1508. (if (string-match "\\[-\\]" sublist)
  1509. (setq sublist (replace-match "$\\boxminus$" t t sublist)))
  1510. (setq rtn (concat rtn istart term sublist iend isep)))
  1511. (t (setq rtn (concat rtn ;; previous list
  1512. lsep ;; list separator
  1513. (org-list-to-generic sublist p)
  1514. lsep ;; list separator
  1515. )))))
  1516. (format wrapper rtn))))
  1517. (defun org-list-to-latex (list &optional params)
  1518. "Convert LIST into a LaTeX list.
  1519. LIST is as returned by `org-list-parse-list'. PARAMS is a property list
  1520. with overruling parameters for `org-list-to-generic'."
  1521. (org-list-to-generic
  1522. list
  1523. (org-combine-plists
  1524. '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}"
  1525. :ustart "\\begin{itemize}" :uend "\\end{itemize}"
  1526. :dstart "\\begin{description}" :dend "\\end{description}"
  1527. :dtstart "[" :dtend "]"
  1528. :ddstart "" :ddend ""
  1529. :istart "\\item " :iend ""
  1530. :isep "\n" :lsep "\n"
  1531. :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}")
  1532. params)))
  1533. (defun org-list-to-html (list &optional params)
  1534. "Convert LIST into a HTML list.
  1535. LIST is as returned by `org-list-parse-list'. PARAMS is a property list
  1536. with overruling parameters for `org-list-to-generic'."
  1537. (org-list-to-generic
  1538. list
  1539. (org-combine-plists
  1540. '(:splicep nil :ostart "<ol>" :oend "</ol>"
  1541. :ustart "<ul>" :uend "</ul>"
  1542. :dstart "<dl>" :dend "</dl>"
  1543. :dtstart "<dt>" :dtend "</dt>"
  1544. :ddstart "<dd>" :ddend "</dd>"
  1545. :istart "<li>" :iend "</li>"
  1546. :isep "\n" :lsep "\n"
  1547. :cbon "<code>[X]</code>" :cboff "<code>[ ]</code>")
  1548. params)))
  1549. (defun org-list-to-texinfo (list &optional params)
  1550. "Convert LIST into a Texinfo list.
  1551. LIST is as returned by `org-list-parse-list'. PARAMS is a property list
  1552. with overruling parameters for `org-list-to-generic'."
  1553. (org-list-to-generic
  1554. list
  1555. (org-combine-plists
  1556. '(:splicep nil :ostart "@itemize @minus" :oend "@end itemize"
  1557. :ustart "@enumerate" :uend "@end enumerate"
  1558. :dstart "@table" :dend "@end table"
  1559. :dtstart "@item " :dtend "\n"
  1560. :ddstart "" :ddend ""
  1561. :istart "@item\n" :iend ""
  1562. :isep "\n" :lsep "\n"
  1563. :cbon "@code{[X]}" :cboff "@code{[ ]}")
  1564. params)))
  1565. (provide 'org-list)
  1566. ;; arch-tag: 73cf50c1-200f-4d1d-8a53-4e842a5b11c8
  1567. ;;; org-list.el ends here