lisp/org/org-inlinetask.el

   1 ;;; org-inlinetask.el --- Tasks independent of outline hierarchy
   2
   3 ;; Copyright (C) 2009-2013 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 <http://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, including
  31 ;; the ability to store meta data like scheduling dates, TODO state, tags
  32 ;; and properties.  However, these nodes are treated specially by the
  33 ;; visibility cycling and export commands.
  34 ;;
  35 ;; Visibility cycling exempts these nodes from cycling.  So whenever their
  36 ;; parent is opened, so are these tasks.  This will only work with
  37 ;; `org-cycle', so if you are also using other commands to show/hide
  38 ;; entries, you will occasionally find these tasks to behave like
  39 ;; all other outline nodes, seemingly splitting the text of the parent
  40 ;; into children.
  41 ;;
  42 ;; Export commands do not treat these nodes as part of the sectioning
  43 ;; structure, but as a special inline text that is either removed, or
  44 ;; formatted in some special way.  This in handled by
  45 ;; `org-inlinetask-export' and `org-inlinetask-export-templates'
  46 ;; variables.
  47 ;;
  48 ;; Special fontification of inline tasks, so that they can be immediately
  49 ;; recognized.  From the stars of the headline, only the first and the
  50 ;; last two will be visible, the others will be hidden using the
  51 ;; `org-hide' face.
  52 ;;
  53 ;; An inline task is identified solely by a minimum outline level, given
  54 ;; by the variable `org-inlinetask-min-level', default 15.
  55 ;;
  56 ;; If you need to have a time planning line (DEADLINE etc), drawers,
  57 ;; for example LOGBOOK of PROPERTIES, or even normal text as part of
  58 ;; the inline task, you must add an "END" headline with the same
  59 ;; number of stars.
  60 ;;
  61 ;; As an example, here are two valid inline tasks:
  62 ;;
  63 ;;    **************** TODO a small task
  64 ;;
  65 ;; and
  66 ;;
  67 ;;    **************** TODO another small task
  68 ;;                     DEADLINE: <2009-03-30 Mon>
  69 ;;                     :PROPERTIES:
  70 ;;                       :SOMETHING: or other
  71 ;;                     :END:
  72 ;;                     And here is some extra text
  73 ;;    **************** END
  74 ;;
  75 ;; Also, if you want to use refiling and archiving for inline tasks,
  76 ;; The END line must be present to make things work properly.
  77 ;;
  78 ;; Note that you should not try to use inline tasks within plain list,
  79 ;; visibility cycling is known to be problematic when doing so.
  80 ;;
  81 ;; This package installs one new command:
  82 ;;
  83 ;; C-c C-x t      Insert a new inline task with END line
  84
  85 ;;; Code:
  86
  87 (require 'org)
  88
  89 (defgroup org-inlinetask nil
  90   "Options concerning inline tasks in Org mode."
  91   :tag "Org Inline Tasks"
  92   :group 'org-structure)
  93
  94 (defcustom org-inlinetask-min-level 15
  95   "Minimum level a headline must have before it is treated as an inline task.
  96 Don't set it to something higher than `29' or clocking will break since this
  97 is the hardcoded maximum number of stars `org-clock-sum' will work with.
  98
  99 It is strongly recommended that you set `org-cycle-max-level' not at all,
 100 or to a number smaller than this one.  In fact, when `org-cycle-max-level' is
 101 not set, it will be assumed to be one less than the value of smaller than
 102 the value of this variable."
 103   :group 'org-inlinetask
 104   :type '(choice
 105           (const :tag "Off" nil)
 106           (integer)))
 107
 108 (defcustom org-inlinetask-show-first-star nil
 109   "Non-nil means display the first star of an inline task as additional marker.
 110 When nil, the first star is not shown."
 111   :tag "Org Inline Tasks"
 112   :group 'org-structure)
 113
 114 (defcustom org-inlinetask-export t
 115   "Non-nil means export inline tasks.
 116 When nil, they will not be exported."
 117   :group 'org-inlinetask
 118   :type 'boolean)
 119
 120 (defvar org-inlinetask-export-templates
 121   '((html "<div class=\"inlinetask\"><b>%s%s</b><br />%s</div>"
 122           '((unless (eq todo "")
 123               (format "<span class=\"%s %s\">%s%s</span> "
 124                       class todo todo priority))
 125             heading content))
 126     (odt "%s" '((org-odt-format-inlinetask heading content
 127                                            todo priority tags)))
 128
 129     (latex "\\begin\{description\}\n\\item[%s%s]~%s\\end\{description\}"
 130            '((unless (eq todo "") (format "\\textsc\{%s%s\} " todo priority))
 131              heading content))
 132     (ascii "     -- %s%s%s"
 133            '((unless (eq todo "") (format "%s%s " todo priority))
 134              heading
 135              (unless (eq content "")
 136                (format "\n         ¦ %s"
 137                        (mapconcat 'identity (org-split-string content "\n")
 138                                   "\n         ¦ ")))))
 139     (docbook "<variablelist>
 140 <varlistentry>
 141 <term>%s%s</term>
 142 <listitem><para>%s</para></listitem>
 143 </varlistentry>
 144 </variablelist>"
 145              '((unless (eq todo "") (format "%s%s " todo priority))
 146                heading content)))
 147   "Templates for inline tasks in various exporters.
 148
 149 This variable is an alist in the shape of \(BACKEND STRING OBJECTS\).
 150
 151 BACKEND is the name of the backend for the template \(ascii, html...\).
 152
 153 STRING is a format control string.
 154
 155 OBJECTS is a list of elements to be substituted into the format
 156 string.  They can be of any type, from a string to a form
 157 returning a value (thus allowing conditional insertion).  A nil
 158 object will be substituted as the empty string.  Obviously, there
 159 must be at least as many objects as %-sequences in the format
 160 string.
 161
 162 Moreover, the following special keywords are provided: `todo',
 163 `priority', `heading', `content', `tags'.  If some of them are not
 164 defined in an inline task, their value is the empty string.
 165
 166 As an example, valid associations are:
 167
 168 \(html \"<ul><li>%s <p>%s</p></li></ul>\" \(heading content\)\)
 169
 170 or, with the additional package \"todonotes\" for LaTeX,
 171
 172 \(latex \"\\todo[inline]{\\textbf{\\textsf{%s %s}}\\linebreak{} %s}\"
 173        '\(\(unless \(eq todo \"\"\)
 174            \(format \"\\textsc{%s%s}\" todo priority\)\)
 175          heading content\)\)\)")
 176
 177 (defvar org-odd-levels-only)
 178 (defvar org-keyword-time-regexp)
 179 (defvar org-drawer-regexp)
 180 (defvar org-complex-heading-regexp)
 181 (defvar org-property-end-re)
 182
 183 (defcustom org-inlinetask-default-state nil
 184   "Non-nil means make inline tasks have a TODO keyword initially.
 185 This should be the state `org-inlinetask-insert-task' should use by
 186 default, or nil of no state should be assigned."
 187   :group 'org-inlinetask
 188   :version "24.1"
 189   :type '(choice
 190           (const :tag "No state" nil)
 191           (string :tag "Specific state")))
 192
 193 (defun org-inlinetask-insert-task (&optional no-state)
 194   "Insert an inline task.
 195 If prefix arg NO-STATE is set, ignore `org-inlinetask-default-state'."
 196   (interactive "P")
 197   ;; Error when inside an inline task, except if point was at its very
 198   ;; beginning, in which case the new inline task will be inserted
 199   ;; before this one.
 200   (when (and (org-inlinetask-in-task-p)
 201              (not (and (org-inlinetask-at-task-p) (bolp))))
 202     (error "Cannot nest inline tasks"))
 203   (or (bolp) (newline))
 204   (let* ((indent (if org-odd-levels-only
 205                      (1- (* 2 org-inlinetask-min-level))
 206                    org-inlinetask-min-level))
 207          (indent-string (concat (make-string indent ?*) " ")))
 208     (insert indent-string
 209             (if (or no-state (not org-inlinetask-default-state))
 210                 "\n"
 211               (concat org-inlinetask-default-state " \n"))
 212             indent-string "END\n"))
 213   (end-of-line -1))
 214 (define-key org-mode-map "\C-c\C-xt" 'org-inlinetask-insert-task)
 215
 216 (defun org-inlinetask-outline-regexp ()
 217   "Return string matching an inline task heading.
 218 The number of levels is controlled by `org-inlinetask-min-level'."
 219   (let ((nstars (if org-odd-levels-only
 220                     (1- (* org-inlinetask-min-level 2))
 221                   org-inlinetask-min-level)))
 222     (format "^\\(\\*\\{%d,\\}\\)[ \t]+" nstars)))
 223
 224 (defun org-inlinetask-at-task-p ()
 225   "Return true if point is at beginning of an inline task."
 226   (save-excursion
 227     (beginning-of-line)
 228     (and (looking-at (concat (org-inlinetask-outline-regexp)  "\\(.*\\)"))
 229          (not (string-match "^end[ \t]*$" (downcase (match-string 2)))))))
 230
 231 (defun org-inlinetask-in-task-p ()
 232   "Return true if point is inside an inline task."
 233   (save-excursion
 234     (beginning-of-line)
 235     (let* ((case-fold-search t)
 236            (stars-re (org-inlinetask-outline-regexp))
 237            (task-beg-re (concat stars-re "\\(?:.*\\)"))
 238            (task-end-re (concat stars-re "END[ \t]*$")))
 239       (or (org-looking-at-p task-beg-re)
 240           (and (re-search-forward "^\\*+[ \t]+" nil t)
 241                (progn (beginning-of-line) (org-looking-at-p task-end-re)))))))
 242
 243 (defun org-inlinetask-goto-beginning ()
 244   "Go to the beginning of the inline task at point."
 245   (end-of-line)
 246   (let ((case-fold-search t)
 247         (inlinetask-re (org-inlinetask-outline-regexp)))
 248     (re-search-backward inlinetask-re nil t)
 249     (when (org-looking-at-p (concat inlinetask-re "END[ \t]*$"))
 250       (re-search-backward inlinetask-re nil t))))
 251
 252 (defun org-inlinetask-goto-end ()
 253   "Go to the end of the inline task at point.
 254 Return point."
 255   (save-match-data
 256     (beginning-of-line)
 257     (let* ((case-fold-search t)
 258            (inlinetask-re (org-inlinetask-outline-regexp))
 259            (task-end-re (concat inlinetask-re "END[ \t]*$")))
 260       (cond
 261        ((looking-at task-end-re) (forward-line))
 262        ((looking-at inlinetask-re)
 263         (forward-line)
 264         (cond
 265          ((looking-at task-end-re) (forward-line))
 266          ((looking-at inlinetask-re))
 267          ((org-inlinetask-in-task-p)
 268           (re-search-forward inlinetask-re nil t)
 269           (forward-line))))
 270        (t (re-search-forward inlinetask-re nil t)
 271           (forward-line)))
 272       (point))))
 273
 274 (defun org-inlinetask-get-task-level ()
 275   "Get the level of the inline task around.
 276 This assumes the point is inside an inline task."
 277   (save-excursion
 278     (end-of-line)
 279     (re-search-backward (org-inlinetask-outline-regexp) nil t)
 280     (- (match-end 1) (match-beginning 1))))
 281
 282 (defun org-inlinetask-promote ()
 283   "Promote the inline task at point.
 284 If the task has an end part, promote it.  Also, prevents level from
 285 going below `org-inlinetask-min-level'."
 286   (interactive)
 287   (if (not (org-inlinetask-in-task-p))
 288       (error "Not in an inline task")
 289     (save-excursion
 290       (let* ((lvl (org-inlinetask-get-task-level))
 291              (next-lvl (org-get-valid-level lvl -1))
 292              (diff (- next-lvl lvl))
 293              (down-task (concat (make-string next-lvl ?*)))
 294              beg)
 295         (if (< next-lvl org-inlinetask-min-level)
 296             (error "Cannot promote an inline task at minimum level")
 297           (org-inlinetask-goto-beginning)
 298           (setq beg (point))
 299           (replace-match down-task nil t nil 1)
 300           (org-inlinetask-goto-end)
 301           (if (eobp) (beginning-of-line) (forward-line -1))
 302           (unless (= (point) beg)
 303             (replace-match down-task nil t nil 1)
 304             (when org-adapt-indentation
 305               (goto-char beg)
 306               (org-fixup-indentation diff))))))))
 307
 308 (defun org-inlinetask-demote ()
 309   "Demote the inline task at point.
 310 If the task has an end part, also demote it."
 311   (interactive)
 312   (if (not (org-inlinetask-in-task-p))
 313       (error "Not in an inline task")
 314     (save-excursion
 315       (let* ((lvl (org-inlinetask-get-task-level))
 316              (next-lvl (org-get-valid-level lvl 1))
 317              (diff (- next-lvl lvl))
 318              (down-task (concat (make-string next-lvl ?*)))
 319              beg)
 320         (org-inlinetask-goto-beginning)
 321         (setq beg (point))
 322         (replace-match down-task nil t nil 1)
 323         (org-inlinetask-goto-end)
 324         (if (eobp) (beginning-of-line) (forward-line -1))
 325         (unless (= (point) beg)
 326           (replace-match down-task nil t nil 1)
 327           (when org-adapt-indentation
 328             (goto-char beg)
 329             (org-fixup-indentation diff)))))))
 330
 331 (defvar org-export-current-backend) ; dynamically bound in org-exp.el
 332 (defun org-inlinetask-export-handler ()
 333   "Handle headlines with level larger or equal to `org-inlinetask-min-level'.
 334 Either remove headline and meta data, or do special formatting."
 335   (goto-char (point-min))
 336   (let* ((keywords-re (concat "^[ \t]*" org-keyword-time-regexp))
 337          (inline-re (concat (org-inlinetask-outline-regexp) ".*")))
 338     (while (re-search-forward inline-re nil t)
 339       (let ((headline (match-string 0))
 340             (beg (point-at-bol))
 341             (end (copy-marker (save-excursion
 342                                 (org-inlinetask-goto-end) (point))))
 343             content)
 344         ;; Delete SCHEDULED, DEADLINE...
 345         (while (re-search-forward keywords-re end t)
 346           (delete-region (point-at-bol) (1+ (point-at-eol))))
 347         (goto-char beg)
 348         ;; Delete drawers
 349         (while (re-search-forward org-drawer-regexp end t)
 350           (when (save-excursion (re-search-forward org-property-end-re nil t))
 351             (delete-region beg (1+ (match-end 0)))))
 352         ;; Get CONTENT, if any.
 353         (goto-char beg)
 354         (forward-line 1)
 355         (unless (= (point) end)
 356           (setq content (buffer-substring (point)
 357                                           (save-excursion (goto-char end)
 358                                                           (forward-line -1)
 359                                                           (point)))))
 360         ;; Remove the task.
 361         (goto-char beg)
 362         (delete-region beg end)
 363         (when (and org-inlinetask-export
 364                    (assq org-export-current-backend
 365                          org-inlinetask-export-templates))
 366           ;; Format CONTENT, if appropriate.
 367           (setq content
 368                 (if (not (and content (string-match "\\S-" content)))
 369                     ""
 370                   ;; Ensure CONTENT has minimal indentation, a single
 371                   ;; newline character at its boundaries, and isn't
 372                   ;; protected.
 373                   (when (string-match "\\`\\([ \t]*\n\\)+" content)
 374                     (setq content (substring content (match-end 0))))
 375                   (when (string-match "[ \t\n]+\\'" content)
 376                     (setq content (substring content 0 (match-beginning 0))))
 377                   (org-add-props
 378                       (concat "\n\n" (org-remove-indentation content) "\n\n")
 379                       '(org-protected nil org-native-text nil))))
 380
 381           (when (string-match org-complex-heading-regexp headline)
 382             (let* ((nil-to-str
 383                     (function
 384                      ;; Change nil arguments into empty strings.
 385                      (lambda (el) (or (eval el) ""))))
 386                    ;;  Set up keywords provided to templates.
 387                    (todo (or (match-string 2 headline) ""))
 388                    (class (or (and (eq "" todo) "")
 389                               (if (member todo org-done-keywords) "done" "todo")))
 390                    (priority (or (match-string 3 headline) ""))
 391                    (heading (or (match-string 4 headline) ""))
 392                    (tags (or (match-string 5 headline) ""))
 393                    ;; Read `org-inlinetask-export-templates'.
 394                    (backend-spec (assq org-export-current-backend
 395                                        org-inlinetask-export-templates))
 396                    (format-str (org-add-props (nth 1 backend-spec)
 397                                    '(org-protected t org-native-text t)))
 398                    (tokens (cadr (nth 2 backend-spec)))
 399                    ;; Build export string.  Ensure it won't break
 400                    ;; surrounding lists by giving it arbitrary high
 401                    ;; indentation.
 402                    (export-str (org-add-props
 403                                    (eval (append '(format format-str)
 404                                                  (mapcar nil-to-str tokens)))
 405                                    '(original-indentation 1000))))
 406               ;; Ensure task starts a new paragraph.
 407               (unless (or (bobp)
 408                           (save-excursion (forward-line -1)
 409                                           (looking-at "[ \t]*$")))
 410                 (insert "\n"))
 411               (insert export-str)
 412               (unless (bolp) (insert "\n")))))))))
 413
 414 (defun org-inlinetask-get-current-indentation ()
 415   "Get the indentation of the last non-while line above this one."
 416   (save-excursion
 417     (beginning-of-line 1)
 418     (skip-chars-backward " \t\n")
 419     (beginning-of-line 1)
 420     (or (org-at-item-p)
 421         (looking-at "[ \t]*"))
 422     (goto-char (match-end 0))
 423     (current-column)))
 424
 425 (defvar org-indent-indentation-per-level) ; defined in org-indent.el
 426
 427 (defface org-inlinetask
 428   (org-compatible-face 'shadow '((t (:bold t))))
 429   "Face for inlinetask headlines."
 430   :group 'org-faces)
 431
 432 (defun org-inlinetask-fontify (limit)
 433   "Fontify the inline tasks down to LIMIT."
 434   (let* ((nstars (if org-odd-levels-only
 435                      (1- (* 2 (or org-inlinetask-min-level 200)))
 436                    (or org-inlinetask-min-level 200)))
 437          (re (concat "^\\(\\*\\)\\(\\*\\{"
 438                      (format "%d" (- nstars 3))
 439                      ",\\}\\)\\(\\*\\* .*\\)"))
 440          ;; Virtual indentation will add the warning face on the first
 441          ;; star.  Thus, in that case, only hide it.
 442          (start-face (if (and (org-bound-and-true-p org-indent-mode)
 443                               (> org-indent-indentation-per-level 1))
 444                          'org-hide
 445                        'org-warning)))
 446     (while (re-search-forward re limit t)
 447       (if org-inlinetask-show-first-star
 448           (add-text-properties (match-beginning 1) (match-end 1)
 449                                `(face ,start-face font-lock-fontified t)))
 450       (add-text-properties (match-beginning
 451                             (if org-inlinetask-show-first-star 2 1))
 452                            (match-end 2)
 453                            '(face org-hide font-lock-fontified t))
 454       (add-text-properties (match-beginning 3) (match-end 3)
 455                            '(face org-inlinetask font-lock-fontified t)))))
 456
 457 (defun org-inlinetask-toggle-visibility ()
 458   "Toggle visibility of inline task at point."
 459   (let ((end (save-excursion
 460                (org-inlinetask-goto-end)
 461                (if (bolp) (1- (point)) (point))))
 462         (start (save-excursion
 463                  (org-inlinetask-goto-beginning)
 464                  (point-at-eol))))
 465     (cond
 466      ;; Nothing to show/hide.
 467      ((= end start))
 468      ;; Inlinetask was folded: expand it.
 469      ((get-char-property (1+ start) 'invisible)
 470       (org-show-entry))
 471      (t (outline-flag-region start end t)))))
 472
 473 (defun org-inlinetask-remove-END-maybe ()
 474   "Remove an END line when present."
 475   (when (looking-at (format "\\([ \t]*\n\\)*\\*\\{%d,\\}[ \t]+END[ \t]*$"
 476                             org-inlinetask-min-level))
 477     (replace-match "")))
 478
 479 (eval-after-load "org-exp"
 480   '(add-hook 'org-export-preprocess-before-backend-specifics-hook
 481              'org-inlinetask-export-handler))
 482 (eval-after-load "org"
 483   '(add-hook 'org-font-lock-hook 'org-inlinetask-fontify))
 484
 485 (provide 'org-inlinetask)
 486
 487 ;;; org-inlinetask.el ends here