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 ;;; Code:
  32
  33 (require 'org-macs)
  34 (require 'org-compat)
  35 (require 'org)
  36
  37 (eval-when-compile
  38   (require 'cl))
  39
  40 (declare-function org-inlinetask-get-task-level "org-inlinetask" ())
  41 (declare-function org-inlinetask-in-task-p "org-inlinetask" ())
  42 (declare-function org-list-item-body-column "org-list" (item))
  43
  44 (defgroup org-indent nil
  45   "Options concerning dynamic virtual outline indentation."
  46   :tag "Org Indent"
  47   :group 'org)
  48
  49 (defconst org-indent-max 40
  50   "Maximum indentation in characters.")
  51 (defconst org-indent-max-levels 20
  52   "Maximum added level through virtual indentation, in
  53 characters.
  54
  55 It is computed by multiplying `org-indent-indentation-per-level'
  56 minus one by actual level of the headline minus one.")
  57
  58 (defvar org-indent-strings nil
  59   "Vector with all indentation strings.
  60 It will be set in `org-indent-initialize'.")
  61 (defvar org-indent-stars nil
  62   "Vector with all indentation star strings.
  63 It will be set in `org-indent-initialize'.")
  64 (defvar org-hide-leading-stars-before-indent-mode nil
  65   "Used locally.")
  66 (defvar org-indent-outline-re (concat "^" outline-regexp)
  67   "Regexp matching and headline or inline task.")
  68 (defvar org-indent-deleted-headline-flag nil
  69   "Non nil if the last deletion acted on an headline.
  70 It is modified by `org-indent-notify-deleted-headline'.")
  71
  72
  73 (defcustom org-indent-boundary-char ?\   ; comment to protect space char
  74   "The end of the virtual indentation strings, a single-character string.
  75 The default is just a space, but if you wish, you can use \"|\" or so.
  76 This can be useful on a terminal window - under a windowing system,
  77 it may be prettier to customize the org-indent face."
  78   :group 'org-indent
  79   :set (lambda (var val)
  80          (set var val)
  81          (and org-indent-strings (org-indent-initialize)))
  82   :type 'character)
  83
  84 (defcustom org-indent-mode-turns-off-org-adapt-indentation t
  85   "Non-nil means setting the variable `org-indent-mode' will \
  86 turn off indentation adaptation.
  87 For details see the variable `org-adapt-indentation'."
  88   :group 'org-indent
  89   :type 'boolean)
  90
  91 (defcustom org-indent-mode-turns-on-hiding-stars t
  92   "Non-nil means setting the variable `org-indent-mode' will \
  93 turn on `org-hide-leading-stars'."
  94   :group 'org-indent
  95   :type 'boolean)
  96
  97 (defcustom org-indent-indentation-per-level 2
  98   "Indentation per level in number of characters."
  99   :group 'org-indent
 100   :type 'integer)
 101
 102 (defun org-indent-initialize ()
 103   "Initialize the indentation strings."
 104   (setq org-indent-strings (make-vector (1+ org-indent-max) nil))
 105   (setq org-indent-stars (make-vector (1+ org-indent-max) nil))
 106   (aset org-indent-strings 0 nil)
 107   (aset org-indent-stars 0 nil)
 108   (loop for i from 1 to org-indent-max do
 109         (aset org-indent-strings i
 110               (org-add-props
 111                   (concat (make-string (1- i) ?\ )
 112                           (char-to-string org-indent-boundary-char))
 113                   nil 'face 'org-indent)))
 114   (loop for i from 1 to org-indent-max-levels do
 115         (aset org-indent-stars i
 116               (org-add-props (make-string i ?*)
 117                   nil 'face 'org-hide))))
 118
 119 ;;;###autoload
 120 (define-minor-mode org-indent-mode
 121   "When active, indent text according to outline structure.
 122
 123
 124 Internally this works by adding `line-prefix' and `wrap-prefix'
 125 properties, after each buffer modifiation, on the modified zone."
 126   nil " Ind" nil
 127   (cond
 128    ((org-bound-and-true-p org-inhibit-startup)
 129     (setq org-indent-mode nil))
 130    ((and org-indent-mode (featurep 'xemacs))
 131     (message "org-indent-mode does not work in XEmacs - refusing to turn it on")
 132     (setq org-indent-mode nil))
 133    ((and org-indent-mode
 134          (not (org-version-check "23.1.50" "Org Indent mode" :predicate)))
 135     (message "org-indent-mode can crash Emacs 23.1 - refusing to turn it on!")
 136     (ding)
 137     (sit-for 1)
 138     (setq org-indent-mode nil))
 139    (org-indent-mode
 140     ;; mode was turned on.
 141     (org-set-local 'indent-tabs-mode nil)
 142     (or org-indent-strings (org-indent-initialize))
 143     (org-indent-indent-buffer)
 144     (when org-indent-mode-turns-off-org-adapt-indentation
 145       (org-set-local 'org-adapt-indentation nil))
 146     (when org-indent-mode-turns-on-hiding-stars
 147       (org-set-local 'org-hide-leading-stars-before-indent-mode
 148                      org-hide-leading-stars)
 149       (org-set-local 'org-hide-leading-stars t))
 150     (make-local-variable 'buffer-substring-filters)
 151     (add-to-list 'buffer-substring-filters
 152                  'org-indent-remove-properties-from-string)
 153     (org-add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local)
 154     (org-add-hook 'before-change-functions
 155                   'org-indent-notify-deleted-headline nil 'local)
 156     (and font-lock-mode (org-restart-font-lock)))
 157    (t
 158     ;; mode was turned off (or we refused to turn it on)
 159     (save-excursion
 160       (save-restriction
 161         (org-indent-remove-properties (point-min) (point-max))
 162         (kill-local-variable 'org-adapt-indentation)
 163         (when (boundp 'org-hide-leading-stars-before-indent-mode)
 164           (org-set-local 'org-hide-leading-stars
 165                          org-hide-leading-stars-before-indent-mode))
 166         (setq buffer-substring-filters
 167               (delq 'org-indent-remove-properties-from-string
 168                     buffer-substring-filters))
 169         (remove-hook 'after-change-functions 'org-indent-refresh-maybe 'local)
 170         (remove-hook 'before-change-functions
 171                      'org-indent-notify-deleted-headline 'local)
 172         (and font-lock-mode (org-restart-font-lock))
 173         (redraw-display))))))
 174
 175
 176 (defface org-indent
 177   (org-compatible-face nil nil)
 178   "Face for outline indentation.
 179 The default is to make it look like whitespace.  But you may find it
 180 useful to make it ever so slightly different."
 181   :group 'org-faces)
 182
 183 (defun org-indent-indent-buffer ()
 184   "Add indentation properties for the whole buffer."
 185   (interactive)
 186   (if (not (org-mode-p))
 187       (error "Buffer major mode must be Org")
 188     (message "Initializing buffer indentation. It may take a few seconds...")
 189     (org-with-wide-buffer
 190      (with-silent-modifications
 191        (org-indent-remove-properties (point-min) (point-max))
 192        (org-indent-add-properties (point-min) (point-max))))
 193     (message "Indentation of buffer initialized.")))
 194
 195 (defsubst org-indent-remove-properties (beg end)
 196   "Remove indentations between BEG and END."
 197   (remove-text-properties beg end '(line-prefix nil wrap-prefix nil)))
 198
 199 (defun org-indent-remove-properties-from-string (string)
 200   "Remove indentation properties from STRING."
 201   (remove-text-properties 0 (length string)
 202                           '(line-prefix nil wrap-prefix nil) string)
 203   string)
 204
 205 (defun org-indent-add-properties (beg end)
 206   "Add indentation properties between BEG and END."
 207   (org-with-wide-buffer
 208     (goto-char beg)
 209     (beginning-of-line)
 210     ;; 1. Initialize prefix at BEG. This is done by storing two
 211     ;;    variables: INLINE-PF and PF, representing respectively
 212     ;;    length of current `line-prefix' when line is inside an
 213     ;;    inline task or not.
 214     (let* ((case-fold-search t)
 215            (limited-re (org-get-limited-outline-regexp))
 216            (added-ind-per-lvl (1- org-indent-indentation-per-level))
 217            (pf (let ((outline-regexp limited-re))
 218                  (save-excursion
 219                    (and (ignore-errors (org-back-to-heading t))
 220                         (looking-at org-outline-regexp)
 221                         (+ (* org-indent-indentation-per-level
 222                               (- (match-end 0) (match-beginning 0) 2)) 2)))))
 223            (pf-inline (and (featurep 'org-inlinetask)
 224                            (org-inlinetask-in-task-p)
 225                            (+ (* org-indent-indentation-per-level
 226                                  (1- (org-inlinetask-get-task-level))) 2)))
 227            (set-prop-and-move
 228             (function
 229              ;; Set prefix properties `line-prefix' and `wrap-prefix'
 230              ;; in current line to, respectively, length L and W and
 231              ;; move forward. If H is non-nil, `line-prefix' will be
 232              ;; starred. Assume point is at bol.
 233              (lambda (l w h)
 234                (let ((line (if h (aref org-indent-stars
 235                                        (min l org-indent-max-levels))
 236                              (aref org-indent-strings
 237                                    (min l org-indent-max))))
 238                      (wrap (aref org-indent-strings (min w org-indent-max))))
 239                 (add-text-properties (point) (point-at-eol)
 240                                      `(line-prefix ,line wrap-prefix ,wrap)))
 241                (forward-line 1)))))
 242       ;; 2. For each line, set `line-prefix' and `wrap-prefix'
 243       ;;    properties depending on the type of line (headline, inline
 244       ;;    task, item or other).
 245       (while (< (point) end)
 246         (cond
 247          ;; Empty line: do nothing.
 248          ((eolp) (forward-line 1))
 249          ;; Headline or inline task.
 250          ((looking-at "\\*+ ")
 251           (let* ((nstars (- (match-end 0) (match-beginning 0) 1))
 252                  (line (* added-ind-per-lvl (1- nstars)))
 253                  (wrap (+ line (1+ nstars))))
 254             (cond
 255              ;; Headline: new value for PF.
 256              ((looking-at limited-re)
 257               (funcall set-prop-and-move line wrap t)
 258               (setq pf wrap))
 259              ;; End of inline task: PF-INLINE is now nil.
 260              ((looking-at "\\*+ end[ \t]*$")
 261               (funcall set-prop-and-move line wrap t)
 262               (setq pf-inline nil))
 263              ;; Start of inline task. Determine if it contains text,
 264              ;; or is only one line long. Set PF-INLINE accordingly.
 265              (t (funcall set-prop-and-move line wrap t)
 266                 (setq pf-inline (and (org-inlinetask-in-task-p) wrap))))))
 267          ;; List item: `wrap-prefix' is set where body starts.
 268          ((org-at-item-p)
 269           (let* ((line (or pf-inline pf 0))
 270                  (wrap (+ (org-list-item-body-column (point)) line)))
 271             (funcall set-prop-and-move line wrap nil)))
 272          ;; Normal line: use PF-INLINE, PF or nil as prefixes.
 273          (t (let* ((line (or pf-inline pf 0))
 274                    (wrap (+ line (org-get-indentation))))
 275               (funcall set-prop-and-move line wrap nil))))))))
 276
 277 (defun org-indent-notify-deleted-headline (beg end)
 278   "Set `org-indent-deleted-headline-flag' depending on the current command.
 279
 280 BEG and END are the positions of the beginning and end of the
 281 range of deleted text.
 282
 283 This function is meant to be called by `before-change-functions'.
 284 Flag will be non-nil if command is going to delete an headline."
 285   (setq org-indent-deleted-headline-flag
 286         (and (/= beg end)
 287              (save-excursion
 288                (goto-char beg)
 289                (re-search-forward org-indent-outline-re end t)))))
 290                (save-match-data
 291                  (re-search-forward org-outline-regexp-bol end t))))))
 292
 293 (defun org-indent-refresh-maybe (beg end dummy)
 294   "Refresh indentation properties in an adequate portion of buffer.
 295 BEG and END are the positions of the beginning and end of the
 296 range of inserted text.  DUMMY is an unused argument.
 297
 298 This function is meant to be called by `after-change-functions'."
 299   (when org-indent-mode
 300     (save-match-data
 301       (cond
 302        ;; An headline was deleted.
 303        (org-indent-deleted-headline-flag
 304         (setq org-indent-deleted-headline-flag nil)
 305         (let ((end (save-excursion (outline-next-heading) (point))))
 306           (org-indent-remove-properties beg end)
 307           (org-indent-add-properties beg end)))
 308        ;; An headline was inserted.
 309        ((and (/= beg end)
 310              (save-excursion
 311                (goto-char beg)
 312                (re-search-forward org-indent-outline-re end t)))
 313         (let ((end (save-excursion
 314                      (goto-char end) (outline-next-heading) (point))))
 315           (org-indent-remove-properties beg end)
 316           (org-indent-add-properties beg end)))
 317        ;; At an headline, modifying stars.
 318        ((save-excursion (goto-char beg)
 319                         (and (org-at-heading-p) (< beg (match-end 0))))
 320         (let ((beg (point-at-bol))
 321               (end (save-excursion (outline-next-heading) (point))))
 322           (org-indent-remove-properties beg end)
 323           (org-indent-add-properties beg end)))
 324        ;; Else, refresh properties of modified area.
 325        (t (org-indent-add-properties beg end))))))
 326
 327 (provide 'org-indent)
 328
 329 ;;; org-indent.el ends here