lisp/org-indent.el

   1 ;;; org-indent.el --- Dynamic indentation for  Org-mode
   2 ;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
   3 ;;
   4 ;; Author: Carsten Dominik <carsten at orgmode dot org>
   5 ;; Keywords: outlines, hypermedia, calendar, wp
   6 ;; Homepage: http://orgmode.org
   7 ;;
   8 ;; This file is part of GNU Emacs.
   9 ;;
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14 ;;
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19 ;;
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22 ;;
  23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  24 ;;
  25 ;;; Commentary:
  26
  27 ;; This is an implementation of dynamic virtual indentation.  It works
  28 ;; by adding text properties to a buffer to make sure lines are
  29 ;; indented according to outline structure.
  30 ;;
  31 ;; The process is synchronous, toggled at every buffer modification.
  32 ;; Though, the initialization (indentation of text already in the
  33 ;; buffer), which can take a few seconds in large buffers, happens on
  34 ;; idle time and only when the buffer being initialized is the active
  35 ;; one.
  36 ;;
  37 ;;; Code:
  38
  39 (require 'org-macs)
  40 (require 'org-compat)
  41 (require 'org)
  42
  43 (eval-when-compile
  44   (require 'cl))
  45
  46 (declare-function org-inlinetask-get-task-level "org-inlinetask" ())
  47 (declare-function org-inlinetask-in-task-p "org-inlinetask" ())
  48 (declare-function org-list-item-body-column "org-list" (item))
  49
  50 (defgroup org-indent nil
  51   "Options concerning dynamic virtual outline indentation."
  52   :tag "Org Indent"
  53   :group 'org)
  54
  55 (defconst org-indent-max 40
  56   "Maximum indentation in characters.")
  57 (defconst org-indent-max-levels 20
  58   "Maximum added level through virtual indentation, in
  59 characters.
  60
  61 It is computed by multiplying `org-indent-indentation-per-level'
  62 minus one by actual level of the headline minus one.")
  63
  64 (defvar org-indent-strings nil
  65   "Vector with all indentation strings.
  66 It will be set in `org-indent-initialize'.")
  67 (defvar org-indent-stars nil
  68   "Vector with all indentation star strings.
  69 It will be set in `org-indent-initialize'.")
  70 (defvar org-indent-inlinetask-first-star (org-add-props "*" '(face org-warning))
  71   "First star of inline tasks, with correct face.")
  72 (defvar org-indent-initial-marker nil
  73   "Position of initialization before interrupt.")
  74 (defvar org-indent-initial-timer nil
  75   "Timer used for initialization.")
  76 (defvar org-indent-initial-lock nil
  77   "Lock used of initialization.")
  78 (defvar org-hide-leading-stars-before-indent-mode nil
  79   "Used locally.")
  80 (defvar org-indent-modified-headline-flag nil
  81   "Non nil if the last deletion acted on an headline.
  82 It is modified by `org-indent-notify-modified-headline'.")
  83
  84
  85 (defcustom org-indent-boundary-char ?\   ; comment to protect space char
  86   "The end of the virtual indentation strings, a single-character string.
  87 The default is just a space, but if you wish, you can use \"|\" or so.
  88 This can be useful on a terminal window - under a windowing system,
  89 it may be prettier to customize the org-indent face."
  90   :group 'org-indent
  91   :set (lambda (var val)
  92          (set var val)
  93          (and org-indent-strings (org-indent-initialize)))
  94   :type 'character)
  95
  96 (defcustom org-indent-mode-turns-off-org-adapt-indentation t
  97   "Non-nil means setting the variable `org-indent-mode' will \
  98 turn off indentation adaptation.
  99 For details see the variable `org-adapt-indentation'."
 100   :group 'org-indent
 101   :type 'boolean)
 102
 103 (defcustom org-indent-mode-turns-on-hiding-stars t
 104   "Non-nil means setting the variable `org-indent-mode' will \
 105 turn on `org-hide-leading-stars'."
 106   :group 'org-indent
 107   :type 'boolean)
 108
 109 (defcustom org-indent-indentation-per-level 2
 110   "Indentation per level in number of characters."
 111   :group 'org-indent
 112   :type 'integer)
 113
 114 (defun org-indent-initialize ()
 115   "Initialize the indentation strings."
 116   (setq org-indent-strings (make-vector (1+ org-indent-max) nil))
 117   (setq org-indent-stars (make-vector (1+ org-indent-max) nil))
 118   (aset org-indent-strings 0 nil)
 119   (aset org-indent-stars 0 nil)
 120   (loop for i from 1 to org-indent-max do
 121         (aset org-indent-strings i
 122               (org-add-props
 123                   (concat (make-string (1- i) ?\ )
 124                           (char-to-string org-indent-boundary-char))
 125                   nil 'face 'org-indent)))
 126   (loop for i from 1 to org-indent-max-levels do
 127         (aset org-indent-stars i
 128               (org-add-props (make-string i ?*)
 129                   nil 'face 'org-hide))))
 130
 131 ;;;###autoload
 132 (define-minor-mode org-indent-mode
 133   "When active, indent text according to outline structure.
 134
 135 Internally this works by adding `line-prefix' and `wrap-prefix'
 136 properties, after each buffer modification, on the modified zone.
 137
 138 The process is synchronous.  Though, initial indentation of
 139 buffer, which can take a few seconds on large buffers, is done
 140 during idle time." nil " Ind" nil
 141   (cond
 142    ((org-bound-and-true-p org-inhibit-startup)
 143     (setq org-indent-mode nil))
 144    ((and org-indent-mode (featurep 'xemacs))
 145     (message "org-indent-mode does not work in XEmacs - refusing to turn it on")
 146     (setq org-indent-mode nil))
 147    ((and org-indent-mode
 148          (not (org-version-check "23.1.50" "Org Indent mode" :predicate)))
 149     (message "org-indent-mode can crash Emacs 23.1 - refusing to turn it on!")
 150     (ding)
 151     (sit-for 1)
 152     (setq org-indent-mode nil))
 153    (org-indent-mode
 154     ;; mode was turned on.
 155     (org-set-local 'indent-tabs-mode nil)
 156     (or org-indent-strings (org-indent-initialize))
 157     (org-set-local 'org-indent-initial-marker (copy-marker 1))
 158     (org-set-local 'org-indent-initial-lock nil)
 159     (when org-indent-mode-turns-off-org-adapt-indentation
 160       (org-set-local 'org-adapt-indentation nil))
 161     (when org-indent-mode-turns-on-hiding-stars
 162       (org-set-local 'org-hide-leading-stars-before-indent-mode
 163                      org-hide-leading-stars)
 164       (org-set-local 'org-hide-leading-stars t))
 165     (make-local-variable 'buffer-substring-filters)
 166     (add-to-list 'buffer-substring-filters
 167                  'org-indent-remove-properties-from-string)
 168     (org-add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local)
 169     (org-add-hook 'before-change-functions
 170                   'org-indent-notify-modified-headline nil 'local)
 171     (and font-lock-mode (org-restart-font-lock))
 172     (org-indent-remove-properties (point-min) (point-max))
 173     (org-set-local 'org-indent-initial-timer
 174                    (run-with-idle-timer 0.2 t #'org-indent-initialize-buffer)))
 175    (t
 176     ;; mode was turned off (or we refused to turn it on)
 177     (kill-local-variable 'org-adapt-indentation)
 178     (when (timerp org-indent-initial-timer)
 179       (cancel-timer org-indent-initial-timer))
 180     (when (markerp org-indent-initial-marker)
 181       (set-marker org-indent-initial-marker nil))
 182     (when (boundp 'org-hide-leading-stars-before-indent-mode)
 183       (org-set-local 'org-hide-leading-stars
 184                      org-hide-leading-stars-before-indent-mode))
 185     (setq buffer-substring-filters
 186           (delq 'org-indent-remove-properties-from-string
 187                 buffer-substring-filters))
 188     (remove-hook 'after-change-functions 'org-indent-refresh-maybe 'local)
 189     (remove-hook 'before-change-functions
 190                  'org-indent-notify-modified-headline 'local)
 191     (org-with-wide-buffer
 192      (org-indent-remove-properties (point-min) (point-max)))
 193     (and font-lock-mode (org-restart-font-lock))
 194     (redraw-display))))
 195
 196 (defface org-indent
 197   (org-compatible-face nil nil)
 198   "Face for outline indentation.
 199 The default is to make it look like whitespace.  But you may find it
 200 useful to make it ever so slightly different."
 201   :group 'org-faces)
 202
 203 (defun org-indent-indent-buffer ()
 204   "Add indentation properties to the accessible part of the buffer."
 205   (interactive)
 206   (if (not (org-mode-p))
 207       (error "Not in Org mode")
 208     (message "Setting buffer indentation. It may take a few seconds...")
 209     (org-indent-remove-properties (point-min) (point-max))
 210     (org-indent-add-properties (point-min) (point-max))
 211     (message "Indentation of buffer set.")))
 212
 213 (defsubst org-indent-remove-properties (beg end)
 214   "Remove indentations between BEG and END."
 215   (with-silent-modifications
 216     (remove-text-properties beg end '(line-prefix nil wrap-prefix nil))))
 217
 218 (defun org-indent-remove-properties-from-string (string)
 219   "Remove indentation properties from STRING."
 220   (remove-text-properties 0 (length string)
 221                           '(line-prefix nil wrap-prefix nil) string)
 222   string)
 223
 224 (defun org-indent-initialize-buffer ()
 225   "Set virtual indentation for the whole buffer asynchronously."
 226   (when (and org-indent-mode (not org-indent-initial-lock))
 227     (org-with-wide-buffer
 228      (setq org-indent-initial-lock t)
 229      (let ((interruptp
 230             ;; Always nil unless interrupted.
 231             (catch 'interrupt
 232               (and org-indent-initial-marker
 233                    (marker-position org-indent-initial-marker)
 234                    (org-indent-add-properties org-indent-initial-marker
 235                                               (point-max) t)
 236                    nil))))
 237        (move-marker org-indent-initial-marker interruptp)
 238        ;; Job is complete: stop idle timer.
 239        (unless interruptp (cancel-timer org-indent-initial-timer))))
 240     (setq org-indent-initial-lock nil)))
 241
 242 (defsubst org-indent-set-line-properties (l w h)
 243   "Set prefix properties on current line an move to next one.
 244
 245 Prefix properties `line-prefix' and `wrap-prefix' in current line
 246 are set to, respectively, length L and W.
 247
 248 If H is non-nil, `line-prefix' will be starred.  If H is
 249 `inline', the first star will have `org-warning' face.
 250
 251 Assume point is at bol."
 252   (let ((line (cond
 253                ((eq 'inline h)
 254                 (let ((stars (aref org-indent-stars
 255                                    (min l org-indent-max-levels))))
 256                   (and stars
 257                        (concat org-indent-inlinetask-first-star
 258                                (substring stars 1)))))
 259                (h (aref org-indent-stars
 260                         (min l org-indent-max-levels)))
 261                (t (aref org-indent-strings
 262                         (min l org-indent-max)))))
 263         (wrap (aref org-indent-strings (min w org-indent-max))))
 264     (add-text-properties (point) (point-at-eol)
 265                          `(line-prefix ,line wrap-prefix ,wrap)))
 266   (forward-line 1))
 267
 268 (defun org-indent-add-properties (beg end &optional async)
 269   "Add indentation properties between BEG and END.
 270
 271 If ASYNC is non-nil, allow to interrupt the process.  This is
 272 done by throwing the `interrupt' tag along with the buffer
 273 position where the process stopped.  Be sure to catch this tag if
 274 you want to use this feature."
 275   (save-match-data
 276     (org-with-wide-buffer
 277      (goto-char beg)
 278      (beginning-of-line)
 279      ;; 1. Initialize prefix at BEG.  This is done by storing two
 280      ;;    variables: INLINE-PF and PF, representing respectively
 281      ;;    length of current `line-prefix' when line is inside an
 282      ;;    inline task or not.
 283      (let* ((case-fold-search t)
 284             (limited-re (org-get-limited-outline-regexp))
 285             (added-ind-per-lvl (1- org-indent-indentation-per-level))
 286             (pf (save-excursion
 287                   (and (ignore-errors (let ((outline-regexp limited-re))
 288                                         (org-back-to-heading t)))
 289                        (+ (* org-indent-indentation-per-level
 290                              (- (match-end 0) (match-beginning 0) 2)) 2))))
 291             (pf-inline (and (featurep 'org-inlinetask)
 292                             (org-inlinetask-in-task-p)
 293                             (+ (* org-indent-indentation-per-level
 294                                   (1- (org-inlinetask-get-task-level))) 2))))
 295        ;; 2. For each line, set `line-prefix' and `wrap-prefix'
 296        ;;    properties depending on the type of line (headline,
 297        ;;    inline task, item or other).
 298        (with-silent-modifications
 299          (while (< (point) end)
 300            (cond
 301             ;; When in async mode, check if interrupt is required.
 302             ((and async (input-pending-p)) (throw 'interrupt (point)))
 303             ;; Empty line: do nothing.
 304             ((eolp) (forward-line 1))
 305             ;; Headline or inline task.
 306             ((looking-at org-outline-regexp)
 307              (let* ((nstars (- (match-end 0) (match-beginning 0) 1))
 308                     (line (* added-ind-per-lvl (1- nstars)))
 309                     (wrap (+ line (1+ nstars))))
 310                (cond
 311                 ;; Headline: new value for PF.
 312                 ((looking-at limited-re)
 313                  (org-indent-set-line-properties line wrap t)
 314                  (setq pf wrap))
 315                 ;; End of inline task: PF-INLINE is now nil.
 316                 ((looking-at "\\*+ end[ \t]*$")
 317                  (org-indent-set-line-properties line wrap 'inline)
 318                  (setq pf-inline nil))
 319                 ;; Start of inline task.  Determine if it contains
 320                 ;; text, or if it is only one line long.  Set
 321                 ;; PF-INLINE accordingly.
 322                 (t (org-indent-set-line-properties line wrap 'inline)
 323                    (setq pf-inline (and (org-inlinetask-in-task-p) wrap))))))
 324             ;; List item: `wrap-prefix' is set where body starts.
 325             ((org-at-item-p)
 326              (let* ((line (or pf-inline pf 0))
 327                     (wrap (+ (org-list-item-body-column (point)) line)))
 328                (org-indent-set-line-properties line wrap nil)))
 329             ;; Normal line: use PF-INLINE, PF or nil as prefixes.
 330             (t (let* ((line (or pf-inline pf 0))
 331                       (wrap (+ line (org-get-indentation))))
 332                  (org-indent-set-line-properties line wrap nil))))))))))
 333
 334 (defun org-indent-notify-modified-headline (beg end)
 335   "Set `org-indent-modified-headline-flag' depending on context.
 336
 337 BEG and END are the positions of the beginning and end of the
 338 range of deleted text.
 339
 340 This function is meant to be called by `before-change-functions'.
 341 Flag will be non-nil if command is going to modify or delete an
 342 headline."
 343   (when org-indent-mode
 344     (setq org-indent-modified-headline-flag
 345           (save-excursion
 346             (goto-char beg)
 347             (save-match-data
 348               (or (and (org-at-heading-p) (< beg (match-end 0)))
 349                   (re-search-forward org-outline-regexp-bol end t)))))))
 350
 351 (defun org-indent-refresh-maybe (beg end dummy)
 352   "Refresh indentation properties in an adequate portion of buffer.
 353 BEG and END are the positions of the beginning and end of the
 354 range of inserted text.  DUMMY is an unused argument.
 355
 356 This function is meant to be called by `after-change-functions'."
 357   (when org-indent-mode
 358     (save-match-data
 359       ;; If an headline was modified or inserted, set properties until
 360       ;; next headline.
 361       (if (or org-indent-modified-headline-flag
 362               (save-excursion
 363                 (goto-char beg)
 364                 (re-search-forward org-outline-regexp-bol end t)))
 365         (let ((end (save-excursion
 366                      (goto-char end)
 367                      (org-with-limited-levels (outline-next-heading))
 368                      (point))))
 369           (setq org-indent-modified-headline-flag nil)
 370           (org-indent-add-properties beg end))
 371         ;; Otherwise, only set properties on modified area.
 372         (org-indent-add-properties beg end)))))
 373
 374 (provide 'org-indent)
 375
 376 ;;; org-indent.el ends here