Re: [O] Weight of headers

[François Pinard]

Nicolas Goaziou <address@hidden> writes:

> address@hidden (François Pinard) writes:

>> My need here is to get an estimate of the weight of displayed headers.

> The following function will give you the number of sub-headings and
> paragraphs (or equivalent, i.e. tables verse-blocks....).

Wow, thanks!  That was a real good starter.

Roughly copying code from here and there (and not even understanding it,
some dead code might remain), I turned your function into the following:

--8<---------------cut here---------------start------------->8---
(defun fp-org-weight-display ()
  "Show header weights in the entire buffer.

Use \\[fp-org-weight-remove-overlays] to remove the header weights."
  (interactive)
  (fp-org-weight-remove-overlays)
  (let (weights)
      (save-excursion
        (goto-char (point-min))
        (outline-next-visible-heading 1)
        (while (not (eobp))
          (save-excursion
            (fp-org-weight-put-overlay (fp-org-weights-at-point)
                                     (funcall outline-level)))
          (outline-next-visible-heading 1))
        ;; Arrange to remove the overlays upon next change.
        (when org-remove-highlights-with-change
          (org-add-hook 'before-change-functions 'fp-org-weight-remove-overlays
                        nil 'local)))))

(defvar fp-org-weight-overlays nil)
(make-variable-buffer-local 'fp-org-weight-overlays)

(defun fp-org-weight-put-overlay (weights &optional level)
  "Put an overlays on the current line, displaying WEIGHTS.
If LEVEL is given, prefix weights with a corresponding number of stars.
This creates a new overlay and stores it in `fp-org-weight-overlays', so that it
will be easy to remove."
  (let* ((c 60)
         (l (if level (org-get-valid-level level 0) 0))
         (off 0)
         ov tx)
    (org-move-to-column c)
    (unless (eolp) (skip-chars-backward "^ \t"))
    (skip-chars-backward " \t")
    (setq ov (make-overlay (1- (point)) (point-at-eol))
          tx (concat (buffer-substring (1- (point)) (point))
                     (make-string (+ off (max 0 (- c (current-column)))) ?.)
                     (org-add-props (format "%s %3d headings %4d paragraphs%s"
                                            (make-string l ?*)
                                            (car weights)
                                            (cdr weights)
                                            (make-string (- 16 l) ?\ ))
                         (list 'face 'org-clock-overlay))
                     ""))
    (if (not (featurep 'xemacs))
        (overlay-put ov 'display tx)
      (overlay-put ov 'invisible t)
      (overlay-put ov 'end-glyph (make-glyph tx)))
    (push ov fp-org-weight-overlays)))

(defun fp-org-weight-remove-overlays (&optional beg end noremove)
  "Remove the occur highlights from the buffer.
BEG and END are ignored.  If NOREMOVE is nil, remove this function
from the `before-change-functions' in the current buffer."
  (interactive)
  (unless org-inhibit-highlight-removal
    (mapc 'delete-overlay fp-org-weight-overlays)
    (setq fp-org-weight-overlays nil)
    (unless noremove
      (remove-hook 'before-change-functions
                   'fp-org-weight-remove-overlays 'local))))

;; Compliment of Nicolas Goaziou <address@hidden>, 2012-02-26
(defun fp-org-weights-at-point ()
  "Return cons of number of subtrees and paragraphs in the subtree at point.
Paragraphs (also encompasses equivalent structures)."
  (org-with-wide-buffer
   (org-narrow-to-subtree)
   (let ((tree (org-element-parse-buffer 'element)) (num-hl 0) (num-el 0))
     (org-element-map tree 'headline (lambda (hl) (incf num-hl)))
     (org-element-map
      tree '(paragraph table verse-block quote-block src-block example-block)
      (lambda (el) (incf num-el)))
     (cons (1- num-hl) num-el))))

(autoload 'org-element-parse-buffer 
"~/bureautique/emacs/_/org-mode/contrib/lisp/org-element")
(global-set-key "\C-cow" 'fp-org-weight-display)
--8<---------------cut here---------------end--------------->8---

The next to last line was needed because your function depends on
org-element.el, which is not directly available in Org mode, at least
as of today's Git repository.  Is it a better way to install that file?

Another questionable thing is that I'm using the org-clock-overly face,
while the code should probably use and define its own.

Once again, thanks Nicolas!

François