From mboxrd@z Thu Jan 1 00:00:00 1970 From: Simon Guest Subject: v3, with support for narrowing Date: Fri, 29 Apr 2011 13:57:45 +1200 Message-ID: <86y62tyg2u.wl%simon.guest@tesujimath.org> References: <867hal4a6t.wl%simon.guest@tesujimath.org> <87iptzoa5x.fsf@ucl.ac.uk> <86zknb9v1y.wl%simon.guest@tesujimath.org> <87oc3qg4f8.fsf@ucl.ac.uk> <86y62uxc90.wl%simon.guest@tesujimath.org> Mime-Version: 1.0 (generated by SEMI 1.14.6 - "Maruoka") Content-Type: text/plain; charset=US-ASCII Return-path: Received: from eggs.gnu.org ([140.186.70.92]:38611) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QFcxt-0007TK-KT for emacs-orgmode@gnu.org; Thu, 28 Apr 2011 21:57:54 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1QFcxs-0000qE-D1 for emacs-orgmode@gnu.org; Thu, 28 Apr 2011 21:57:53 -0400 Received: from snapmx1.ironport.snap.net.nz ([202.37.100.100]:4733) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QFcxr-0000pe-KV for emacs-orgmode@gnu.org; Thu, 28 Apr 2011 21:57:52 -0400 In-Reply-To: List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: Samuel Wales Cc: emacs-org list 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)