org-inlinetask.el 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361
  1. ;;; org-inlinetask.el --- Tasks Independent of Outline Hierarchy -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2009-2018 Free Software Foundation, Inc.
  3. ;;
  4. ;; Author: Carsten Dominik <carsten at orgmode dot org>
  5. ;; Keywords: outlines, hypermedia, calendar, wp
  6. ;; Homepage: https://orgmode.org
  7. ;; This file is part of GNU Emacs.
  8. ;; GNU Emacs is free software: you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation, either version 3 of the License, or
  11. ;; (at your option) any later version.
  12. ;; GNU Emacs is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. ;; GNU General Public License for more details.
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
  18. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  19. ;;
  20. ;;; Commentary:
  21. ;;
  22. ;; This module implements inline tasks in Org mode. Inline tasks are
  23. ;; tasks that have all the properties of normal outline nodes,
  24. ;; including the ability to store meta data like scheduling dates,
  25. ;; TODO state, tags and properties. However, these nodes are treated
  26. ;; specially by the visibility cycling.
  27. ;;
  28. ;; Visibility cycling exempts these nodes from cycling. So whenever
  29. ;; their parent is opened, so are these tasks. This will only work
  30. ;; with `org-cycle', so if you are also using other commands to
  31. ;; show/hide entries, you will occasionally find these tasks to behave
  32. ;; like all other outline nodes, seemingly splitting the text of the
  33. ;; parent into children.
  34. ;;
  35. ;; Special fontification of inline tasks, so that they can be
  36. ;; immediately recognized. From the stars of the headline, only the
  37. ;; first and the last two will be visible, the others will be hidden
  38. ;; using the `org-hide' face.
  39. ;;
  40. ;; An inline task is identified solely by a minimum outline level,
  41. ;; given by the variable `org-inlinetask-min-level', default 15.
  42. ;;
  43. ;; If you need to have a time planning line (DEADLINE etc), drawers,
  44. ;; for example LOGBOOK of PROPERTIES, or even normal text as part of
  45. ;; the inline task, you must add an "END" headline with the same
  46. ;; number of stars.
  47. ;;
  48. ;; As an example, here are two valid inline tasks:
  49. ;;
  50. ;; **************** TODO a small task
  51. ;;
  52. ;; and
  53. ;;
  54. ;; **************** TODO another small task
  55. ;; DEADLINE: <2009-03-30 Mon>
  56. ;; :PROPERTIES:
  57. ;; :SOMETHING: or other
  58. ;; :END:
  59. ;; And here is some extra text
  60. ;; **************** END
  61. ;;
  62. ;; Also, if you want to use refiling and archiving for inline tasks,
  63. ;; The END line must be present to make things work properly.
  64. ;;
  65. ;; Note that you should not try to use inline tasks within plain list,
  66. ;; visibility cycling is known to be problematic when doing so.
  67. ;;
  68. ;; This package installs one new command:
  69. ;;
  70. ;; C-c C-x t Insert a new inline task with END line
  71. ;;; Code:
  72. (require 'org)
  73. (defgroup org-inlinetask nil
  74. "Options concerning inline tasks in Org mode."
  75. :tag "Org Inline Tasks"
  76. :group 'org-structure)
  77. (defcustom org-inlinetask-min-level 15
  78. "Minimum level a headline must have before it is treated as an inline task.
  79. Don't set it to something higher than `29' or clocking will break since this
  80. is the hardcoded maximum number of stars `org-clock-sum' will work with.
  81. It is strongly recommended that you set `org-cycle-max-level' not at all,
  82. or to a number smaller than this one. In fact, when `org-cycle-max-level' is
  83. not set, it will be assumed to be one less than the value of smaller than
  84. the value of this variable."
  85. :group 'org-inlinetask
  86. :type '(choice
  87. (const :tag "Off" nil)
  88. (integer)))
  89. (defcustom org-inlinetask-show-first-star nil
  90. "Non-nil means display the first star of an inline task as additional marker.
  91. When nil, the first star is not shown."
  92. :tag "Org Inline Tasks"
  93. :group 'org-structure
  94. :type 'boolean)
  95. (defvar org-odd-levels-only)
  96. (defvar org-keyword-time-regexp)
  97. (defvar org-complex-heading-regexp)
  98. (defvar org-property-end-re)
  99. (defcustom org-inlinetask-default-state nil
  100. "Non-nil means make inline tasks have a TODO keyword initially.
  101. This should be the state `org-inlinetask-insert-task' should use by
  102. default, or nil if no state should be assigned."
  103. :group 'org-inlinetask
  104. :version "24.1"
  105. :type '(choice
  106. (const :tag "No state" nil)
  107. (string :tag "Specific state")))
  108. (defun org-inlinetask-insert-task (&optional no-state)
  109. "Insert an inline task.
  110. If prefix arg NO-STATE is set, ignore `org-inlinetask-default-state'.
  111. If there is a region wrap it inside the inline task."
  112. (interactive "P")
  113. ;; Error when inside an inline task, except if point was at its very
  114. ;; beginning, in which case the new inline task will be inserted
  115. ;; before this one.
  116. (when (and (org-inlinetask-in-task-p)
  117. (not (and (org-inlinetask-at-task-p) (bolp))))
  118. (error "Cannot nest inline tasks"))
  119. (or (bolp) (newline))
  120. (let* ((indent (if org-odd-levels-only
  121. (1- (* 2 org-inlinetask-min-level))
  122. org-inlinetask-min-level))
  123. (indent-string (concat (make-string indent ?*) " "))
  124. (rbeg (if (org-region-active-p) (region-beginning) (point)))
  125. (rend (if (org-region-active-p) (region-end) (point))))
  126. (goto-char rend)
  127. (insert "\n" indent-string "END\n")
  128. (goto-char rbeg)
  129. (unless (bolp) (insert "\n"))
  130. (insert indent-string
  131. (if (or no-state (not org-inlinetask-default-state))
  132. ""
  133. (concat org-inlinetask-default-state " "))
  134. (if (= rend rbeg) "" "\n"))
  135. (unless (= rend rbeg) (end-of-line 0))))
  136. (define-key org-mode-map "\C-c\C-xt" 'org-inlinetask-insert-task)
  137. (defun org-inlinetask-outline-regexp ()
  138. "Return string matching an inline task heading.
  139. The number of levels is controlled by `org-inlinetask-min-level'."
  140. (let ((nstars (if org-odd-levels-only
  141. (1- (* org-inlinetask-min-level 2))
  142. org-inlinetask-min-level)))
  143. (format "^\\(\\*\\{%d,\\}\\)[ \t]+" nstars)))
  144. (defun org-inlinetask-at-task-p ()
  145. "Return true if point is at beginning of an inline task."
  146. (save-excursion
  147. (beginning-of-line)
  148. (and (looking-at (concat (org-inlinetask-outline-regexp) "\\(.*\\)"))
  149. (not (string-match "^end[ \t]*$" (downcase (match-string 2)))))))
  150. (defun org-inlinetask-in-task-p ()
  151. "Return true if point is inside an inline task."
  152. (save-excursion
  153. (beginning-of-line)
  154. (let* ((case-fold-search t)
  155. (stars-re (org-inlinetask-outline-regexp))
  156. (task-beg-re (concat stars-re "\\(?:.*\\)"))
  157. (task-end-re (concat stars-re "END[ \t]*$")))
  158. (or (looking-at-p task-beg-re)
  159. (and (re-search-forward "^\\*+[ \t]+" nil t)
  160. (progn (beginning-of-line) (looking-at-p task-end-re)))))))
  161. (defun org-inlinetask-goto-beginning ()
  162. "Go to the beginning of the inline task at point."
  163. (end-of-line)
  164. (let ((case-fold-search t)
  165. (inlinetask-re (org-inlinetask-outline-regexp)))
  166. (re-search-backward inlinetask-re nil t)
  167. (when (looking-at-p (concat inlinetask-re "END[ \t]*$"))
  168. (re-search-backward inlinetask-re nil t))))
  169. (defun org-inlinetask-goto-end ()
  170. "Go to the end of the inline task at point.
  171. Return point."
  172. (save-match-data
  173. (beginning-of-line)
  174. (let* ((case-fold-search t)
  175. (inlinetask-re (org-inlinetask-outline-regexp))
  176. (task-end-re (concat inlinetask-re "END[ \t]*$")))
  177. (cond
  178. ((looking-at-p task-end-re)
  179. (forward-line))
  180. ((looking-at-p inlinetask-re)
  181. (forward-line)
  182. (cond
  183. ((looking-at-p task-end-re) (forward-line))
  184. ((looking-at-p inlinetask-re))
  185. ((org-inlinetask-in-task-p)
  186. (re-search-forward inlinetask-re nil t)
  187. (forward-line))
  188. (t nil)))
  189. (t
  190. (re-search-forward inlinetask-re nil t)
  191. (forward-line)))))
  192. (point))
  193. (defun org-inlinetask-get-task-level ()
  194. "Get the level of the inline task around.
  195. This assumes the point is inside an inline task."
  196. (save-excursion
  197. (end-of-line)
  198. (re-search-backward (org-inlinetask-outline-regexp) nil t)
  199. (- (match-end 1) (match-beginning 1))))
  200. (defun org-inlinetask-promote ()
  201. "Promote the inline task at point.
  202. If the task has an end part, promote it. Also, prevents level from
  203. going below `org-inlinetask-min-level'."
  204. (interactive)
  205. (if (not (org-inlinetask-in-task-p))
  206. (error "Not in an inline task")
  207. (save-excursion
  208. (let* ((lvl (org-inlinetask-get-task-level))
  209. (next-lvl (org-get-valid-level lvl -1))
  210. (diff (- next-lvl lvl))
  211. (down-task (concat (make-string next-lvl ?*)))
  212. beg)
  213. (if (< next-lvl org-inlinetask-min-level)
  214. (error "Cannot promote an inline task at minimum level")
  215. (org-inlinetask-goto-beginning)
  216. (setq beg (point))
  217. (replace-match down-task nil t nil 1)
  218. (org-inlinetask-goto-end)
  219. (if (eobp) (beginning-of-line) (forward-line -1))
  220. (unless (= (point) beg)
  221. (replace-match down-task nil t nil 1)
  222. (when org-adapt-indentation
  223. (goto-char beg)
  224. (org-fixup-indentation diff))))))))
  225. (defun org-inlinetask-demote ()
  226. "Demote the inline task at point.
  227. If the task has an end part, also demote it."
  228. (interactive)
  229. (if (not (org-inlinetask-in-task-p))
  230. (error "Not in an inline task")
  231. (save-excursion
  232. (let* ((lvl (org-inlinetask-get-task-level))
  233. (next-lvl (org-get-valid-level lvl 1))
  234. (diff (- next-lvl lvl))
  235. (down-task (concat (make-string next-lvl ?*)))
  236. beg)
  237. (org-inlinetask-goto-beginning)
  238. (setq beg (point))
  239. (replace-match down-task nil t nil 1)
  240. (org-inlinetask-goto-end)
  241. (if (eobp) (beginning-of-line) (forward-line -1))
  242. (unless (= (point) beg)
  243. (replace-match down-task nil t nil 1)
  244. (when org-adapt-indentation
  245. (goto-char beg)
  246. (org-fixup-indentation diff)))))))
  247. (defun org-inlinetask-get-current-indentation ()
  248. "Get the indentation of the last non-while line above this one."
  249. (save-excursion
  250. (beginning-of-line 1)
  251. (skip-chars-backward " \t\n")
  252. (beginning-of-line 1)
  253. (or (org-at-item-p)
  254. (looking-at "[ \t]*"))
  255. (goto-char (match-end 0))
  256. (current-column)))
  257. (defvar org-indent-indentation-per-level) ; defined in org-indent.el
  258. (defface org-inlinetask '((t :inherit shadow))
  259. "Face for inlinetask headlines."
  260. :group 'org-faces)
  261. (defun org-inlinetask-fontify (limit)
  262. "Fontify the inline tasks down to LIMIT."
  263. (let* ((nstars (if org-odd-levels-only
  264. (1- (* 2 (or org-inlinetask-min-level 200)))
  265. (or org-inlinetask-min-level 200)))
  266. (re (concat "^\\(\\*\\)\\(\\*\\{"
  267. (format "%d" (- nstars 3))
  268. ",\\}\\)\\(\\*\\* .*\\)"))
  269. ;; Virtual indentation will add the warning face on the first
  270. ;; star. Thus, in that case, only hide it.
  271. (start-face (if (and (bound-and-true-p org-indent-mode)
  272. (> org-indent-indentation-per-level 1))
  273. 'org-hide
  274. 'org-warning)))
  275. (while (re-search-forward re limit t)
  276. (if org-inlinetask-show-first-star
  277. (add-text-properties (match-beginning 1) (match-end 1)
  278. `(face ,start-face font-lock-fontified t)))
  279. (add-text-properties (match-beginning
  280. (if org-inlinetask-show-first-star 2 1))
  281. (match-end 2)
  282. '(face org-hide font-lock-fontified t))
  283. (add-text-properties (match-beginning 3) (match-end 3)
  284. '(face org-inlinetask font-lock-fontified t)))))
  285. (defun org-inlinetask-toggle-visibility ()
  286. "Toggle visibility of inline task at point."
  287. (let ((end (save-excursion
  288. (org-inlinetask-goto-end)
  289. (if (bolp) (1- (point)) (point))))
  290. (start (save-excursion
  291. (org-inlinetask-goto-beginning)
  292. (point-at-eol))))
  293. (cond
  294. ;; Nothing to show/hide.
  295. ((= end start))
  296. ;; Inlinetask was folded: expand it.
  297. ((eq (get-char-property (1+ start) 'invisible) 'outline)
  298. (org-flag-region start end nil 'outline))
  299. (t (org-flag-region start end t 'outline)))))
  300. (defun org-inlinetask-hide-tasks (state)
  301. "Hide inline tasks in buffer when STATE is `contents' or `children'.
  302. This function is meant to be used in `org-cycle-hook'."
  303. (pcase state
  304. (`contents
  305. (let ((regexp (org-inlinetask-outline-regexp)))
  306. (save-excursion
  307. (goto-char (point-min))
  308. (while (re-search-forward regexp nil t)
  309. (org-inlinetask-toggle-visibility)
  310. (org-inlinetask-goto-end)))))
  311. (`children
  312. (save-excursion
  313. (while
  314. (or (org-inlinetask-at-task-p)
  315. (and (outline-next-heading) (org-inlinetask-at-task-p)))
  316. (org-inlinetask-toggle-visibility)
  317. (org-inlinetask-goto-end))))))
  318. (defun org-inlinetask-remove-END-maybe ()
  319. "Remove an END line when present."
  320. (when (looking-at (format "\\([ \t]*\n\\)*\\*\\{%d,\\}[ \t]+END[ \t]*$"
  321. org-inlinetask-min-level))
  322. (replace-match "")))
  323. (add-hook 'org-font-lock-hook 'org-inlinetask-fontify)
  324. (add-hook 'org-cycle-hook 'org-inlinetask-hide-tasks)
  325. (provide 'org-inlinetask)
  326. ;;; org-inlinetask.el ends here