From: Simon Guest <simon.guest@tesujimath.org>
To: Samuel Wales <samologist@gmail.com>
Cc: emacs-org list <emacs-orgmode@gnu.org>
Subject: v3, with support for narrowing
Date: Fri, 29 Apr 2011 13:57:45 +1200 [thread overview]
Message-ID: <86y62tyg2u.wl%simon.guest@tesujimath.org> (raw)
In-Reply-To: <BANLkTinn1d-uj5bh0N-ye=yt_LoJJ5ipwQ@mail.gmail.com>
At Thu, 28 Apr 2011 15:47:07 -0700,
Samuel Wales wrote:
> Is it possible to make it so that you can show the overlays for just a
> subtree or region instead of the entire buffer?
Hi Samuel,
Good idea! So I just fixed it to handle narrowing properly, so narrow
to your region or subtree of interest first, and then count as usual.
Attached v3 which does this. I'm not normally this responsive, you
just caught me at a good time. ;-)
> Also, I have a plugin-compatible backend that will get you the /exact/
> word count (uses w3m). If you're interested you can have it be an
> alternate backend.
I'm not that interested in higher fidelity counting. I'm especially
interested in speed.
cheers,
Simon
;; org-wc.el
;;
;; Count words in org mode trees.
;; Shows word count per heading line, summed over sub-headings.
;; Aims to be fast, so doesn't check carefully what it's counting. ;-)
;;
;; Simon Guest, 23/4/11
;;
;; Implementation based on:
;; - Paul Sexton's word count posted on org-mode mailing list 21/2/11.
;; - clock overlays
;;
;; v2
;; 29/4/11
;; Don't modify buffer, and fixed handling of empty sections.
;;
;; v3
;; 29/4/11
;; Handle narrowing correctly, so partial word count works on narrowed regions.
(defun org-in-heading-line ()
"Is point in a line starting with `*'?"
(equal (char-after (point-at-bol)) ?*))
(defun org-word-count (beg end)
"Report the number of words in the Org mode buffer or selected region."
(interactive "r")
(unless mark-active
(setf beg (point-min)
end (point-max)))
(let ((wc (org-word-count-aux beg end)))
(message (format "%d words in %s." wc
(if mark-active "region" "buffer")))))
(defun org-word-count-aux (beg end)
"Report the number of words in the selected region.
Ignores: heading lines,
blocks,
comments,
drawers.
LaTeX macros are counted as 1 word."
(let ((wc 0)
(block-begin-re "^#\\\+BEGIN")
(block-end-re "^#\\+END")
(latex-macro-regexp "\\\\[A-Za-z]+\\(\\[[^]]*\\]\\|\\){\\([^}]*\\)}")
(drawers-re (concat "^[ \t]*:\\("
(mapconcat 'regexp-quote org-drawers "\\|")
"\\):[ \t]*$"))
(drawers-end-re "^[ \t]*:END:"))
(save-excursion
(goto-char beg)
(while (< (point) end)
(cond
;; Ignore heading lines.
((org-in-heading-line)
(forward-line))
;; Ignore blocks.
((looking-at block-begin-re)
(re-search-forward block-end-re))
;; Ignore comments.
((org-in-commented-line)
(forward-line))
;; Ignore drawers.
((looking-at drawers-re)
(re-search-forward drawers-end-re nil t))
;; Count latex macros as 1 word, ignoring their arguments.
((save-excursion
(backward-char)
(looking-at latex-macro-regexp))
(goto-char (match-end 0))
(setf wc (+ 2 wc)))
(t
(progn
(and (re-search-forward "\\w+\\W*" end 'skip)
(incf wc)))))))
wc))
(defun org-wc-count-subtrees ()
"Count words in each subtree, putting result as the property :org-wc on that heading."
(interactive)
(remove-text-properties (point-min) (point-max)
'(:org-wc t))
(save-excursion
(goto-char (point-max))
(while (outline-previous-heading)
(save-restriction
(org-narrow-to-subtree)
(let ((wc (org-word-count-aux (point-min) (point-max))))
(put-text-property (point) (point-at-eol) :org-wc wc)
(goto-char (point-min)))))))
(defun org-wc-display (beg end total-only)
"Show subtree word counts in the entire buffer.
With prefix argument, only show the total wordcount for the buffer or region
in the echo area.
Use \\[org-wc-remove-overlays] to remove the subtree times.
Ignores: heading lines,
blocks,
comments,
drawers.
LaTeX macros are counted as 1 word."
(interactive "r\nP")
(org-wc-remove-overlays)
(unless total-only
(let ((bmp (buffer-modified-p))
wc
p)
(org-wc-count-subtrees)
(save-excursion
(goto-char (point-min))
(while (or (and (equal (setq p (point)) (point-min))
(get-text-property p :org-wc))
(setq p (next-single-property-change
(point) :org-wc)))
(goto-char p)
(when (setq wc (get-text-property p :org-wc))
(org-wc-put-overlay wc (funcall outline-level))))
;; Arrange to remove the overlays upon next change.
(when org-remove-highlights-with-change
(org-add-hook 'before-change-functions 'org-wc-remove-overlays
nil 'local)))
(set-buffer-modified-p bmp)))
(if mark-active
(org-word-count beg end)
(org-word-count (point-min) (point-max))))
(defvar org-wc-overlays nil)
(make-variable-buffer-local 'org-wc-overlays)
(defun org-wc-put-overlay (wc &optional level)
"Put an overlays on the current line, displaying word count.
If LEVEL is given, prefix word count with a corresponding number of stars.
This creates a new overlay and stores it in `org-wc-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" (number-to-string wc))
(list 'face 'org-wc-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 org-wc-overlays)))
(defun org-wc-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 org-wc-overlays)
(setq org-wc-overlays nil)
(unless noremove
(remove-hook 'before-change-functions
'org-wc-remove-overlays 'local))))
(provide 'org-wc)
next prev parent reply other threads:[~2011-04-29 1:57 UTC|newest]
Thread overview: 19+ messages / expand[flat|nested] mbox.gz Atom feed top
2011-04-23 8:57 Implemented word count for subtrees Simon Guest
2011-04-27 17:51 ` Eric S Fraga
2011-04-27 22:41 ` Simon Guest
2011-04-28 8:34 ` Eric S Fraga
2011-04-28 22:05 ` Sub-tree word count v2 Simon Guest
2011-04-28 22:47 ` Samuel Wales
2011-04-29 1:57 ` Simon Guest [this message]
2011-04-29 2:41 ` v3, with support for narrowing Eric Abrahamsen
2011-04-29 3:35 ` Nick Dokos
2011-04-29 4:31 ` Eric Abrahamsen
2011-04-29 14:56 ` Nick Dokos
2011-04-29 21:42 ` Simon Guest
2011-06-09 1:33 ` v4, now with properties and inclusion tags Eric Abrahamsen
2011-05-14 22:48 ` v3, with support for narrowing Samuel Wales
2011-05-15 4:25 ` Simon Guest
2011-04-28 23:16 ` Sub-tree word count v2 Eric S Fraga
2011-04-28 7:53 ` Implemented word count for subtrees Sébastien Vauban
2011-04-28 8:35 ` Eric S Fraga
2011-05-02 12:19 ` Daniel Clemente
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=86y62tyg2u.wl%simon.guest@tesujimath.org \
--to=simon.guest@tesujimath.org \
--cc=emacs-orgmode@gnu.org \
--cc=samologist@gmail.com \
/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).