org-inlinetask.el (13207B)
1 ;;; org-inlinetask.el --- Tasks Independent of Outline Hierarchy -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2009-2023 Free Software Foundation, Inc. 4 ;; 5 ;; Author: Carsten Dominik <carsten.dominik@gmail.com> 6 ;; Keywords: outlines, hypermedia, calendar, wp 7 ;; URL: https://orgmode.org 8 9 ;; This file is part of GNU Emacs. 10 11 ;; GNU Emacs is free software: you can redistribute it and/or modify 12 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. 16 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. 21 22 ;; You should have received a copy of the GNU General Public License 23 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 24 25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 26 ;; 27 ;;; Commentary: 28 ;; 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. 34 ;; 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. 41 ;; 42 ;; Special fontification of inline tasks, so that they can be 43 ;; immediately recognized. From the stars of the headline, only last 44 ;; two will be visible, the others will be hidden using the `org-hide' 45 ;; face. 46 ;; 47 ;; An inline task is identified solely by a minimum outline level, 48 ;; given by the variable `org-inlinetask-min-level', default 15. 49 ;; 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. 54 ;; 55 ;; As an example, here are two valid inline tasks: 56 ;; 57 ;; **************** TODO A small task 58 ;; 59 ;; and 60 ;; 61 ;; **************** TODO Another small task 62 ;; DEADLINE: <2009-03-30 Mon> 63 ;; :PROPERTIES: 64 ;; :SOMETHING: another thing 65 ;; :END: 66 ;; And here is some extra text 67 ;; **************** END 68 ;; 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. 71 ;; 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. 74 ;; 75 ;; This package installs one new command: 76 ;; 77 ;; C-c C-x t Insert a new inline task with END line 78 79 ;;; Code: 80 81 (require 'org-macs) 82 (org-assert-version) 83 84 (require 'org) 85 86 (defgroup org-inlinetask nil 87 "Options concerning inline tasks in Org mode." 88 :tag "Org Inline Tasks" 89 :group 'org-structure) 90 91 (defcustom org-inlinetask-min-level 15 92 "Minimum level a headline must have before it is treated as an inline task. 93 Don't set it to something higher than `29' or clocking will break since this 94 is the hardcoded maximum number of stars `org-clock-sum' will work with. 95 96 It is strongly recommended that you set `org-cycle-max-level' not at all, 97 or to a number smaller than this one. In fact, when `org-cycle-max-level' is 98 not set, it will be assumed to be one less than the value of smaller than 99 the value of this variable." 100 :group 'org-inlinetask 101 :type '(choice 102 (const :tag "Off" nil) 103 (integer))) 104 105 (defcustom org-inlinetask-show-first-star nil 106 "Non-nil means display the first star of an inline task as additional marker. 107 When nil, the first star is not shown." 108 :tag "Org Inline Tasks" 109 :group 'org-structure 110 :type 'boolean) 111 112 (defvar org-odd-levels-only) 113 (defvar org-keyword-time-regexp) 114 (defvar org-complex-heading-regexp) 115 (defvar org-property-end-re) 116 117 (defcustom org-inlinetask-default-state nil 118 "Non-nil means make inline tasks have a TODO keyword initially. 119 This should be the state `org-inlinetask-insert-task' should use by 120 default, or nil if no state should be assigned." 121 :group 'org-inlinetask 122 :version "24.1" 123 :type '(choice 124 (const :tag "No state" nil) 125 (string :tag "Specific state"))) 126 127 (defun org-inlinetask-insert-task (&optional no-state) 128 "Insert an inline task. 129 If prefix arg NO-STATE is set, ignore `org-inlinetask-default-state'. 130 If there is a region wrap it inside the inline task." 131 (interactive "P") 132 ;; Error when inside an inline task, except if point was at its very 133 ;; beginning, in which case the new inline task will be inserted 134 ;; before this one. 135 (when (and (org-inlinetask-in-task-p) 136 (not (and (org-inlinetask-at-task-p) (bolp)))) 137 (user-error "Cannot nest inline tasks")) 138 (or (bolp) (newline)) 139 (let* ((indent (if org-odd-levels-only 140 (1- (* 2 org-inlinetask-min-level)) 141 org-inlinetask-min-level)) 142 (indent-string (concat (make-string indent ?*) " ")) 143 (rbeg (if (org-region-active-p) (region-beginning) (point))) 144 (rend (if (org-region-active-p) (region-end) (point)))) 145 (goto-char rend) 146 (insert "\n" indent-string "END\n") 147 (goto-char rbeg) 148 (unless (bolp) (insert "\n")) 149 (insert indent-string 150 (if (or no-state (not org-inlinetask-default-state)) 151 "" 152 (concat org-inlinetask-default-state " ")) 153 (if (= rend rbeg) "" "\n")) 154 (unless (= rend rbeg) (end-of-line 0)))) 155 (define-key org-mode-map "\C-c\C-xt" 'org-inlinetask-insert-task) 156 157 (defun org-inlinetask-outline-regexp () 158 "Return string matching an inline task heading. 159 The number of levels is controlled by `org-inlinetask-min-level'." 160 (let ((nstars (if org-odd-levels-only 161 (1- (* org-inlinetask-min-level 2)) 162 org-inlinetask-min-level))) 163 (format "^\\(\\*\\{%d,\\}\\)[ \t]+" nstars))) 164 165 (defun org-inlinetask-end-p () 166 "Return a non-nil value if point is on inline task's END part." 167 (let ((case-fold-search t)) 168 (org-match-line (concat (org-inlinetask-outline-regexp) "END[ \t]*$")))) 169 170 (defun org-inlinetask-at-task-p () 171 "Return non-nil if point is at beginning of an inline task." 172 (and (org-match-line (concat (org-inlinetask-outline-regexp) "\\(.*\\)")) 173 (not (org-inlinetask-end-p)))) 174 175 (defun org-inlinetask-in-task-p () 176 "Return true if point is inside an inline task." 177 (save-excursion 178 (beginning-of-line) 179 (let ((case-fold-search t)) 180 (or (looking-at-p (concat (org-inlinetask-outline-regexp) "\\(?:.*\\)")) 181 (and (re-search-forward "^\\*+[ \t]+" nil t) 182 (org-inlinetask-end-p)))))) 183 184 (defun org-inlinetask-goto-beginning () 185 "Go to the beginning of the inline task at point." 186 (end-of-line) 187 (let ((case-fold-search t) 188 (inlinetask-re (org-inlinetask-outline-regexp))) 189 (re-search-backward inlinetask-re nil t) 190 (when (org-inlinetask-end-p) 191 (re-search-backward inlinetask-re nil t)))) 192 193 (defun org-inlinetask-goto-end () 194 "Go to the end of the inline task at point. 195 Return point." 196 (save-match-data 197 (beginning-of-line) 198 (let ((case-fold-search t) 199 (inlinetask-re (org-inlinetask-outline-regexp))) 200 (cond 201 ((org-inlinetask-end-p) 202 (forward-line)) 203 ((looking-at-p inlinetask-re) 204 (forward-line) 205 (cond 206 ((org-inlinetask-end-p) (forward-line)) 207 ((looking-at-p inlinetask-re)) 208 ((org-inlinetask-in-task-p) 209 (re-search-forward inlinetask-re nil t) 210 (forward-line)) 211 (t nil))) 212 (t 213 (re-search-forward inlinetask-re nil t) 214 (forward-line))))) 215 (point)) 216 217 (defun org-inlinetask-get-task-level () 218 "Get the level of the inline task around. 219 This assumes the point is inside an inline task." 220 (save-excursion 221 (end-of-line) 222 (re-search-backward (org-inlinetask-outline-regexp) nil t) 223 (- (match-end 1) (match-beginning 1)))) 224 225 (defun org-inlinetask-promote () 226 "Promote the inline task at point. 227 If the task has an end part, promote it. Also, prevents level from 228 going below `org-inlinetask-min-level'." 229 (interactive) 230 (if (not (org-inlinetask-in-task-p)) 231 (user-error "Not in an inline task") 232 (save-excursion 233 (let* ((lvl (org-inlinetask-get-task-level)) 234 (next-lvl (org-get-valid-level lvl -1)) 235 (diff (- next-lvl lvl)) 236 (down-task (concat (make-string next-lvl ?*))) 237 beg) 238 (if (< next-lvl org-inlinetask-min-level) 239 (user-error "Cannot promote an inline task at minimum level") 240 (org-inlinetask-goto-beginning) 241 (setq beg (point)) 242 (replace-match down-task nil t nil 1) 243 (org-inlinetask-goto-end) 244 (if (and (eobp) (looking-back "END\\s-*" (line-beginning-position))) 245 (beginning-of-line) 246 (forward-line -1)) 247 (unless (= (point) beg) 248 (looking-at (org-inlinetask-outline-regexp)) 249 (replace-match down-task nil t nil 1) 250 (when (eq org-adapt-indentation t) 251 (goto-char beg) 252 (org-fixup-indentation diff)))))))) 253 254 (defun org-inlinetask-demote () 255 "Demote the inline task at point. 256 If the task has an end part, also demote it." 257 (interactive) 258 (if (not (org-inlinetask-in-task-p)) 259 (user-error "Not in an inline task") 260 (save-excursion 261 (let* ((lvl (org-inlinetask-get-task-level)) 262 (next-lvl (org-get-valid-level lvl 1)) 263 (diff (- next-lvl lvl)) 264 (down-task (concat (make-string next-lvl ?*))) 265 beg) 266 (org-inlinetask-goto-beginning) 267 (setq beg (point)) 268 (replace-match down-task nil t nil 1) 269 (org-inlinetask-goto-end) 270 (if (and (eobp) (looking-back "END\\s-*" (line-beginning-position))) 271 (beginning-of-line) 272 (forward-line -1)) 273 (unless (= (point) beg) 274 (looking-at (org-inlinetask-outline-regexp)) 275 (replace-match down-task nil t nil 1) 276 (when (eq org-adapt-indentation t) 277 (goto-char beg) 278 (org-fixup-indentation diff))))))) 279 280 (defvar org-indent-indentation-per-level) ; defined in org-indent.el 281 282 (defface org-inlinetask '((t :inherit shadow)) 283 "Face for inlinetask headlines." 284 :group 'org-faces) 285 286 (defun org-inlinetask-fontify (limit) 287 "Fontify the inline tasks down to LIMIT." 288 (let* ((nstars (if org-odd-levels-only 289 (1- (* 2 (or org-inlinetask-min-level 200))) 290 (or org-inlinetask-min-level 200))) 291 (re (concat "^\\(\\*\\)\\(\\*\\{" 292 (format "%d" (- nstars 3)) 293 ",\\}\\)\\(\\*\\* .*\\)")) 294 ;; Virtual indentation will add the warning face on the first 295 ;; star. Thus, in that case, only hide it. 296 (start-face (if (and (bound-and-true-p org-indent-mode) 297 (> org-indent-indentation-per-level 1)) 298 'org-hide 299 'org-warning))) 300 (while (re-search-forward re limit t) 301 (if org-inlinetask-show-first-star 302 (add-text-properties (match-beginning 1) (match-end 1) 303 `(face ,start-face font-lock-fontified t))) 304 (add-text-properties (match-beginning 305 (if org-inlinetask-show-first-star 2 1)) 306 (match-end 2) 307 '(face org-hide font-lock-fontified t)) 308 (add-text-properties (match-beginning 3) (match-end 3) 309 '(face org-inlinetask font-lock-fontified t))))) 310 311 (defun org-inlinetask-toggle-visibility (&optional state) 312 "Toggle visibility of inline task at point. 313 When optional argument STATE is `fold', fold unconditionally. 314 When STATE is `unfold', unfold unconditionally." 315 (let ((end (save-excursion 316 (org-inlinetask-goto-end) 317 (if (bolp) (1- (point)) (point)))) 318 (start (save-excursion 319 (org-inlinetask-goto-beginning) 320 (line-end-position)))) 321 (cond 322 ;; Nothing to show/hide. 323 ((= end start)) 324 ;; Inlinetask was folded: expand it. 325 ((and (not (eq state 'fold)) 326 (or (eq state 'unfold) 327 (org-fold-get-folding-spec 'headline (1+ start)))) 328 (org-fold-region start end nil 'headline)) 329 (t (org-fold-region start end t 'headline))))) 330 331 (defun org-inlinetask-hide-tasks (state) 332 "Hide inline tasks in buffer when STATE is `contents' or `children'. 333 This function is meant to be used in `org-cycle-hook'." 334 (pcase state 335 (`contents 336 (let ((regexp (org-inlinetask-outline-regexp))) 337 (save-excursion 338 (goto-char (point-min)) 339 (while (re-search-forward regexp nil t) 340 (org-inlinetask-toggle-visibility 'fold) 341 (org-inlinetask-goto-end))))) 342 (`children 343 (save-excursion 344 (while 345 (or (org-inlinetask-at-task-p) 346 (and (outline-next-heading) (org-inlinetask-at-task-p))) 347 (org-inlinetask-toggle-visibility 'fold) 348 (org-inlinetask-goto-end)))))) 349 350 (defun org-inlinetask-remove-END-maybe () 351 "Remove an END line when present." 352 (when (looking-at (format "\\([ \t]*\n\\)*\\*\\{%d,\\}[ \t]+END[ \t]*$" 353 org-inlinetask-min-level)) 354 (replace-match ""))) 355 356 (add-hook 'org-font-lock-hook 'org-inlinetask-fontify) 357 (add-hook 'org-cycle-hook 'org-inlinetask-hide-tasks) 358 359 (provide 'org-inlinetask) 360 361 ;;; org-inlinetask.el ends here