lisp/org-inlinetask.el

   1 ;;; org-inlinetask.el --- Tasks Independent of Outline Hierarchy -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2009-2017 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
   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 the
  44 ;; first and the last two will be visible, the others will be hidden
  45 ;; using the `org-hide' 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: or other
  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)
  82
  83 (defgroup org-inlinetask nil
  84   "Options concerning inline tasks in Org mode."
  85   :tag "Org Inline Tasks"
  86   :group 'org-structure)
  87
  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.
  92
  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)))
 101
 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)
 108
 109 (defvar org-odd-levels-only)
 110 (defvar org-keyword-time-regexp)
 111 (defvar org-complex-heading-regexp)
 112 (defvar org-property-end-re)
 113
 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 if 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")))
 123
 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 If there is a region wrap it inside the inline task."
 128   (interactive "P")
 129   ;; Error when inside an inline task, except if point was at its very
 130   ;; beginning, in which case the new inline task will be inserted
 131   ;; before this one.
 132   (when (and (org-inlinetask-in-task-p)
 133              (not (and (org-inlinetask-at-task-p) (bolp))))
 134     (error "Cannot nest inline tasks"))
 135   (or (bolp) (newline))
 136   (let* ((indent (if org-odd-levels-only
 137                      (1- (* 2 org-inlinetask-min-level))
 138                    org-inlinetask-min-level))
 139          (indent-string (concat (make-string indent ?*) " "))
 140          (rbeg (if (org-region-active-p) (region-beginning) (point)))
 141          (rend (if (org-region-active-p) (region-end) (point))))
 142     (goto-char rend)
 143     (insert "\n" indent-string "END\n")
 144     (goto-char rbeg)
 145     (unless (bolp) (insert "\n"))
 146     (insert indent-string
 147             (if (or no-state (not org-inlinetask-default-state))
 148                 ""
 149               (concat org-inlinetask-default-state " "))
 150             (if (= rend rbeg) "" "\n"))
 151     (unless (= rend rbeg) (end-of-line 0))))
 152 (define-key org-mode-map "\C-c\C-xt" 'org-inlinetask-insert-task)
 153
 154 (defun org-inlinetask-outline-regexp ()
 155   "Return string matching an inline task heading.
 156 The number of levels is controlled by `org-inlinetask-min-level'."
 157   (let ((nstars (if org-odd-levels-only
 158                     (1- (* org-inlinetask-min-level 2))
 159                   org-inlinetask-min-level)))
 160     (format "^\\(\\*\\{%d,\\}\\)[ \t]+" nstars)))
 161
 162 (defun org-inlinetask-at-task-p ()
 163   "Return true if point is at beginning of an inline task."
 164   (save-excursion
 165     (beginning-of-line)
 166     (and (looking-at (concat (org-inlinetask-outline-regexp)  "\\(.*\\)"))
 167          (not (string-match "^end[ \t]*$" (downcase (match-string 2)))))))
 168
 169 (defun org-inlinetask-in-task-p ()
 170   "Return true if point is inside an inline task."
 171   (save-excursion
 172     (beginning-of-line)
 173     (let* ((case-fold-search t)
 174            (stars-re (org-inlinetask-outline-regexp))
 175            (task-beg-re (concat stars-re "\\(?:.*\\)"))
 176            (task-end-re (concat stars-re "END[ \t]*$")))
 177       (or (looking-at-p task-beg-re)
 178           (and (re-search-forward "^\\*+[ \t]+" nil t)
 179                (progn (beginning-of-line) (looking-at-p task-end-re)))))))
 180
 181 (defun org-inlinetask-goto-beginning ()
 182   "Go to the beginning of the inline task at point."
 183   (end-of-line)
 184   (let ((case-fold-search t)
 185         (inlinetask-re (org-inlinetask-outline-regexp)))
 186     (re-search-backward inlinetask-re nil t)
 187     (when (looking-at-p (concat inlinetask-re "END[ \t]*$"))
 188       (re-search-backward inlinetask-re nil t))))
 189
 190 (defun org-inlinetask-goto-end ()
 191   "Go to the end of the inline task at point.
 192     Return point."
 193   (save-match-data
 194     (beginning-of-line)
 195     (let* ((case-fold-search t)
 196            (inlinetask-re (org-inlinetask-outline-regexp))
 197            (task-end-re (concat inlinetask-re "END[ \t]*$")))
 198       (cond
 199        ((looking-at-p task-end-re)
 200         (forward-line))
 201        ((looking-at-p inlinetask-re)
 202         (forward-line)
 203         (cond
 204          ((looking-at-p task-end-re) (forward-line))
 205          ((looking-at-p inlinetask-re))
 206          ((org-inlinetask-in-task-p)
 207           (re-search-forward inlinetask-re nil t)
 208           (forward-line))
 209          (t nil)))
 210        (t
 211         (re-search-forward inlinetask-re nil t)
 212         (forward-line)))))
 213   (point))
 214
 215 (defun org-inlinetask-get-task-level ()
 216   "Get the level of the inline task around.
 217 This assumes the point is inside an inline task."
 218   (save-excursion
 219     (end-of-line)
 220     (re-search-backward (org-inlinetask-outline-regexp) nil t)
 221     (- (match-end 1) (match-beginning 1))))
 222
 223 (defun org-inlinetask-promote ()
 224   "Promote the inline task at point.
 225 If the task has an end part, promote it.  Also, prevents level from
 226 going below `org-inlinetask-min-level'."
 227   (interactive)
 228   (if (not (org-inlinetask-in-task-p))
 229       (error "Not in an inline task")
 230     (save-excursion
 231       (let* ((lvl (org-inlinetask-get-task-level))
 232              (next-lvl (org-get-valid-level lvl -1))
 233              (diff (- next-lvl lvl))
 234              (down-task (concat (make-string next-lvl ?*)))
 235              beg)
 236         (if (< next-lvl org-inlinetask-min-level)
 237             (error "Cannot promote an inline task at minimum level")
 238           (org-inlinetask-goto-beginning)
 239           (setq beg (point))
 240           (replace-match down-task nil t nil 1)
 241           (org-inlinetask-goto-end)
 242           (if (eobp) (beginning-of-line) (forward-line -1))
 243           (unless (= (point) beg)
 244             (replace-match down-task nil t nil 1)
 245             (when org-adapt-indentation
 246               (goto-char beg)
 247               (org-fixup-indentation diff))))))))
 248
 249 (defun org-inlinetask-demote ()
 250   "Demote the inline task at point.
 251 If the task has an end part, also demote it."
 252   (interactive)
 253   (if (not (org-inlinetask-in-task-p))
 254       (error "Not in an inline task")
 255     (save-excursion
 256       (let* ((lvl (org-inlinetask-get-task-level))
 257              (next-lvl (org-get-valid-level lvl 1))
 258              (diff (- next-lvl lvl))
 259              (down-task (concat (make-string next-lvl ?*)))
 260              beg)
 261         (org-inlinetask-goto-beginning)
 262         (setq beg (point))
 263         (replace-match down-task nil t nil 1)
 264         (org-inlinetask-goto-end)
 265         (if (eobp) (beginning-of-line) (forward-line -1))
 266         (unless (= (point) beg)
 267           (replace-match down-task nil t nil 1)
 268           (when org-adapt-indentation
 269             (goto-char beg)
 270             (org-fixup-indentation diff)))))))
 271
 272 (defun org-inlinetask-get-current-indentation ()
 273   "Get the indentation of the last non-while line above this one."
 274   (save-excursion
 275     (beginning-of-line 1)
 276     (skip-chars-backward " \t\n")
 277     (beginning-of-line 1)
 278     (or (org-at-item-p)
 279         (looking-at "[ \t]*"))
 280     (goto-char (match-end 0))
 281     (current-column)))
 282
 283 (defvar org-indent-indentation-per-level) ; defined in org-indent.el
 284
 285 (defface org-inlinetask '((t :inherit shadow))
 286   "Face for inlinetask headlines."
 287   :group 'org-faces)
 288
 289 (defun org-inlinetask-fontify (limit)
 290   "Fontify the inline tasks down to LIMIT."
 291   (let* ((nstars (if org-odd-levels-only
 292                      (1- (* 2 (or org-inlinetask-min-level 200)))
 293                    (or org-inlinetask-min-level 200)))
 294          (re (concat "^\\(\\*\\)\\(\\*\\{"
 295                      (format "%d" (- nstars 3))
 296                      ",\\}\\)\\(\\*\\* .*\\)"))
 297          ;; Virtual indentation will add the warning face on the first
 298          ;; star.  Thus, in that case, only hide it.
 299          (start-face (if (and (bound-and-true-p org-indent-mode)
 300                               (> org-indent-indentation-per-level 1))
 301                          'org-hide
 302                        'org-warning)))
 303     (while (re-search-forward re limit t)
 304       (if org-inlinetask-show-first-star
 305           (add-text-properties (match-beginning 1) (match-end 1)
 306                                `(face ,start-face font-lock-fontified t)))
 307       (add-text-properties (match-beginning
 308                             (if org-inlinetask-show-first-star 2 1))
 309                            (match-end 2)
 310                            '(face org-hide font-lock-fontified t))
 311       (add-text-properties (match-beginning 3) (match-end 3)
 312                            '(face org-inlinetask font-lock-fontified t)))))
 313
 314 (defun org-inlinetask-toggle-visibility ()
 315   "Toggle visibility of inline task at point."
 316   (let ((end (save-excursion
 317                (org-inlinetask-goto-end)
 318                (if (bolp) (1- (point)) (point))))
 319         (start (save-excursion
 320                  (org-inlinetask-goto-beginning)
 321                  (point-at-eol))))
 322     (cond
 323      ;; Nothing to show/hide.
 324      ((= end start))
 325      ;; Inlinetask was folded: expand it.
 326      ((eq (get-char-property (1+ start) 'invisible) 'outline)
 327       (outline-flag-region start end nil)
 328       (org-cycle-hide-drawers 'children))
 329      (t (outline-flag-region start end t)))))
 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)
 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)
 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