From: pinard@iro.umontreal.ca (François Pinard)
To: emacs-orgmode@gnu.org
Subject: Re: Weight of headers
Date: Sun, 26 Feb 2012 22:36:55 -0500 [thread overview]
Message-ID: <871uphlzfs.fsf@iro.umontreal.ca> (raw)
In-Reply-To: <874nudhj4j.fsf@gmail.com> (Nicolas Goaziou's message of "Sun, 26 Feb 2012 13:30:36 +0100")
Nicolas Goaziou <n.goaziou@gmail.com> writes:
> pinard@iro.umontreal.ca (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 <n.goaziou@gmail.com>, 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
next prev parent reply other threads:[~2012-02-27 3:36 UTC|newest]
Thread overview: 6+ messages / expand[flat|nested] mbox.gz Atom feed top
2012-02-26 2:42 Weight of headers François Pinard
2012-02-26 12:30 ` Nicolas Goaziou
2012-02-27 3:36 ` François Pinard [this message]
2012-02-27 3:56 ` François Pinard
2012-02-27 4:12 ` Nick Dokos
2012-02-27 4:52 ` Samuel Wales
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=871uphlzfs.fsf@iro.umontreal.ca \
--to=pinard@iro.umontreal.ca \
--cc=emacs-orgmode@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).