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-resume-timer nil
  77   "Timer used to reschedule initialization process.")
  78 (defvar org-indent-initial-process-duration '(0 2 0)
  79   "How long before initialization gives hand to other idle processes.")
  80 (defvar org-indent-initial-resume-delay '(0 0 200000)
  81   "How long before resuming initialization process.")
  82 (defvar org-indent-initial-lock nil
  83   "Lock used of initialization.")
  84 (defvar org-hide-leading-stars-before-indent-mode nil
  85   "Used locally.")
  86 (defvar org-indent-modified-headline-flag nil
  87   "Non nil if the last deletion acted on an headline.
  88 It is modified by `org-indent-notify-modified-headline'.")
  89
  90
  91 (defcustom org-indent-boundary-char ?\   ; comment to protect space char
  92   "The end of the virtual indentation strings, a single-character string.
  93 The default is just a space, but if you wish, you can use \"|\" or so.
  94 This can be useful on a terminal window - under a windowing system,
  95 it may be prettier to customize the org-indent face."
  96   :group 'org-indent
  97   :set (lambda (var val)
  98          (set var val)
  99          (and org-indent-strings (org-indent-initialize)))
 100   :type 'character)
 101
 102 (defcustom org-indent-mode-turns-off-org-adapt-indentation t
 103   "Non-nil means setting the variable `org-indent-mode' will \
 104 turn off indentation adaptation.
 105 For details see the variable `org-adapt-indentation'."
 106   :group 'org-indent
 107   :type 'boolean)
 108
 109 (defcustom org-indent-mode-turns-on-hiding-stars t
 110   "Non-nil means setting the variable `org-indent-mode' will \
 111 turn on `org-hide-leading-stars'."
 112   :group 'org-indent
 113   :type 'boolean)
 114
 115 (defcustom org-indent-indentation-per-level 2
 116   "Indentation per level in number of characters."
 117   :group 'org-indent
 118   :type 'integer)
 119
 120 (defface org-indent
 121   (org-compatible-face nil nil)
 122   "Face for outline indentation.
 123 The default is to make it look like whitespace.  But you may find it
 124 useful to make it ever so slightly different."
 125   :group 'org-faces)
 126
 127 (defun org-indent-initialize ()
 128   "Initialize the indentation strings."
 129   (setq org-indent-strings (make-vector (1+ org-indent-max) nil))
 130   (setq org-indent-stars (make-vector (1+ org-indent-max) nil))
 131   (aset org-indent-strings 0 nil)
 132   (aset org-indent-stars 0 nil)
 133   (loop for i from 1 to org-indent-max do
 134         (aset org-indent-strings i
 135               (org-add-props
 136                   (concat (make-string (1- i) ?\ )
 137                           (char-to-string org-indent-boundary-char))
 138                   nil 'face 'org-indent)))
 139   (loop for i from 1 to org-indent-max-levels do
 140         (aset org-indent-stars i
 141               (org-add-props (make-string i ?*)
 142                   nil 'face 'org-hide))))
 143
 144 (defsubst org-indent-remove-properties (beg end)
 145   "Remove indentations between BEG and END."
 146   (with-silent-modifications
 147     (remove-text-properties beg end '(line-prefix nil wrap-prefix nil))))
 148
 149 ;;;###autoload
 150 (define-minor-mode org-indent-mode
 151   "When active, indent text according to outline structure.
 152
 153 Internally this works by adding `line-prefix' and `wrap-prefix'
 154 properties, after each buffer modification, on the modified zone.
 155
 156 The process is synchronous.  Though, initial indentation of
 157 buffer, which can take a few seconds on large buffers, is done
 158 during idle time." nil " Ind" nil
 159   (cond
 160    ((org-bound-and-true-p org-inhibit-startup)
 161     (setq org-indent-mode nil))
 162    ((and org-indent-mode (featurep 'xemacs))
 163     (message "org-indent-mode does not work in XEmacs - refusing to turn it on")
 164     (setq org-indent-mode nil))
 165    ((and org-indent-mode
 166          (not (org-version-check "23.1.50" "Org Indent mode" :predicate)))
 167     (message "org-indent-mode can crash Emacs 23.1 - refusing to turn it on!")
 168     (ding)
 169     (sit-for 1)
 170     (setq org-indent-mode nil))
 171    (org-indent-mode
 172     ;; mode was turned on.
 173     (org-set-local 'indent-tabs-mode nil)
 174     (or org-indent-strings (org-indent-initialize))
 175     (org-set-local 'org-indent-initial-marker (copy-marker 1))
 176     (org-set-local 'org-indent-initial-lock nil)
 177     (when org-indent-mode-turns-off-org-adapt-indentation
 178       (org-set-local 'org-adapt-indentation nil))
 179     (when org-indent-mode-turns-on-hiding-stars
 180       (org-set-local 'org-hide-leading-stars-before-indent-mode
 181                      org-hide-leading-stars)
 182       (org-set-local 'org-hide-leading-stars t))
 183     (make-local-variable 'buffer-substring-filters)
 184     (add-to-list 'buffer-substring-filters
 185                  'org-indent-remove-properties-from-string)
 186     (org-add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local)
 187     (org-add-hook 'before-change-functions
 188                   'org-indent-notify-modified-headline nil 'local)
 189     (and font-lock-mode (org-restart-font-lock))
 190     (org-indent-remove-properties (point-min) (point-max))
 191     (org-set-local 'org-indent-initial-timer
 192                    (run-with-idle-timer 0.2 t #'org-indent-initialize-buffer)))
 193    (t
 194     ;; mode was turned off (or we refused to turn it on)
 195     (kill-local-variable 'org-adapt-indentation)
 196     (when (timerp org-indent-initial-timer)
 197       (cancel-timer org-indent-initial-timer))
 198     (when (markerp org-indent-initial-marker)
 199       (set-marker org-indent-initial-marker nil))
 200     (when (boundp 'org-hide-leading-stars-before-indent-mode)
 201       (org-set-local 'org-hide-leading-stars
 202                      org-hide-leading-stars-before-indent-mode))
 203     (setq buffer-substring-filters
 204           (delq 'org-indent-remove-properties-from-string
 205                 buffer-substring-filters))
 206     (remove-hook 'after-change-functions 'org-indent-refresh-maybe 'local)
 207     (remove-hook 'before-change-functions
 208                  'org-indent-notify-modified-headline 'local)
 209     (org-with-wide-buffer
 210      (org-indent-remove-properties (point-min) (point-max)))
 211     (and font-lock-mode (org-restart-font-lock))
 212     (redraw-display))))
 213
 214 (defun org-indent-indent-buffer ()
 215   "Add indentation properties to the accessible part of the buffer."
 216   (interactive)
 217   (if (not (org-mode-p))
 218       (error "Not in Org mode")
 219     (message "Setting buffer indentation. It may take a few seconds...")
 220     (org-indent-remove-properties (point-min) (point-max))
 221     (org-indent-add-properties (point-min) (point-max))
 222     (message "Indentation of buffer set.")))
 223
 224 (defun org-indent-remove-properties-from-string (string)
 225   "Remove indentation properties from STRING."
 226   (remove-text-properties 0 (length string)
 227                           '(line-prefix nil wrap-prefix nil) string)
 228   string)
 229
 230 (defun org-indent-initialize-buffer ()
 231   "Set virtual indentation for the whole buffer asynchronously."
 232   (when (and org-indent-mode (not org-indent-initial-lock))
 233     ;; Clean reschedule timer (cf `org-indent-add-properties').
 234     (when org-indent-initial-resume-timer
 235       (cancel-timer org-indent-initial-resume-timer))
 236     (org-with-wide-buffer
 237      (setq org-indent-initial-lock t)
 238      (let ((interruptp
 239             ;; Always nil unless interrupted.
 240             (catch 'interrupt
 241               (and org-indent-initial-marker
 242                    (marker-position org-indent-initial-marker)
 243                    (org-indent-add-properties org-indent-initial-marker
 244                                               (point-max) t)
 245                    nil))))
 246        (move-marker org-indent-initial-marker interruptp)
 247        ;; Job is complete: stop idle timer.
 248        (unless interruptp (cancel-timer org-indent-initial-timer))))
 249     (setq org-indent-initial-lock nil)))
 250
 251 (defsubst org-indent-set-line-properties (l w h)
 252   "Set prefix properties on current line an move to next one.
 253
 254 Prefix properties `line-prefix' and `wrap-prefix' in current line
 255 are set to, respectively, length L and W.
 256
 257 If H is non-nil, `line-prefix' will be starred.  If H is
 258 `inline', the first star will have `org-warning' face.
 259
 260 Assume point is at beginning of line."
 261   (let ((line (cond
 262                ((eq 'inline h)
 263                 (let ((stars (aref org-indent-stars
 264                                    (min l org-indent-max-levels))))
 265                   (and stars
 266                        (concat org-indent-inlinetask-first-star
 267                                (substring stars 1)))))
 268                (h (aref org-indent-stars
 269                         (min l org-indent-max-levels)))
 270                (t (aref org-indent-strings
 271                         (min l org-indent-max)))))
 272         (wrap (aref org-indent-strings (min w org-indent-max))))
 273     ;; Add properties down to the next line to indent empty lines.
 274     (add-text-properties (point) (min (1+ (point-at-eol)) (point-max))
 275                          `(line-prefix ,line wrap-prefix ,wrap)))
 276   (forward-line 1))
 277
 278 (defun org-indent-add-properties (beg end &optional async)
 279   "Add indentation properties between BEG and END.
 280
 281 If ASYNC is non-nil, allow to interrupt the process.  This is
 282 done by throwing the `interrupt' tag along with the buffer
 283 position where the process stopped.  Be sure to catch this tag if
 284 you want to use this feature."
 285   (save-match-data
 286     (org-with-wide-buffer
 287      (goto-char beg)
 288      (beginning-of-line)
 289      ;; 1. Initialize prefix at BEG.  This is done by storing two
 290      ;;    variables: INLINE-PF and PF, representing respectively
 291      ;;    length of current `line-prefix' when line is inside an
 292      ;;    inline task or not.
 293      (let* ((case-fold-search t)
 294             (limited-re (org-get-limited-outline-regexp))
 295             (added-ind-per-lvl (1- org-indent-indentation-per-level))
 296             (pf (save-excursion
 297                   (and (ignore-errors (let ((outline-regexp limited-re))
 298                                         (org-back-to-heading t)))
 299                        (+ (* org-indent-indentation-per-level
 300                              (- (match-end 0) (match-beginning 0) 2)) 2))))
 301             (pf-inline (and (featurep 'org-inlinetask)
 302                             (org-inlinetask-in-task-p)
 303                             (+ (* org-indent-indentation-per-level
 304                                   (1- (org-inlinetask-get-task-level))) 2)))
 305             (time-limit (time-add (current-time)
 306                                   org-indent-initial-process-duration)))
 307        ;; 2. For each line, set `line-prefix' and `wrap-prefix'
 308        ;;    properties depending on the type of line (headline,
 309        ;;    inline task, item or other).
 310        (with-silent-modifications
 311          (while (and (<= (point) end) (not (eobp)))
 312            (cond
 313             ;; When in async mode, check if interrupt is required.
 314             ((and async (input-pending-p)) (throw 'interrupt (point)))
 315             ;; In async mode, take a break of
 316             ;; `org-indent-initial-resume-delay' every
 317             ;; `org-indent-initial-process-duration' to avoid blocking
 318             ;; any other idle timer or process output.
 319             ((and async (time-less-p time-limit (current-time)))
 320              (setq org-indent-initial-resume-timer
 321                    (run-with-idle-timer
 322                     (time-add (current-idle-time)
 323                               org-indent-initial-resume-delay)
 324                     nil #'org-indent-initialize-buffer))
 325              (throw 'interrupt (point)))
 326             ;; Headline or inline task.
 327             ((looking-at org-outline-regexp)
 328              (let* ((nstars (- (match-end 0) (match-beginning 0) 1))
 329                     (line (* added-ind-per-lvl (1- nstars)))
 330                     (wrap (+ line (1+ nstars))))
 331                (cond
 332                 ;; Headline: new value for PF.
 333                 ((looking-at limited-re)
 334                  (org-indent-set-line-properties line wrap t)
 335                  (setq pf wrap))
 336                 ;; End of inline task: PF-INLINE is now nil.
 337                 ((looking-at "\\*+ end[ \t]*$")
 338                  (org-indent-set-line-properties line wrap 'inline)
 339                  (setq pf-inline nil))
 340                 ;; Start of inline task.  Determine if it contains
 341                 ;; text, or if it is only one line long.  Set
 342                 ;; PF-INLINE accordingly.
 343                 (t (org-indent-set-line-properties line wrap 'inline)
 344                    (setq pf-inline (and (org-inlinetask-in-task-p) wrap))))))
 345             ;; List item: `wrap-prefix' is set where body starts.
 346             ((org-at-item-p)
 347              (let* ((line (or pf-inline pf 0))
 348                     (wrap (+ (org-list-item-body-column (point)) line)))
 349                (org-indent-set-line-properties line wrap nil)))
 350             ;; Normal line: use PF-INLINE, PF or nil as prefixes.
 351             (t (let* ((line (or pf-inline pf 0))
 352                       (wrap (+ line (org-get-indentation))))
 353                  (org-indent-set-line-properties line wrap nil))))))))))
 354
 355 (defun org-indent-notify-modified-headline (beg end)
 356   "Set `org-indent-modified-headline-flag' depending on context.
 357
 358 BEG and END are the positions of the beginning and end of the
 359 range of deleted text.
 360
 361 This function is meant to be called by `before-change-functions'.
 362 Flag will be non-nil if command is going to modify or delete an
 363 headline."
 364   (when org-indent-mode
 365     (setq org-indent-modified-headline-flag
 366           (save-excursion
 367             (goto-char beg)
 368             (save-match-data
 369               (or (and (org-at-heading-p) (< beg (match-end 0)))
 370                   (re-search-forward org-outline-regexp-bol end t)))))))
 371
 372 (defun org-indent-refresh-maybe (beg end dummy)
 373   "Refresh indentation properties in an adequate portion of buffer.
 374 BEG and END are the positions of the beginning and end of the
 375 range of inserted text.  DUMMY is an unused argument.
 376
 377 This function is meant to be called by `after-change-functions'."
 378   (when org-indent-mode
 379     (save-match-data
 380       ;; If an headline was modified or inserted, set properties until
 381       ;; next headline.
 382       (if (or org-indent-modified-headline-flag
 383               (save-excursion
 384                 (goto-char beg)
 385                 (re-search-forward org-outline-regexp-bol end t)))
 386         (let ((end (save-excursion
 387                      (goto-char end)
 388                      (org-with-limited-levels (outline-next-heading))
 389                      (point))))
 390           (setq org-indent-modified-headline-flag nil)
 391           (org-indent-add-properties beg end))
 392         ;; Otherwise, only set properties on modified area.
 393         (org-indent-add-properties beg end)))))
 394
 395 (provide 'org-indent)
 396
 397 ;;; org-indent.el ends here