code.delx.au - gnu-emacs/blob - lisp/org/org-inlinetask.el

   1 ;;; org-inlinetask.el --- Tasks independent of outline hierarchy
   2
   3 ;; Copyright (C) 2009, 2010, 2011 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 ;; Version: 7.4
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27 ;;
  28 ;;; Commentary:
  29 ;;
  30 ;; This module implements inline tasks in Org-mode.  Inline tasks are
  31 ;; tasks that have all the properties of normal outline nodes, including
  32 ;; the ability to store meta data like scheduling dates, TODO state, tags
  33 ;; and properties.  However, these nodes are treated specially by the
  34 ;; visibility cycling and export commands.
  35 ;;
  36 ;; Visibility cycling exempts these nodes from cycling.  So whenever their
  37 ;; parent is opened, so are these tasks.  This will only work with
  38 ;; `org-cycle', so if you are also using other commands to show/hide
  39 ;; entries, you will occasionally find these tasks to behave like
  40 ;; all other outline nodes, seemingly splitting the text of the parent
  41 ;; into children.
  42 ;;
  43 ;; Export commands do not treat these nodes as part of the sectioning
  44 ;; structure, but as a special inline text that is either removed, or
  45 ;; formatted in some special way.
  46 ;;
  47 ;; Special fontification of inline tasks, so that they can be immediately
  48 ;; recognized.  From the stars of the headline, only the first and the
  49 ;; last two will be visible, the others will be hidden using the
  50 ;; `org-hide' face.
  51 ;;
  52 ;; An inline task is identified solely by a minimum outline level, given
  53 ;; by the variable `org-inlinetask-min-level', default 15.
  54 ;;
  55 ;; Inline tasks are normally assumed to contain at most a time planning
  56 ;; line (DEADLINE etc) after it, and then any number of drawers, for
  57 ;; example LOGBOOK of PROPERTIES.  No empty lines are allowed.
  58 ;; If you need to have normal text as part of an inline task, you
  59 ;; can do so by adding an "END" headline with the same number of stars,
  60 ;; for example
  61 ;;
  62 ;;    **************** TODO some small task
  63 ;;                     DEADLINE: <2009-03-30 Mon>
  64 ;;                     :PROPERTIES:
  65 ;;                       :SOMETHING: or other
  66 ;;                     :END:
  67 ;;                     And here is some extra text
  68 ;;    **************** END
  69 ;;
  70 ;; Also, if you want to use refiling and archiving for inline tasks,
  71 ;; The END line must be present to make things work properly.
  72 ;;
  73 ;; This package installs one new command:
  74 ;;
  75 ;; C-c C-x t      Insert a new inline task with END line
  76
  77 ;;; Code:
  78
  79 (require 'org)
  80
  81 (defgroup org-inlinetask nil
  82   "Options concerning inline tasks in Org mode."
  83   :tag "Org Inline Tasks"
  84   :group 'org-structure)
  85
  86 (defcustom org-inlinetask-min-level 15
  87   "Minimum level a headline must have before it is treated as an inline task.
  88 It is strongly recommended that you set `org-cycle-max-level' not at all,
  89 or to a number smaller than this one.  In fact, when `org-cycle-max-level' is
  90 not set, it will be assumed to be one less than the value of smaller than
  91 the value of this variable."
  92   :group 'org-inlinetask
  93   :type '(choice
  94           (const :tag "Off" nil)
  95           (integer)))
  96
  97 (defcustom org-inlinetask-export t
  98   "Non-nil means export inline tasks.
  99 When nil, they will not be exported."
 100   :group 'org-inlinetask
 101   :type 'boolean)
 102
 103 (defvar org-inlinetask-export-templates
 104   '((html "<pre class=\"inlinetask\"><b>%s%s</b><br>%s</pre>"
 105           '((unless (eq todo "")
 106               (format "<span class=\"%s %s\">%s%s</span> "
 107                       class todo todo priority))
 108             heading content))
 109     (latex "\\begin\{description\}\\item[%s%s]%s\\end\{description\}"
 110            '((unless (eq todo "") (format "\\textsc\{%s%s\} " todo priority))
 111              heading content))
 112     (ascii "     -- %s%s%s"
 113            '((unless (eq todo "") (format "%s%s " todo priority))
 114              heading
 115              (unless (eq content "")
 116                (format "\n         ¦ %s"
 117                        (mapconcat 'identity (org-split-string content "\n")
 118                                   "\n         ¦ ")))))
 119     (docbook "<variablelist>
 120 <varlistentry>
 121 <term>%s%s</term>
 122 <listitem><para>%s</para></listitem>
 123 </varlistentry>
 124 </variablelist>"
 125              '((unless (eq todo "") (format "%s%s " todo priority))
 126                heading content)))
 127   "Templates for inline tasks in various exporters.
 128
 129 This variable is an alist in the shape of (BACKEND STRING OBJECTS).
 130
 131 BACKEND is the name of the backend for the template (ascii, html...).
 132
 133 STRING is a format control string.
 134
 135 OBJECTS is a list of elements to be substituted into the format
 136 string.  They can be of any type, from a string to a form
 137 returning a value (thus allowing conditional insertion).  A nil
 138 object will be substituted as the empty string.  Obviously, there
 139 must be at least as many objects as %-sequences in the format
 140 string.
 141
 142 Moreover, the following special keywords are provided: `todo',
 143 `priority', `heading', `content', `tags'.  If some of them are not
 144 defined in an inline task, their value is the empty string.
 145
 146 As an example, valid associations are:
 147
 148 (html \"<ul><li>%s <p>%s</p></li></ul>\" (heading content))
 149
 150 or, with the additional package \"todonotes\" for LaTeX,
 151
 152 (latex \"\\todo[inline]{\\textbf{\\textsf{%s %s}}\\linebreak{} %s}\"
 153        '((unless (eq todo \"\")
 154            (format \"\\textsc{%s%s}\" todo priority))
 155          heading content)))")
 156
 157 (defvar org-odd-levels-only)
 158 (defvar org-keyword-time-regexp)
 159 (defvar org-drawer-regexp)
 160 (defvar org-complex-heading-regexp)
 161 (defvar org-property-end-re)
 162
 163 (defcustom org-inlinetask-default-state nil
 164   "Non-nil means make inline tasks have a TODO keyword initially.
 165 This should be the state `org-inlinetask-insert-task' should use by
 166 default, or nil of no state should be assigned."
 167   :group 'org-inlinetask
 168   :type '(choice
 169           (const :tag "No state" nil)
 170           (string :tag "Specific state")))
 171
 172 (defun org-inlinetask-insert-task (&optional no-state)
 173   "Insert an inline task.
 174 If prefix arg NO-STATE is set, ignore `org-inlinetask-default-state'."
 175   (interactive "P")
 176   (or (bolp) (newline))
 177   (let ((indent org-inlinetask-min-level))
 178     (if org-odd-levels-only
 179         (setq indent (- (* 2 indent) 1)))
 180     (insert (make-string indent ?*)
 181             (if (or no-state (not org-inlinetask-default-state))
 182                 " \n"
 183               (concat " " org-inlinetask-default-state " \n"))
 184             (make-string indent ?*) " END\n"))
 185   (end-of-line -1))
 186 (define-key org-mode-map "\C-c\C-xt" 'org-inlinetask-insert-task)
 187
 188 (defun org-inlinetask-outline-regexp ()
 189   "Return string matching an inline task heading.
 190 The number of levels is controlled by `org-inlinetask-min-level'."
 191   (let ((nstars (if org-odd-levels-only
 192                     (1- (* org-inlinetask-min-level 2))
 193                   org-inlinetask-min-level)))
 194     (format "^\\(\\*\\{%d,\\}\\)[ \t]+" nstars)))
 195
 196 (defun org-inlinetask-in-task-p ()
 197   "Return true if point is inside an inline task."
 198   (save-excursion
 199     (let* ((stars-re (org-inlinetask-outline-regexp))
 200            (task-beg-re (concat stars-re "\\(?:.*\\)"))
 201            (task-end-re (concat stars-re "\\(?:END\\|end\\)[ \t]*$")))
 202       (beginning-of-line)
 203       (or (looking-at task-beg-re)
 204           (and (re-search-forward "^\\*+[ \t]+" nil t)
 205                (progn (beginning-of-line) (looking-at task-end-re)))))))
 206
 207 (defun org-inlinetask-goto-beginning ()
 208   "Go to the beginning of the inline task at point."
 209   (end-of-line)
 210   (re-search-backward (org-inlinetask-outline-regexp) nil t)
 211   (when (org-looking-at-p (concat (org-inlinetask-outline-regexp) "END[ \t]*$"))
 212     (re-search-backward (org-inlinetask-outline-regexp) nil t)))
 213
 214 (defun org-inlinetask-goto-end ()
 215   "Go to the end of the inline task at point."
 216   (beginning-of-line)
 217   (cond
 218    ((org-looking-at-p (concat (org-inlinetask-outline-regexp) "END[ \t]*$"))
 219     (forward-line 1))
 220    ((org-looking-at-p (org-inlinetask-outline-regexp))
 221     (forward-line 1)
 222     (when (org-inlinetask-in-task-p)
 223       (re-search-forward (org-inlinetask-outline-regexp) nil t)
 224       (forward-line 1)))
 225    (t
 226     (re-search-forward (org-inlinetask-outline-regexp) nil t)
 227     (forward-line 1))))
 228
 229 (defun org-inlinetask-get-task-level ()
 230   "Get the level of the inline task around.
 231 This assumes the point is inside an inline task."
 232   (save-excursion
 233     (end-of-line)
 234     (re-search-backward (org-inlinetask-outline-regexp) nil t)
 235     (- (match-end 1) (match-beginning 1))))
 236
 237 (defvar backend) ; dynamically scoped into the next function
 238 (defun org-inlinetask-export-handler ()
 239   "Handle headlines with level larger or equal to `org-inlinetask-min-level'.
 240 Either remove headline and meta data, or do special formatting."
 241   (goto-char (point-min))
 242   (let* ((nstars (if org-odd-levels-only
 243                      (1- (* 2 (or org-inlinetask-min-level 200)))
 244                    (or org-inlinetask-min-level 200)))
 245          (re1 (format "^\\(\\*\\{%d,\\}\\) .*\n" nstars))
 246          (re2 (concat "^[ \t]*" org-keyword-time-regexp))
 247          headline beg end stars content)
 248     (while (re-search-forward re1 nil t)
 249       (setq headline (match-string 0)
 250             stars (match-string 1)
 251             content nil)
 252       (replace-match "")
 253       (while (looking-at re2)
 254         (delete-region (point) (1+ (point-at-eol))))
 255       (while (looking-at org-drawer-regexp)
 256         (setq beg (point))
 257         (if (re-search-forward org-property-end-re nil t)
 258             (delete-region beg (1+ (match-end 0)))))
 259       (setq beg (point))
 260       (when (and (re-search-forward "^\\(\\*+\\) " nil t)
 261                  (= (length (match-string 1)) (length stars))
 262                  (progn (goto-char (match-end 0))
 263                         (looking-at "END[ \t]*$")))
 264         (setq content (buffer-substring beg (1- (point-at-bol))))
 265         (delete-region beg (1+ (match-end 0))))
 266       (goto-char beg)
 267       (when org-inlinetask-export
 268         ;; content formatting
 269         (when content
 270             (if (not (string-match "\\S-" content))
 271                 (setq content nil)
 272               (if (string-match "[ \t\n]+\\'" content)
 273                   (setq content (substring content 0 (match-beginning 0))))
 274               (setq content (org-remove-indentation content))))
 275         (setq content (or content ""))
 276         ;; grab elements to export
 277         (when (string-match org-complex-heading-regexp headline)
 278           (let* ((todo (or (match-string 2 headline) ""))
 279                  (class (or (and (eq "" todo) "")
 280                             (if (member todo org-done-keywords) "done" "todo")))
 281                  (priority (or (match-string 3 headline) ""))
 282                  (heading (or (match-string 4 headline) ""))
 283                  (tags (or (match-string 5 headline) ""))
 284                  (backend-spec (assq backend org-inlinetask-export-templates))
 285                  (format-str (nth 1 backend-spec))
 286                  (tokens (cadr (nth 2 backend-spec)))
 287                  ;; change nil arguments into empty strings
 288                  (nil-to-str (lambda (el) (or (eval el) "")))
 289                  ;; build and protect export string
 290                  (export-str (org-add-props
 291                                  (eval (append '(format format-str)
 292                                                (mapcar nil-to-str tokens)))
 293                                  nil 'org-protected t)))
 294             ;; eventually insert it
 295             (insert export-str "\n")))))))
 296
 297 (defun org-inlinetask-get-current-indentation ()
 298   "Get the indentation of the last non-while line above this one."
 299   (save-excursion
 300     (beginning-of-line 1)
 301     (skip-chars-backward " \t\n")
 302     (beginning-of-line 1)
 303     (or (org-at-item-p)
 304         (looking-at "[ \t]*"))
 305     (goto-char (match-end 0))
 306     (current-column)))
 307
 308 (defun org-inlinetask-fontify (limit)
 309   "Fontify the inline tasks."
 310   (let* ((nstars (if org-odd-levels-only
 311                      (1- (* 2 (or org-inlinetask-min-level 200)))
 312                    (or org-inlinetask-min-level 200)))
 313          (re (concat "^\\(\\*\\)\\(\\*\\{"
 314                     (format "%d" (- nstars 3))
 315                     ",\\}\\)\\(\\*\\* .*\\)")))
 316     (while (re-search-forward re limit t)
 317       (add-text-properties (match-beginning 1) (match-end 1)
 318                            '(face org-warning font-lock-fontified t))
 319       (add-text-properties (match-beginning 2) (match-end 2)
 320                            '(face org-hide font-lock-fontified t))
 321       (add-text-properties (match-beginning 3) (match-end 3)
 322                            '(face shadow font-lock-fontified t)))))
 323
 324 (defun org-inlinetask-remove-END-maybe ()
 325   "Remove an END line when present."
 326   (when (looking-at (format "\\([ \t]*\n\\)*\\*\\{%d,\\}[ \t]+END[ \t]*$"
 327                             org-inlinetask-min-level))
 328     (replace-match "")))
 329
 330 (eval-after-load "org-exp"
 331   '(add-hook 'org-export-preprocess-after-tree-selection-hook
 332              'org-inlinetask-export-handler))
 333 (eval-after-load "org"
 334   '(add-hook 'org-font-lock-hook 'org-inlinetask-fontify))
 335
 336 (provide 'org-inlinetask)
 337
 338 ;;; org-inlinetask.el ends here