EXPERIMENTAL/org-indent.el

   1 ;; Need to hook into demotion, promotion functions:  Redo the entire subtree
   2
   3 ;; Problem:  I have this huge list of overlays, should I be able
   4 ;; to reuse them?
   5
   6 ; should be a mode...
   7 (defconst org-indent-strings (make-vector 80 nil))
   8 (loop for i from 0 to 79 do
   9       (aset org-indent-strings i (org-add-props (make-string i ?\ )
  10                                      nil 'face '(:underline nil :background "grey95"))))
  11
  12 (defvar org-indent-overlays nil)
  13 (make-variable-buffer-local 'org-indent-overlays)
  14
  15 (defun org-indent-initialize-buffer ()
  16   (interactive)
  17   (when (org-mode-p)
  18     (org-remove-indent-overlays)
  19     (let (n)
  20       (save-excursion
  21         (save-restriction
  22           (widen)
  23           (goto-char (point-min))
  24           (while (< (point) (point-max))
  25             (cond
  26              ((looking-at outline-regexp)
  27               (setq n (1+ (funcall outline-level))))
  28              (n
  29               (setq ov (org-make-overlay (1- (point)) (point)))
  30               (org-overlay-put ov 'after-string (aref org-indent-strings n))
  31               (org-overlay-put ov 'evaporate t)
  32               (org-overlay-put ov 'rear-sticky nil)
  33               (org-overlay-put ov 'front-sticky nil)
  34               (org-overlay-put ov 'org-indent n)
  35               (push ov org-indent-overlays)))
  36             (beginning-of-line 2)))))))
  37
  38 (run-with-idle-timer 10 t 'org-indent-initialize-buffer)
  39
  40 (defun org-indent-refresh (start end)
  41   "Refresh indentation overlays in the range given."
  42   (save-excursion
  43     (goto-char start)
  44     (when (search-forward "\n" end t)
  45       (goto-char start)
  46       (beginning-of-line 0)
  47       (let ((n (or (get-char-property (max (point-min) (1- (point)))
  48                                       'org-indent) 0))
  49             ov e)
  50         (while (<= (point) end)
  51           (mapc (lambda (x) (if (org-overlay-get x 'org-indent)
  52                                 (if (> (setq e (org-overlay-end x)) (point))
  53                                     (org-move-overlay x (1- e) e)
  54                                   (org-delete-overlay x)
  55                                   (setq org-indent-overlays
  56                                         (delq x org-indent-overlays)))))
  57                 (overlays-at (max (point-min) (1- (point)))))
  58           (cond
  59            ((looking-at outline-regexp)
  60             (setq n (1+ (funcall outline-level))))
  61            (n
  62             (setq ov (org-make-overlay (1- (point)) (point)))
  63             (org-overlay-put ov 'after-string (aref org-indent-strings n))
  64             (org-overlay-put ov 'evaporate t)
  65             (org-overlay-put ov 'rear-sticky nil)
  66             (org-overlay-put ov 'front-sticky nil)
  67             (org-overlay-put ov 'org-indent n)
  68             (push ov org-indent-overlays)))
  69           (beginning-of-line 2))))))
  70
  71 (defun org-remove-indent-overlays ()
  72   (interactive)
  73   (mapc 'org-delete-overlay org-indent-overlays)
  74   (setq org-indent-overlays nil))
  75
  76 (defun org-indent-after-change-function (start end length)
  77   "After change function for org-indent.
  78 Notices when an insert has added some lines and adjusts
  79 the line number extents accordingly."
  80   (if (= start end)
  81       () ;; this is a deletion
  82     (org-indent-refresh start end)))
  83
  84 (add-hook 'after-change-functions 'org-indent-after-change-function)
  85
  86 (defun org-fixup-indentation (diff)
  87   ""
  88   (save-excursion
  89     (let ((end (save-excursion (outline-next-heading)
  90                                (point-marker)))
  91           (prohibit (if (> diff 0)
  92                         "^\\S-"
  93                       (concat "^ \\{0," (int-to-string (- diff)) "\\}\\S-")))
  94           col)
  95       (if (eq org-adapt-indentation 'virtual)
  96           (org-indent-refresh (point) end)
  97         (unless (save-excursion (end-of-line 1)
  98                                 (re-search-forward prohibit end t))
  99           (while (and (< (point) end)
 100                       (re-search-forward "^[ \t]+" end t))
 101             (goto-char (match-end 0))
 102             (setq col (current-column))
 103             (if (< diff 0) (replace-match ""))
 104             (indent-to (+ diff col))))
 105         (move-marker end nil)))))
 106
 107 (setq org-adapt-indentation 'virtual)