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